├── .gitignore ├── .travis.opam ├── .travis.yml ├── COPYING ├── Library ├── Ancillary │ ├── autoinstall │ └── travisci ├── Autoconf │ ├── bsdowl.m4 │ └── ocaml.m4 ├── Configuration │ ├── debug.mk │ └── release.mk └── Data │ └── bsdowl.css ├── Makefile ├── Makefile.config.in ├── Makefile.inc ├── README.md ├── aclocal.m4 ├── configure.ac ├── manual ├── Makefile └── intro.text ├── meta ├── Makefile └── lemonade.in ├── opam ├── descr └── opam ├── ppx ├── Makefile └── ppx_lemonade.ml ├── src ├── Makefile ├── lemonade_Continuation.ml ├── lemonade_Continuation.mli ├── lemonade_Lazy.ml ├── lemonade_Lazy.mli ├── lemonade_List.ml ├── lemonade_List.mli ├── lemonade_Maybe.ml ├── lemonade_Maybe.mli ├── lemonade_Ok.ml ├── lemonade_Ok.mli ├── lemonade_Reader.ml ├── lemonade_Reader.mli ├── lemonade_Retry.ml ├── lemonade_Retry.mli ├── lemonade_State.ml ├── lemonade_State.mli ├── lemonade_Stream.ml ├── lemonade_Stream.mli ├── lemonade_Success.ml ├── lemonade_Success.mli ├── lemonade_Type.ml ├── lemonade_Type.mli ├── lemonade_Writer.ml └── lemonade_Writer.mli └── testsuite ├── Makefile ├── main.ml ├── testList.ml ├── testMaybe.ml ├── testPPX.ml ├── testStream.ml └── testSuccessReader.ml /.gitignore: -------------------------------------------------------------------------------- 1 | # 2 | # Autoconf files 3 | # 4 | autom4te.cache/ 5 | config.log 6 | config.status 7 | configure 8 | Makefile.config 9 | Makefile.local 10 | .product 11 | .merlin 12 | -------------------------------------------------------------------------------- /.travis.opam: -------------------------------------------------------------------------------- 1 | compiler: 2 | - 4.00.1 3 | - 4.01.0 4 | - 4.02.3 5 | repository: 6 | - ocamlfind 7 | - mixture 8 | git: 9 | - https://github.com/michipili/broken.git 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | addons: 4 | apt: 5 | sources: 6 | - avsm 7 | packages: 8 | - aspcud 9 | - ocaml 10 | - opam 11 | - ocaml-native-compilers 12 | install: sh -ex ./Library/Ancillary/autoinstall bmake bsdowl opam 13 | script: sh -ex ./Library/Ancillary/travisci 14 | cache: 15 | directories: 16 | - ${HOME}/.local 17 | - ${HOME}/.opam 18 | env: 19 | - TRAVIS_OCAML_VERSION=4.00.1 TRAVIS_ENABLE_PPX_REWRITER=no 20 | - TRAVIS_OCAML_VERSION=4.01.0 TRAVIS_ENABLE_PPX_REWRITER=no 21 | - TRAVIS_OCAML_VERSION=4.02.3 TRAVIS_ENABLE_PPX_REWRITER=yes 22 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | This program is released under the CeCILL-B version 1.0 (see the text 2 | below). 3 | 4 | The file ppx/ppx_lemonade.ml is licenced under the LGPL version 2.1 5 | (see the text below) with the additional exemption that compiling, 6 | linking, and/or using OpenSSL is allowed. 7 | 8 | CeCILL-B FREE SOFTWARE LICENSE AGREEMENT 9 | 10 | 11 | Notice 12 | 13 | This Agreement is a Free Software license agreement that is the result 14 | of discussions between its authors in order to ensure compliance with 15 | the two main principles guiding its drafting: 16 | 17 | * firstly, compliance with the principles governing the distribution 18 | of Free Software: access to source code, broad rights granted to 19 | users, 20 | * secondly, the election of a governing law, French law, with which 21 | it is conformant, both as regards the law of torts and 22 | intellectual property law, and the protection that it offers to 23 | both authors and holders of the economic rights over software. 24 | 25 | The authors of the CeCILL-B (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre]) 26 | license are: 27 | 28 | Commissariat à l'Energie Atomique - CEA, a public scientific, technical 29 | and industrial research establishment, having its principal place of 30 | business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France. 31 | 32 | Centre National de la Recherche Scientifique - CNRS, a public scientific 33 | and technological establishment, having its principal place of business 34 | at 3 rue Michel-Ange, 75794 Paris cedex 16, France. 35 | 36 | Institut National de Recherche en Informatique et en Automatique - 37 | INRIA, a public scientific and technological establishment, having its 38 | principal place of business at Domaine de Voluceau, Rocquencourt, BP 39 | 105, 78153 Le Chesnay cedex, France. 40 | 41 | 42 | Preamble 43 | 44 | This Agreement is an open source software license intended to give users 45 | significant freedom to modify and redistribute the software licensed 46 | hereunder. 47 | 48 | The exercising of this freedom is conditional upon a strong obligation 49 | of giving credits for everybody that distributes a software 50 | incorporating a software ruled by the current license so as all 51 | contributions to be properly identified and acknowledged. 52 | 53 | In consideration of access to the source code and the rights to copy, 54 | modify and redistribute granted by the license, users are provided only 55 | with a limited warranty and the software's author, the holder of the 56 | economic rights, and the successive licensors only have limited liability. 57 | 58 | In this respect, the risks associated with loading, using, modifying 59 | and/or developing or reproducing the software by the user are brought to 60 | the user's attention, given its Free Software status, which may make it 61 | complicated to use, with the result that its use is reserved for 62 | developers and experienced professionals having in-depth computer 63 | knowledge. Users are therefore encouraged to load and test the 64 | suitability of the software as regards their requirements in conditions 65 | enabling the security of their systems and/or data to be ensured and, 66 | more generally, to use and operate it in the same conditions of 67 | security. This Agreement may be freely reproduced and published, 68 | provided it is not altered, and that no provisions are either added or 69 | removed herefrom. 70 | 71 | This Agreement may apply to any or all software for which the holder of 72 | the economic rights decides to submit the use thereof to its provisions. 73 | 74 | 75 | Article 1 - DEFINITIONS 76 | 77 | For the purpose of this Agreement, when the following expressions 78 | commence with a capital letter, they shall have the following meaning: 79 | 80 | Agreement: means this license agreement, and its possible subsequent 81 | versions and annexes. 82 | 83 | Software: means the software in its Object Code and/or Source Code form 84 | and, where applicable, its documentation, "as is" when the Licensee 85 | accepts the Agreement. 86 | 87 | Initial Software: means the Software in its Source Code and possibly its 88 | Object Code form and, where applicable, its documentation, "as is" when 89 | it is first distributed under the terms and conditions of the Agreement. 90 | 91 | Modified Software: means the Software modified by at least one 92 | Contribution. 93 | 94 | Source Code: means all the Software's instructions and program lines to 95 | which access is required so as to modify the Software. 96 | 97 | Object Code: means the binary files originating from the compilation of 98 | the Source Code. 99 | 100 | Holder: means the holder(s) of the economic rights over the Initial 101 | Software. 102 | 103 | Licensee: means the Software user(s) having accepted the Agreement. 104 | 105 | Contributor: means a Licensee having made at least one Contribution. 106 | 107 | Licensor: means the Holder, or any other individual or legal entity, who 108 | distributes the Software under the Agreement. 109 | 110 | Contribution: means any or all modifications, corrections, translations, 111 | adaptations and/or new functions integrated into the Software by any or 112 | all Contributors, as well as any or all Internal Modules. 113 | 114 | Module: means a set of sources files including their documentation that 115 | enables supplementary functions or services in addition to those offered 116 | by the Software. 117 | 118 | External Module: means any or all Modules, not derived from the 119 | Software, so that this Module and the Software run in separate address 120 | spaces, with one calling the other when they are run. 121 | 122 | Internal Module: means any or all Module, connected to the Software so 123 | that they both execute in the same address space. 124 | 125 | Parties: mean both the Licensee and the Licensor. 126 | 127 | These expressions may be used both in singular and plural form. 128 | 129 | 130 | Article 2 - PURPOSE 131 | 132 | The purpose of the Agreement is the grant by the Licensor to the 133 | Licensee of a non-exclusive, transferable and worldwide license for the 134 | Software as set forth in Article 5 hereinafter for the whole term of the 135 | protection granted by the rights over said Software. 136 | 137 | 138 | Article 3 - ACCEPTANCE 139 | 140 | 3.1 The Licensee shall be deemed as having accepted the terms and 141 | conditions of this Agreement upon the occurrence of the first of the 142 | following events: 143 | 144 | * (i) loading the Software by any or all means, notably, by 145 | downloading from a remote server, or by loading from a physical 146 | medium; 147 | * (ii) the first time the Licensee exercises any of the rights 148 | granted hereunder. 149 | 150 | 3.2 One copy of the Agreement, containing a notice relating to the 151 | characteristics of the Software, to the limited warranty, and to the 152 | fact that its use is restricted to experienced users has been provided 153 | to the Licensee prior to its acceptance as set forth in Article 3.1 154 | hereinabove, and the Licensee hereby acknowledges that it has read and 155 | understood it. 156 | 157 | 158 | Article 4 - EFFECTIVE DATE AND TERM 159 | 160 | 161 | 4.1 EFFECTIVE DATE 162 | 163 | The Agreement shall become effective on the date when it is accepted by 164 | the Licensee as set forth in Article 3.1. 165 | 166 | 167 | 4.2 TERM 168 | 169 | The Agreement shall remain in force for the entire legal term of 170 | protection of the economic rights over the Software. 171 | 172 | 173 | Article 5 - SCOPE OF RIGHTS GRANTED 174 | 175 | The Licensor hereby grants to the Licensee, who accepts, the following 176 | rights over the Software for any or all use, and for the term of the 177 | Agreement, on the basis of the terms and conditions set forth hereinafter. 178 | 179 | Besides, if the Licensor owns or comes to own one or more patents 180 | protecting all or part of the functions of the Software or of its 181 | components, the Licensor undertakes not to enforce the rights granted by 182 | these patents against successive Licensees using, exploiting or 183 | modifying the Software. If these patents are transferred, the Licensor 184 | undertakes to have the transferees subscribe to the obligations set 185 | forth in this paragraph. 186 | 187 | 188 | 5.1 RIGHT OF USE 189 | 190 | The Licensee is authorized to use the Software, without any limitation 191 | as to its fields of application, with it being hereinafter specified 192 | that this comprises: 193 | 194 | 1. permanent or temporary reproduction of all or part of the Software 195 | by any or all means and in any or all form. 196 | 197 | 2. loading, displaying, running, or storing the Software on any or 198 | all medium. 199 | 200 | 3. entitlement to observe, study or test its operation so as to 201 | determine the ideas and principles behind any or all constituent 202 | elements of said Software. This shall apply when the Licensee 203 | carries out any or all loading, displaying, running, transmission 204 | or storage operation as regards the Software, that it is entitled 205 | to carry out hereunder. 206 | 207 | 208 | 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS 209 | 210 | The right to make Contributions includes the right to translate, adapt, 211 | arrange, or make any or all modifications to the Software, and the right 212 | to reproduce the resulting software. 213 | 214 | The Licensee is authorized to make any or all Contributions to the 215 | Software provided that it includes an explicit notice that it is the 216 | author of said Contribution and indicates the date of the creation thereof. 217 | 218 | 219 | 5.3 RIGHT OF DISTRIBUTION 220 | 221 | In particular, the right of distribution includes the right to publish, 222 | transmit and communicate the Software to the general public on any or 223 | all medium, and by any or all means, and the right to market, either in 224 | consideration of a fee, or free of charge, one or more copies of the 225 | Software by any means. 226 | 227 | The Licensee is further authorized to distribute copies of the modified 228 | or unmodified Software to third parties according to the terms and 229 | conditions set forth hereinafter. 230 | 231 | 232 | 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION 233 | 234 | The Licensee is authorized to distribute true copies of the Software in 235 | Source Code or Object Code form, provided that said distribution 236 | complies with all the provisions of the Agreement and is accompanied by: 237 | 238 | 1. a copy of the Agreement, 239 | 240 | 2. a notice relating to the limitation of both the Licensor's 241 | warranty and liability as set forth in Articles 8 and 9, 242 | 243 | and that, in the event that only the Object Code of the Software is 244 | redistributed, the Licensee allows effective access to the full Source 245 | Code of the Software at a minimum during the entire period of its 246 | distribution of the Software, it being understood that the additional 247 | cost of acquiring the Source Code shall not exceed the cost of 248 | transferring the data. 249 | 250 | 251 | 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE 252 | 253 | If the Licensee makes any Contribution to the Software, the resulting 254 | Modified Software may be distributed under a license agreement other 255 | than this Agreement subject to compliance with the provisions of Article 256 | 5.3.4. 257 | 258 | 259 | 5.3.3 DISTRIBUTION OF EXTERNAL MODULES 260 | 261 | When the Licensee has developed an External Module, the terms and 262 | conditions of this Agreement do not apply to said External Module, that 263 | may be distributed under a separate license agreement. 264 | 265 | 266 | 5.3.4 CREDITS 267 | 268 | Any Licensee who may distribute a Modified Software hereby expressly 269 | agrees to: 270 | 271 | 1. indicate in the related documentation that it is based on the 272 | Software licensed hereunder, and reproduce the intellectual 273 | property notice for the Software, 274 | 275 | 2. ensure that written indications of the Software intended use, 276 | intellectual property notice and license hereunder are included in 277 | easily accessible format from the Modified Software interface, 278 | 279 | 3. mention, on a freely accessible website describing the Modified 280 | Software, at least throughout the distribution term thereof, that 281 | it is based on the Software licensed hereunder, and reproduce the 282 | Software intellectual property notice, 283 | 284 | 4. where it is distributed to a third party that may distribute a 285 | Modified Software without having to make its source code 286 | available, make its best efforts to ensure that said third party 287 | agrees to comply with the obligations set forth in this Article . 288 | 289 | If the Software, whether or not modified, is distributed with an 290 | External Module designed for use in connection with the Software, the 291 | Licensee shall submit said External Module to the foregoing obligations. 292 | 293 | 294 | 5.3.5 COMPATIBILITY WITH THE CeCILL AND CeCILL-C LICENSES 295 | 296 | Where a Modified Software contains a Contribution subject to the CeCILL 297 | license, the provisions set forth in Article 5.3.4 shall be optional. 298 | 299 | A Modified Software may be distributed under the CeCILL-C license. In 300 | such a case the provisions set forth in Article 5.3.4 shall be optional. 301 | 302 | 303 | Article 6 - INTELLECTUAL PROPERTY 304 | 305 | 306 | 6.1 OVER THE INITIAL SOFTWARE 307 | 308 | The Holder owns the economic rights over the Initial Software. Any or 309 | all use of the Initial Software is subject to compliance with the terms 310 | and conditions under which the Holder has elected to distribute its work 311 | and no one shall be entitled to modify the terms and conditions for the 312 | distribution of said Initial Software. 313 | 314 | The Holder undertakes that the Initial Software will remain ruled at 315 | least by this Agreement, for the duration set forth in Article 4.2. 316 | 317 | 318 | 6.2 OVER THE CONTRIBUTIONS 319 | 320 | The Licensee who develops a Contribution is the owner of the 321 | intellectual property rights over this Contribution as defined by 322 | applicable law. 323 | 324 | 325 | 6.3 OVER THE EXTERNAL MODULES 326 | 327 | The Licensee who develops an External Module is the owner of the 328 | intellectual property rights over this External Module as defined by 329 | applicable law and is free to choose the type of agreement that shall 330 | govern its distribution. 331 | 332 | 333 | 6.4 JOINT PROVISIONS 334 | 335 | The Licensee expressly undertakes: 336 | 337 | 1. not to remove, or modify, in any manner, the intellectual property 338 | notices attached to the Software; 339 | 340 | 2. to reproduce said notices, in an identical manner, in the copies 341 | of the Software modified or not. 342 | 343 | The Licensee undertakes not to directly or indirectly infringe the 344 | intellectual property rights of the Holder and/or Contributors on the 345 | Software and to take, where applicable, vis-à-vis its staff, any and all 346 | measures required to ensure respect of said intellectual property rights 347 | of the Holder and/or Contributors. 348 | 349 | 350 | Article 7 - RELATED SERVICES 351 | 352 | 7.1 Under no circumstances shall the Agreement oblige the Licensor to 353 | provide technical assistance or maintenance services for the Software. 354 | 355 | However, the Licensor is entitled to offer this type of services. The 356 | terms and conditions of such technical assistance, and/or such 357 | maintenance, shall be set forth in a separate instrument. Only the 358 | Licensor offering said maintenance and/or technical assistance services 359 | shall incur liability therefor. 360 | 361 | 7.2 Similarly, any Licensor is entitled to offer to its licensees, under 362 | its sole responsibility, a warranty, that shall only be binding upon 363 | itself, for the redistribution of the Software and/or the Modified 364 | Software, under terms and conditions that it is free to decide. Said 365 | warranty, and the financial terms and conditions of its application, 366 | shall be subject of a separate instrument executed between the Licensor 367 | and the Licensee. 368 | 369 | 370 | Article 8 - LIABILITY 371 | 372 | 8.1 Subject to the provisions of Article 8.2, the Licensee shall be 373 | entitled to claim compensation for any direct loss it may have suffered 374 | from the Software as a result of a fault on the part of the relevant 375 | Licensor, subject to providing evidence thereof. 376 | 377 | 8.2 The Licensor's liability is limited to the commitments made under 378 | this Agreement and shall not be incurred as a result of in particular: 379 | (i) loss due the Licensee's total or partial failure to fulfill its 380 | obligations, (ii) direct or consequential loss that is suffered by the 381 | Licensee due to the use or performance of the Software, and (iii) more 382 | generally, any consequential loss. In particular the Parties expressly 383 | agree that any or all pecuniary or business loss (i.e. loss of data, 384 | loss of profits, operating loss, loss of customers or orders, 385 | opportunity cost, any disturbance to business activities) or any or all 386 | legal proceedings instituted against the Licensee by a third party, 387 | shall constitute consequential loss and shall not provide entitlement to 388 | any or all compensation from the Licensor. 389 | 390 | 391 | Article 9 - WARRANTY 392 | 393 | 9.1 The Licensee acknowledges that the scientific and technical 394 | state-of-the-art when the Software was distributed did not enable all 395 | possible uses to be tested and verified, nor for the presence of 396 | possible defects to be detected. In this respect, the Licensee's 397 | attention has been drawn to the risks associated with loading, using, 398 | modifying and/or developing and reproducing the Software which are 399 | reserved for experienced users. 400 | 401 | The Licensee shall be responsible for verifying, by any or all means, 402 | the suitability of the product for its requirements, its good working 403 | order, and for ensuring that it shall not cause damage to either persons 404 | or properties. 405 | 406 | 9.2 The Licensor hereby represents, in good faith, that it is entitled 407 | to grant all the rights over the Software (including in particular the 408 | rights set forth in Article 5). 409 | 410 | 9.3 The Licensee acknowledges that the Software is supplied "as is" by 411 | the Licensor without any other express or tacit warranty, other than 412 | that provided for in Article 9.2 and, in particular, without any warranty 413 | as to its commercial value, its secured, safe, innovative or relevant 414 | nature. 415 | 416 | Specifically, the Licensor does not warrant that the Software is free 417 | from any error, that it will operate without interruption, that it will 418 | be compatible with the Licensee's own equipment and software 419 | configuration, nor that it will meet the Licensee's requirements. 420 | 421 | 9.4 The Licensor does not either expressly or tacitly warrant that the 422 | Software does not infringe any third party intellectual property right 423 | relating to a patent, software or any other property right. Therefore, 424 | the Licensor disclaims any and all liability towards the Licensee 425 | arising out of any or all proceedings for infringement that may be 426 | instituted in respect of the use, modification and redistribution of the 427 | Software. Nevertheless, should such proceedings be instituted against 428 | the Licensee, the Licensor shall provide it with technical and legal 429 | assistance for its defense. Such technical and legal assistance shall be 430 | decided on a case-by-case basis between the relevant Licensor and the 431 | Licensee pursuant to a memorandum of understanding. The Licensor 432 | disclaims any and all liability as regards the Licensee's use of the 433 | name of the Software. No warranty is given as regards the existence of 434 | prior rights over the name of the Software or as regards the existence 435 | of a trademark. 436 | 437 | 438 | Article 10 - TERMINATION 439 | 440 | 10.1 In the event of a breach by the Licensee of its obligations 441 | hereunder, the Licensor may automatically terminate this Agreement 442 | thirty (30) days after notice has been sent to the Licensee and has 443 | remained ineffective. 444 | 445 | 10.2 A Licensee whose Agreement is terminated shall no longer be 446 | authorized to use, modify or distribute the Software. However, any 447 | licenses that it may have granted prior to termination of the Agreement 448 | shall remain valid subject to their having been granted in compliance 449 | with the terms and conditions hereof. 450 | 451 | 452 | Article 11 - MISCELLANEOUS 453 | 454 | 455 | 11.1 EXCUSABLE EVENTS 456 | 457 | Neither Party shall be liable for any or all delay, or failure to 458 | perform the Agreement, that may be attributable to an event of force 459 | majeure, an act of God or an outside cause, such as defective 460 | functioning or interruptions of the electricity or telecommunications 461 | networks, network paralysis following a virus attack, intervention by 462 | government authorities, natural disasters, water damage, earthquakes, 463 | fire, explosions, strikes and labor unrest, war, etc. 464 | 465 | 11.2 Any failure by either Party, on one or more occasions, to invoke 466 | one or more of the provisions hereof, shall under no circumstances be 467 | interpreted as being a waiver by the interested Party of its right to 468 | invoke said provision(s) subsequently. 469 | 470 | 11.3 The Agreement cancels and replaces any or all previous agreements, 471 | whether written or oral, between the Parties and having the same 472 | purpose, and constitutes the entirety of the agreement between said 473 | Parties concerning said purpose. No supplement or modification to the 474 | terms and conditions hereof shall be effective as between the Parties 475 | unless it is made in writing and signed by their duly authorized 476 | representatives. 477 | 478 | 11.4 In the event that one or more of the provisions hereof were to 479 | conflict with a current or future applicable act or legislative text, 480 | said act or legislative text shall prevail, and the Parties shall make 481 | the necessary amendments so as to comply with said act or legislative 482 | text. All other provisions shall remain effective. Similarly, invalidity 483 | of a provision of the Agreement, for any reason whatsoever, shall not 484 | cause the Agreement as a whole to be invalid. 485 | 486 | 487 | 11.5 LANGUAGE 488 | 489 | The Agreement is drafted in both French and English and both versions 490 | are deemed authentic. 491 | 492 | 493 | Article 12 - NEW VERSIONS OF THE AGREEMENT 494 | 495 | 12.1 Any person is authorized to duplicate and distribute copies of this 496 | Agreement. 497 | 498 | 12.2 So as to ensure coherence, the wording of this Agreement is 499 | protected and may only be modified by the authors of the License, who 500 | reserve the right to periodically publish updates or new versions of the 501 | Agreement, each with a separate number. These subsequent versions may 502 | address new issues encountered by Free Software. 503 | 504 | 12.3 Any Software distributed under a given version of the Agreement may 505 | only be subsequently distributed under the same version of the Agreement 506 | or a subsequent version. 507 | 508 | 509 | Article 13 - GOVERNING LAW AND JURISDICTION 510 | 511 | 13.1 The Agreement is governed by French law. The Parties agree to 512 | endeavor to seek an amicable solution to any disagreements or disputes 513 | that may arise during the performance of the Agreement. 514 | 515 | 13.2 Failing an amicable solution within two (2) months as from their 516 | occurrence, and unless emergency proceedings are necessary, the 517 | disagreements or disputes shall be referred to the Paris Courts having 518 | jurisdiction, by the more diligent Party. 519 | 520 | 521 | Version 1.0 dated 2006-09-05. 522 | 523 | As a special exception to the GNU Library General Public License, you 524 | may also link, statically or dynamically, a "work that uses the 525 | Library" with a publicly distributed version of the Library to produce 526 | an executable file containing portions of the Library, and distribute 527 | that executable file under terms of your choice, without any of the 528 | additional requirements listed in clause 6 of the GNU Library General 529 | Public License. By "a publicly distributed version of the Library", 530 | we mean either the unmodified Library, or a modified version of the 531 | Library that is distributed under the conditions defined in clause 3 532 | of the GNU Library General Public License. This exception does not 533 | however invalidate any other reasons why the executable file might be 534 | covered by the GNU Library General Public License. 535 | 536 | GNU LESSER GENERAL PUBLIC LICENSE 537 | Version 2.1, February 1999 538 | 539 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 540 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 541 | Everyone is permitted to copy and distribute verbatim copies 542 | of this license document, but changing it is not allowed. 543 | 544 | [This is the first released version of the Lesser GPL. It also counts 545 | as the successor of the GNU Library Public License, version 2, hence 546 | the version number 2.1.] 547 | 548 | Preamble 549 | 550 | The licenses for most software are designed to take away your 551 | freedom to share and change it. By contrast, the GNU General Public 552 | Licenses are intended to guarantee your freedom to share and change 553 | free software--to make sure the software is free for all its users. 554 | 555 | This license, the Lesser General Public License, applies to some 556 | specially designated software packages--typically libraries--of the 557 | Free Software Foundation and other authors who decide to use it. You 558 | can use it too, but we suggest you first think carefully about whether 559 | this license or the ordinary General Public License is the better 560 | strategy to use in any particular case, based on the explanations below. 561 | 562 | When we speak of free software, we are referring to freedom of use, 563 | not price. Our General Public Licenses are designed to make sure that 564 | you have the freedom to distribute copies of free software (and charge 565 | for this service if you wish); that you receive source code or can get 566 | it if you want it; that you can change the software and use pieces of 567 | it in new free programs; and that you are informed that you can do 568 | these things. 569 | 570 | To protect your rights, we need to make restrictions that forbid 571 | distributors to deny you these rights or to ask you to surrender these 572 | rights. These restrictions translate to certain responsibilities for 573 | you if you distribute copies of the library or if you modify it. 574 | 575 | For example, if you distribute copies of the library, whether gratis 576 | or for a fee, you must give the recipients all the rights that we gave 577 | you. You must make sure that they, too, receive or can get the source 578 | code. If you link other code with the library, you must provide 579 | complete object files to the recipients, so that they can relink them 580 | with the library after making changes to the library and recompiling 581 | it. And you must show them these terms so they know their rights. 582 | 583 | We protect your rights with a two-step method: (1) we copyright the 584 | library, and (2) we offer you this license, which gives you legal 585 | permission to copy, distribute and/or modify the library. 586 | 587 | To protect each distributor, we want to make it very clear that 588 | there is no warranty for the free library. Also, if the library is 589 | modified by someone else and passed on, the recipients should know 590 | that what they have is not the original version, so that the original 591 | author's reputation will not be affected by problems that might be 592 | introduced by others. 593 | 594 | Finally, software patents pose a constant threat to the existence of 595 | any free program. We wish to make sure that a company cannot 596 | effectively restrict the users of a free program by obtaining a 597 | restrictive license from a patent holder. Therefore, we insist that 598 | any patent license obtained for a version of the library must be 599 | consistent with the full freedom of use specified in this license. 600 | 601 | Most GNU software, including some libraries, is covered by the 602 | ordinary GNU General Public License. This license, the GNU Lesser 603 | General Public License, applies to certain designated libraries, and 604 | is quite different from the ordinary General Public License. We use 605 | this license for certain libraries in order to permit linking those 606 | libraries into non-free programs. 607 | 608 | When a program is linked with a library, whether statically or using 609 | a shared library, the combination of the two is legally speaking a 610 | combined work, a derivative of the original library. The ordinary 611 | General Public License therefore permits such linking only if the 612 | entire combination fits its criteria of freedom. The Lesser General 613 | Public License permits more lax criteria for linking other code with 614 | the library. 615 | 616 | We call this license the "Lesser" General Public License because it 617 | does Less to protect the user's freedom than the ordinary General 618 | Public License. It also provides other free software developers Less 619 | of an advantage over competing non-free programs. These disadvantages 620 | are the reason we use the ordinary General Public License for many 621 | libraries. However, the Lesser license provides advantages in certain 622 | special circumstances. 623 | 624 | For example, on rare occasions, there may be a special need to 625 | encourage the widest possible use of a certain library, so that it becomes 626 | a de-facto standard. To achieve this, non-free programs must be 627 | allowed to use the library. A more frequent case is that a free 628 | library does the same job as widely used non-free libraries. In this 629 | case, there is little to gain by limiting the free library to free 630 | software only, so we use the Lesser General Public License. 631 | 632 | In other cases, permission to use a particular library in non-free 633 | programs enables a greater number of people to use a large body of 634 | free software. For example, permission to use the GNU C Library in 635 | non-free programs enables many more people to use the whole GNU 636 | operating system, as well as its variant, the GNU/Linux operating 637 | system. 638 | 639 | Although the Lesser General Public License is Less protective of the 640 | users' freedom, it does ensure that the user of a program that is 641 | linked with the Library has the freedom and the wherewithal to run 642 | that program using a modified version of the Library. 643 | 644 | The precise terms and conditions for copying, distribution and 645 | modification follow. Pay close attention to the difference between a 646 | "work based on the library" and a "work that uses the library". The 647 | former contains code derived from the library, whereas the latter must 648 | be combined with the library in order to run. 649 | 650 | GNU LESSER GENERAL PUBLIC LICENSE 651 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 652 | 653 | 0. This License Agreement applies to any software library or other 654 | program which contains a notice placed by the copyright holder or 655 | other authorized party saying it may be distributed under the terms of 656 | this Lesser General Public License (also called "this License"). 657 | Each licensee is addressed as "you". 658 | 659 | A "library" means a collection of software functions and/or data 660 | prepared so as to be conveniently linked with application programs 661 | (which use some of those functions and data) to form executables. 662 | 663 | The "Library", below, refers to any such software library or work 664 | which has been distributed under these terms. A "work based on the 665 | Library" means either the Library or any derivative work under 666 | copyright law: that is to say, a work containing the Library or a 667 | portion of it, either verbatim or with modifications and/or translated 668 | straightforwardly into another language. (Hereinafter, translation is 669 | included without limitation in the term "modification".) 670 | 671 | "Source code" for a work means the preferred form of the work for 672 | making modifications to it. For a library, complete source code means 673 | all the source code for all modules it contains, plus any associated 674 | interface definition files, plus the scripts used to control compilation 675 | and installation of the library. 676 | 677 | Activities other than copying, distribution and modification are not 678 | covered by this License; they are outside its scope. The act of 679 | running a program using the Library is not restricted, and output from 680 | such a program is covered only if its contents constitute a work based 681 | on the Library (independent of the use of the Library in a tool for 682 | writing it). Whether that is true depends on what the Library does 683 | and what the program that uses the Library does. 684 | 685 | 1. You may copy and distribute verbatim copies of the Library's 686 | complete source code as you receive it, in any medium, provided that 687 | you conspicuously and appropriately publish on each copy an 688 | appropriate copyright notice and disclaimer of warranty; keep intact 689 | all the notices that refer to this License and to the absence of any 690 | warranty; and distribute a copy of this License along with the 691 | Library. 692 | 693 | You may charge a fee for the physical act of transferring a copy, 694 | and you may at your option offer warranty protection in exchange for a 695 | fee. 696 | 697 | 2. You may modify your copy or copies of the Library or any portion 698 | of it, thus forming a work based on the Library, and copy and 699 | distribute such modifications or work under the terms of Section 1 700 | above, provided that you also meet all of these conditions: 701 | 702 | a) The modified work must itself be a software library. 703 | 704 | b) You must cause the files modified to carry prominent notices 705 | stating that you changed the files and the date of any change. 706 | 707 | c) You must cause the whole of the work to be licensed at no 708 | charge to all third parties under the terms of this License. 709 | 710 | d) If a facility in the modified Library refers to a function or a 711 | table of data to be supplied by an application program that uses 712 | the facility, other than as an argument passed when the facility 713 | is invoked, then you must make a good faith effort to ensure that, 714 | in the event an application does not supply such function or 715 | table, the facility still operates, and performs whatever part of 716 | its purpose remains meaningful. 717 | 718 | (For example, a function in a library to compute square roots has 719 | a purpose that is entirely well-defined independent of the 720 | application. Therefore, Subsection 2d requires that any 721 | application-supplied function or table used by this function must 722 | be optional: if the application does not supply it, the square 723 | root function must still compute square roots.) 724 | 725 | These requirements apply to the modified work as a whole. If 726 | identifiable sections of that work are not derived from the Library, 727 | and can be reasonably considered independent and separate works in 728 | themselves, then this License, and its terms, do not apply to those 729 | sections when you distribute them as separate works. But when you 730 | distribute the same sections as part of a whole which is a work based 731 | on the Library, the distribution of the whole must be on the terms of 732 | this License, whose permissions for other licensees extend to the 733 | entire whole, and thus to each and every part regardless of who wrote 734 | it. 735 | 736 | Thus, it is not the intent of this section to claim rights or contest 737 | your rights to work written entirely by you; rather, the intent is to 738 | exercise the right to control the distribution of derivative or 739 | collective works based on the Library. 740 | 741 | In addition, mere aggregation of another work not based on the Library 742 | with the Library (or with a work based on the Library) on a volume of 743 | a storage or distribution medium does not bring the other work under 744 | the scope of this License. 745 | 746 | 3. You may opt to apply the terms of the ordinary GNU General Public 747 | License instead of this License to a given copy of the Library. To do 748 | this, you must alter all the notices that refer to this License, so 749 | that they refer to the ordinary GNU General Public License, version 2, 750 | instead of to this License. (If a newer version than version 2 of the 751 | ordinary GNU General Public License has appeared, then you can specify 752 | that version instead if you wish.) Do not make any other change in 753 | these notices. 754 | 755 | Once this change is made in a given copy, it is irreversible for 756 | that copy, so the ordinary GNU General Public License applies to all 757 | subsequent copies and derivative works made from that copy. 758 | 759 | This option is useful when you wish to copy part of the code of 760 | the Library into a program that is not a library. 761 | 762 | 4. You may copy and distribute the Library (or a portion or 763 | derivative of it, under Section 2) in object code or executable form 764 | under the terms of Sections 1 and 2 above provided that you accompany 765 | it with the complete corresponding machine-readable source code, which 766 | must be distributed under the terms of Sections 1 and 2 above on a 767 | medium customarily used for software interchange. 768 | 769 | If distribution of object code is made by offering access to copy 770 | from a designated place, then offering equivalent access to copy the 771 | source code from the same place satisfies the requirement to 772 | distribute the source code, even though third parties are not 773 | compelled to copy the source along with the object code. 774 | 775 | 5. A program that contains no derivative of any portion of the 776 | Library, but is designed to work with the Library by being compiled or 777 | linked with it, is called a "work that uses the Library". Such a 778 | work, in isolation, is not a derivative work of the Library, and 779 | therefore falls outside the scope of this License. 780 | 781 | However, linking a "work that uses the Library" with the Library 782 | creates an executable that is a derivative of the Library (because it 783 | contains portions of the Library), rather than a "work that uses the 784 | library". The executable is therefore covered by this License. 785 | Section 6 states terms for distribution of such executables. 786 | 787 | When a "work that uses the Library" uses material from a header file 788 | that is part of the Library, the object code for the work may be a 789 | derivative work of the Library even though the source code is not. 790 | Whether this is true is especially significant if the work can be 791 | linked without the Library, or if the work is itself a library. The 792 | threshold for this to be true is not precisely defined by law. 793 | 794 | If such an object file uses only numerical parameters, data 795 | structure layouts and accessors, and small macros and small inline 796 | functions (ten lines or less in length), then the use of the object 797 | file is unrestricted, regardless of whether it is legally a derivative 798 | work. (Executables containing this object code plus portions of the 799 | Library will still fall under Section 6.) 800 | 801 | Otherwise, if the work is a derivative of the Library, you may 802 | distribute the object code for the work under the terms of Section 6. 803 | Any executables containing that work also fall under Section 6, 804 | whether or not they are linked directly with the Library itself. 805 | 806 | 6. As an exception to the Sections above, you may also combine or 807 | link a "work that uses the Library" with the Library to produce a 808 | work containing portions of the Library, and distribute that work 809 | under terms of your choice, provided that the terms permit 810 | modification of the work for the customer's own use and reverse 811 | engineering for debugging such modifications. 812 | 813 | You must give prominent notice with each copy of the work that the 814 | Library is used in it and that the Library and its use are covered by 815 | this License. You must supply a copy of this License. If the work 816 | during execution displays copyright notices, you must include the 817 | copyright notice for the Library among them, as well as a reference 818 | directing the user to the copy of this License. Also, you must do one 819 | of these things: 820 | 821 | a) Accompany the work with the complete corresponding 822 | machine-readable source code for the Library including whatever 823 | changes were used in the work (which must be distributed under 824 | Sections 1 and 2 above); and, if the work is an executable linked 825 | with the Library, with the complete machine-readable "work that 826 | uses the Library", as object code and/or source code, so that the 827 | user can modify the Library and then relink to produce a modified 828 | executable containing the modified Library. (It is understood 829 | that the user who changes the contents of definitions files in the 830 | Library will not necessarily be able to recompile the application 831 | to use the modified definitions.) 832 | 833 | b) Use a suitable shared library mechanism for linking with the 834 | Library. A suitable mechanism is one that (1) uses at run time a 835 | copy of the library already present on the user's computer system, 836 | rather than copying library functions into the executable, and (2) 837 | will operate properly with a modified version of the library, if 838 | the user installs one, as long as the modified version is 839 | interface-compatible with the version that the work was made with. 840 | 841 | c) Accompany the work with a written offer, valid for at 842 | least three years, to give the same user the materials 843 | specified in Subsection 6a, above, for a charge no more 844 | than the cost of performing this distribution. 845 | 846 | d) If distribution of the work is made by offering access to copy 847 | from a designated place, offer equivalent access to copy the above 848 | specified materials from the same place. 849 | 850 | e) Verify that the user has already received a copy of these 851 | materials or that you have already sent this user a copy. 852 | 853 | For an executable, the required form of the "work that uses the 854 | Library" must include any data and utility programs needed for 855 | reproducing the executable from it. However, as a special exception, 856 | the materials to be distributed need not include anything that is 857 | normally distributed (in either source or binary form) with the major 858 | components (compiler, kernel, and so on) of the operating system on 859 | which the executable runs, unless that component itself accompanies 860 | the executable. 861 | 862 | It may happen that this requirement contradicts the license 863 | restrictions of other proprietary libraries that do not normally 864 | accompany the operating system. Such a contradiction means you cannot 865 | use both them and the Library together in an executable that you 866 | distribute. 867 | 868 | 7. You may place library facilities that are a work based on the 869 | Library side-by-side in a single library together with other library 870 | facilities not covered by this License, and distribute such a combined 871 | library, provided that the separate distribution of the work based on 872 | the Library and of the other library facilities is otherwise 873 | permitted, and provided that you do these two things: 874 | 875 | a) Accompany the combined library with a copy of the same work 876 | based on the Library, uncombined with any other library 877 | facilities. This must be distributed under the terms of the 878 | Sections above. 879 | 880 | b) Give prominent notice with the combined library of the fact 881 | that part of it is a work based on the Library, and explaining 882 | where to find the accompanying uncombined form of the same work. 883 | 884 | 8. You may not copy, modify, sublicense, link with, or distribute 885 | the Library except as expressly provided under this License. Any 886 | attempt otherwise to copy, modify, sublicense, link with, or 887 | distribute the Library is void, and will automatically terminate your 888 | rights under this License. However, parties who have received copies, 889 | or rights, from you under this License will not have their licenses 890 | terminated so long as such parties remain in full compliance. 891 | 892 | 9. You are not required to accept this License, since you have not 893 | signed it. However, nothing else grants you permission to modify or 894 | distribute the Library or its derivative works. These actions are 895 | prohibited by law if you do not accept this License. Therefore, by 896 | modifying or distributing the Library (or any work based on the 897 | Library), you indicate your acceptance of this License to do so, and 898 | all its terms and conditions for copying, distributing or modifying 899 | the Library or works based on it. 900 | 901 | 10. Each time you redistribute the Library (or any work based on the 902 | Library), the recipient automatically receives a license from the 903 | original licensor to copy, distribute, link with or modify the Library 904 | subject to these terms and conditions. You may not impose any further 905 | restrictions on the recipients' exercise of the rights granted herein. 906 | You are not responsible for enforcing compliance by third parties with 907 | this License. 908 | 909 | 11. If, as a consequence of a court judgment or allegation of patent 910 | infringement or for any other reason (not limited to patent issues), 911 | conditions are imposed on you (whether by court order, agreement or 912 | otherwise) that contradict the conditions of this License, they do not 913 | excuse you from the conditions of this License. If you cannot 914 | distribute so as to satisfy simultaneously your obligations under this 915 | License and any other pertinent obligations, then as a consequence you 916 | may not distribute the Library at all. For example, if a patent 917 | license would not permit royalty-free redistribution of the Library by 918 | all those who receive copies directly or indirectly through you, then 919 | the only way you could satisfy both it and this License would be to 920 | refrain entirely from distribution of the Library. 921 | 922 | If any portion of this section is held invalid or unenforceable under any 923 | particular circumstance, the balance of the section is intended to apply, 924 | and the section as a whole is intended to apply in other circumstances. 925 | 926 | It is not the purpose of this section to induce you to infringe any 927 | patents or other property right claims or to contest validity of any 928 | such claims; this section has the sole purpose of protecting the 929 | integrity of the free software distribution system which is 930 | implemented by public license practices. Many people have made 931 | generous contributions to the wide range of software distributed 932 | through that system in reliance on consistent application of that 933 | system; it is up to the author/donor to decide if he or she is willing 934 | to distribute software through any other system and a licensee cannot 935 | impose that choice. 936 | 937 | This section is intended to make thoroughly clear what is believed to 938 | be a consequence of the rest of this License. 939 | 940 | 12. If the distribution and/or use of the Library is restricted in 941 | certain countries either by patents or by copyrighted interfaces, the 942 | original copyright holder who places the Library under this License may add 943 | an explicit geographical distribution limitation excluding those countries, 944 | so that distribution is permitted only in or among countries not thus 945 | excluded. In such case, this License incorporates the limitation as if 946 | written in the body of this License. 947 | 948 | 13. The Free Software Foundation may publish revised and/or new 949 | versions of the Lesser General Public License from time to time. 950 | Such new versions will be similar in spirit to the present version, 951 | but may differ in detail to address new problems or concerns. 952 | 953 | Each version is given a distinguishing version number. If the Library 954 | specifies a version number of this License which applies to it and 955 | "any later version", you have the option of following the terms and 956 | conditions either of that version or of any later version published by 957 | the Free Software Foundation. If the Library does not specify a 958 | license version number, you may choose any version ever published by 959 | the Free Software Foundation. 960 | 961 | 14. If you wish to incorporate parts of the Library into other free 962 | programs whose distribution conditions are incompatible with these, 963 | write to the author to ask for permission. For software which is 964 | copyrighted by the Free Software Foundation, write to the Free 965 | Software Foundation; we sometimes make exceptions for this. Our 966 | decision will be guided by the two goals of preserving the free status 967 | of all derivatives of our free software and of promoting the sharing 968 | and reuse of software generally. 969 | 970 | NO WARRANTY 971 | 972 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 973 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 974 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 975 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 976 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 977 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 978 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 979 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 980 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 981 | 982 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 983 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 984 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 985 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 986 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 987 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 988 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 989 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 990 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 991 | DAMAGES. 992 | 993 | END OF TERMS AND CONDITIONS 994 | 995 | How to Apply These Terms to Your New Libraries 996 | 997 | If you develop a new library, and you want it to be of the greatest 998 | possible use to the public, we recommend making it free software that 999 | everyone can redistribute and change. You can do so by permitting 1000 | redistribution under these terms (or, alternatively, under the terms of the 1001 | ordinary General Public License). 1002 | 1003 | To apply these terms, attach the following notices to the library. It is 1004 | safest to attach them to the start of each source file to most effectively 1005 | convey the exclusion of warranty; and each file should have at least the 1006 | "copyright" line and a pointer to where the full notice is found. 1007 | 1008 | 1009 | Copyright (C) 1010 | 1011 | This library is free software; you can redistribute it and/or 1012 | modify it under the terms of the GNU Lesser General Public 1013 | License as published by the Free Software Foundation; either 1014 | version 2.1 of the License, or (at your option) any later version. 1015 | 1016 | This library is distributed in the hope that it will be useful, 1017 | but WITHOUT ANY WARRANTY; without even the implied warranty of 1018 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 1019 | Lesser General Public License for more details. 1020 | 1021 | You should have received a copy of the GNU Lesser General Public 1022 | License along with this library; if not, write to the Free Software 1023 | Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 1024 | 1025 | Also add information on how to contact you by electronic and paper mail. 1026 | 1027 | You should also get your employer (if you work as a programmer) or your 1028 | school, if any, to sign a "copyright disclaimer" for the library, if 1029 | necessary. Here is a sample; alter the names: 1030 | 1031 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 1032 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 1033 | 1034 | , 1 April 1990 1035 | Ty Coon, President of Vice 1036 | 1037 | That's all there is to it! 1038 | -------------------------------------------------------------------------------- /Library/Ancillary/autoinstall: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ### autoinstall -- Autoinstall for Travis CI 4 | 5 | # Lemonade (https://github.com/michipili/lemonade) 6 | # This file is part of Lemonade 7 | # 8 | # Copyright © 2015 Michael Grünewald 9 | # 10 | # This file must be used under the terms of the CeCILL-B. 11 | # This source file is licensed as described in the file COPYING, which 12 | # you should have received as part of this distribution. The terms 13 | # are also available at 14 | # http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt 15 | 16 | : ${local:=${HOME}/.local} 17 | : ${srcdir:=${HOME}/.local/sources} 18 | 19 | if [ -f "${local}/.anvil_autoinstall_cached" ]; then exit 0; fi 20 | 21 | git clone 'https://github.com/michipili/anvil' "${srcdir}/anvil" 22 | /bin/sh -ex "${srcdir}/anvil/subr/anvil_travisci_autoinstall.sh" "$@"\ 23 | && touch "${local}/.anvil_autoinstall_cached" 24 | 25 | ### End of file `autoinstall' 26 | -------------------------------------------------------------------------------- /Library/Ancillary/travisci: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ### travisci -- Continuous integration test for travis 4 | 5 | # Lemonade (https://github.com/michipili/lemonade) 6 | # This file is part of Lemonade 7 | # 8 | # Copyright © 2015 Michael Grünewald 9 | # 10 | # This file must be used under the terms of the CeCILL-B. 11 | # This source file is licensed as described in the file COPYING, which 12 | # you should have received as part of this distribution. The terms 13 | # are also available at 14 | # http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt 15 | 16 | INSTALL_PREFIX="${HOME}/.local" 17 | 18 | eval $(opam config env --switch ${TRAVIS_OCAML_VERSION:?}) 19 | 20 | if [ "${TRAVIS_ENABLE_PPX_REWRITER}" = "yes" ]; then 21 | opam install ppx_tools 22 | fi 23 | 24 | autoconf 25 | ./configure --prefix="${INSTALL_PREFIX}" --enable-ppx-rewriter=${TRAVIS_ENABLE_PPX_REWRITER} 26 | bmake -I "${INSTALL_PREFIX}/share/bsdowl" all 27 | bmake -I "${INSTALL_PREFIX}/share/bsdowl" test 28 | 29 | ### End of file `travisci' 30 | -------------------------------------------------------------------------------- /Library/Autoconf/bsdowl.m4: -------------------------------------------------------------------------------- 1 | dnl autoconf macros for BSD Owl 2 | dnl 3 | dnl Copyright © 2015 Michael Grünewald 4 | 5 | # AC_WITH_OCAML_SITE_LIB 6 | # ---------------------- 7 | # Define an option --with-ocaml-site-lib which governs the variable 8 | # WITH_OCAML_SITE_LIB. This variable is substituted. 9 | 10 | AC_DEFUN([AC_WITH_OCAML_SITE_LIB], 11 | [AC_ARG_WITH([ocaml-site-lib], 12 | [AS_HELP_STRING([--with-ocaml-site-lib], 13 | [install under OCaml site-lib's directory])], 14 | [WITH_OCAML_SITE_LIB=${with_ocaml_site_lib}], 15 | [WITH_OCAML_SITE_LIB=no]) 16 | AC_SUBST([WITH_OCAML_SITE_LIB]) 17 | ]) 18 | -------------------------------------------------------------------------------- /Library/Autoconf/ocaml.m4: -------------------------------------------------------------------------------- 1 | dnl autoconf macros for OCaml 2 | dnl 3 | dnl Copyright © 2015 Michael Grünewald 4 | dnl Copyright © 2013 Gabriel Kerneis 5 | dnl Copyright © 2009 Richard W.M. Jones 6 | dnl Copyright © 2009 Stefano Zacchiroli 7 | dnl Copyright © 2000-2005 Olivier Andrieu 8 | dnl Copyright © 2000-2005 Jean-Christophe Filliâtre 9 | dnl Copyright © 2000-2005 Georges Mariano 10 | dnl 11 | dnl For documentation, please read the ocaml.m4 man page. 12 | 13 | 14 | # AC_PROG_OCAML 15 | # ------------- 16 | # This macro detects which tools of the usual OCaml toolchain are 17 | # available. It defines and substitutes the following variables: 18 | # 19 | # OCAMLC set to the name of the bytecode compiler 20 | # (eg. "ocamlc" or "ocamlc.opt"), or "no" if 21 | # no OCaml installation was found 22 | # OCAMLOPT the name of the native-code compiler, eg. "ocamlopt", 23 | # "ocamlopt.opt" or "no" 24 | # OCAMLBEST "byte" (if only the bytecode compiler is available) 25 | # or "opt" (if both bytecode and native code compilers 26 | # are available) 27 | # OCAMLNATDYNLINK "yes" (if native dynlink is available) or "no" 28 | # OCAMLDEP the name of the dependency resolver, eg. "ocamldep" 29 | # OCAMLMKTOP the name of ocamlmktop 30 | # OCAMLMKLIB the name of ocamlmklib 31 | # OCAMLDOC the name of ocamldoc 32 | # OCAMLBUILD the name of ocamlbuild 33 | # OCAMLLIB the OCaml library path (eg. C) 34 | # OCAMLVERSION the compiler version (eg. C<3.11.0>) 35 | 36 | AC_DEFUN([AC_PROG_OCAML], 37 | [dnl 38 | # checking for ocamlc 39 | AC_CHECK_TOOL([OCAMLC],[ocamlc],[no]) 40 | 41 | if test "$OCAMLC" != "no"; then 42 | OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` 43 | AC_MSG_RESULT([OCaml version is $OCAMLVERSION]) 44 | # If OCAMLLIB is set, use it 45 | if test "$OCAMLLIB" = ""; then 46 | OCAMLLIB=`$OCAMLC -where 2>/dev/null | tr -d '\015' || $OCAMLC -v|tail -1|cut -d ' ' -f 4` 47 | else 48 | AC_MSG_RESULT([OCAMLLIB previously set; preserving it.]) 49 | fi 50 | AC_MSG_RESULT([OCaml library path is $OCAMLLIB]) 51 | 52 | AC_SUBST([OCAMLVERSION]) 53 | AC_SUBST([OCAMLLIB]) 54 | 55 | # checking for ocamlopt 56 | AC_CHECK_TOOL([OCAMLOPT],[ocamlopt],[no]) 57 | OCAMLBEST=byte 58 | if test "$OCAMLOPT" = "no"; then 59 | AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.]) 60 | else 61 | TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` 62 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 63 | AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.]) 64 | OCAMLOPT=no 65 | else 66 | OCAMLBEST=opt 67 | fi 68 | fi 69 | 70 | AC_SUBST([OCAMLBEST]) 71 | 72 | # checking for ocamlc.opt 73 | AC_CHECK_TOOL([OCAMLCDOTOPT],[ocamlc.opt],[no]) 74 | if test "$OCAMLCDOTOPT" != "no"; then 75 | TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` 76 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 77 | AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.]) 78 | else 79 | OCAMLC=$OCAMLCDOTOPT 80 | fi 81 | fi 82 | 83 | # checking for ocamlopt.opt 84 | if test "$OCAMLOPT" != "no" ; then 85 | AC_CHECK_TOOL([OCAMLOPTDOTOPT],[ocamlopt.opt],[no]) 86 | if test "$OCAMLOPTDOTOPT" != "no"; then 87 | TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` 88 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 89 | AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.]) 90 | else 91 | OCAMLOPT=$OCAMLOPTDOTOPT 92 | fi 93 | fi 94 | fi 95 | 96 | AC_SUBST([OCAMLOPT]) 97 | fi 98 | 99 | AC_SUBST([OCAMLC]) 100 | 101 | # checking for native dynlink 102 | AC_MSG_CHECKING([for dynlink.cmxa]) 103 | if test -f "$OCAMLLIB/dynlink.cmxa" ; then 104 | OCAMLNATDYNLINK=yes 105 | AC_MSG_RESULT([yes]) 106 | else 107 | OCAMLNATDYNLINK=no 108 | AC_MSG_RESULT([no]) 109 | fi 110 | 111 | AC_SUBST([OCAMLNATDYNLINK]) 112 | 113 | # checking for ocaml toplevel 114 | AC_CHECK_TOOL([OCAML],[ocaml],[no]) 115 | 116 | # checking for ocamldep 117 | AC_CHECK_TOOL([OCAMLDEP],[ocamldep],[no]) 118 | 119 | # checking for ocamlmktop 120 | AC_CHECK_TOOL([OCAMLMKTOP],[ocamlmktop],[no]) 121 | 122 | # checking for ocamlmklib 123 | AC_CHECK_TOOL([OCAMLMKLIB],[ocamlmklib],[no]) 124 | 125 | # checking for ocamldoc 126 | AC_CHECK_TOOL([OCAMLDOC],[ocamldoc],[no]) 127 | 128 | # checking for ocamlbuild 129 | AC_CHECK_TOOL([OCAMLBUILD],[ocamlbuild],[no]) 130 | ]) 131 | 132 | 133 | # AC_PROG_OCAMLLEX 134 | # ---------------- 135 | # This checks for the ocamllex program and sets OCAMLLEX to the name 136 | # of the program (eg. ocamllex or ocamllex.opt), or no if not found. 137 | 138 | AC_DEFUN([AC_PROG_OCAMLLEX], 139 | [dnl 140 | # checking for ocamllex 141 | AC_CHECK_TOOL([OCAMLLEX],[ocamllex],[no]) 142 | if test "$OCAMLLEX" != "no"; then 143 | AC_CHECK_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no]) 144 | if test "$OCAMLLEXDOTOPT" != "no"; then 145 | OCAMLLEX=$OCAMLLEXDOTOPT 146 | fi 147 | fi 148 | AC_SUBST([OCAMLLEX]) 149 | ]) 150 | 151 | 152 | # AC_PROG_OCAMLYACC 153 | # ----------------- 154 | # This checks for the ocamlyacc program and sets OCAMLYACC to the name 155 | # of the program, or no if not found. 156 | 157 | AC_DEFUN([AC_PROG_OCAMLYACC], 158 | [dnl 159 | AC_CHECK_TOOL([OCAMLYACC],[ocamlyacc],[no]) 160 | AC_SUBST([OCAMLYACC]) 161 | ]) 162 | 163 | 164 | # AC_PROG_CAMLP4 165 | # -------------- 166 | # This checks for camlp4, and checks that the version matches the 167 | # compiler version found previously. It sets CAMLP4 to the name of the 168 | # basic camlp4 program, or no if not found. 169 | # 170 | # The macro also checks for other tools of the camlp4 suite like 171 | # camlp4o, camlp4orf, etc. For each of them, a fully capitalized 172 | # variable is set to the tool name (or no if not found); all variable 173 | # are substituted for when filling .in files. The full list of tools 174 | # and respective variable names is as follows: 175 | # 176 | # camlp4 CAMLP4 177 | # camlp4boot CAMLP4BOOT 178 | # camlp4o CAMLP4O 179 | # camlp4of CAMLP4OF 180 | # camlp4oof CAMLP4OOF 181 | # camlp4orf CAMLP4ORF 182 | # camlp4prof CAMLP4PROF 183 | # camlp4r CAMLP4R 184 | # camlp4rf CAMLP4RF 185 | 186 | AC_DEFUN([AC_PROG_CAMLP4], 187 | [dnl 188 | AC_REQUIRE([AC_PROG_OCAML])dnl 189 | 190 | # checking for camlp4 191 | AC_CHECK_TOOL([CAMLP4],[camlp4],[no]) 192 | if test "$CAMLP4" != "no"; then 193 | TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'` 194 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 195 | AC_MSG_RESULT([versions differs from ocamlc]) 196 | CAMLP4=no 197 | fi 198 | fi 199 | AC_SUBST([CAMLP4]) 200 | 201 | # checking for companion tools 202 | AC_CHECK_TOOL([CAMLP4BOOT],[camlp4boot],[no]) 203 | AC_CHECK_TOOL([CAMLP4O],[camlp4o],[no]) 204 | AC_CHECK_TOOL([CAMLP4OF],[camlp4of],[no]) 205 | AC_CHECK_TOOL([CAMLP4OOF],[camlp4oof],[no]) 206 | AC_CHECK_TOOL([CAMLP4ORF],[camlp4orf],[no]) 207 | AC_CHECK_TOOL([CAMLP4PROF],[camlp4prof],[no]) 208 | AC_CHECK_TOOL([CAMLP4R],[camlp4r],[no]) 209 | AC_CHECK_TOOL([CAMLP4RF],[camlp4rf],[no]) 210 | AC_SUBST([CAMLP4BOOT]) 211 | AC_SUBST([CAMLP4O]) 212 | AC_SUBST([CAMLP4OF]) 213 | AC_SUBST([CAMLP4OOF]) 214 | AC_SUBST([CAMLP4ORF]) 215 | AC_SUBST([CAMLP4PROF]) 216 | AC_SUBST([CAMLP4R]) 217 | AC_SUBST([CAMLP4RF]) 218 | ]) 219 | 220 | 221 | # AC_PROG_FINDLIB 222 | # --------------- 223 | # This macro checks for the presence of the ocamlfind program (part of 224 | # findlib). It defines and substitutes OCAMLFIND to the name of the 225 | # ocamlfind program, or no if not found. 226 | 227 | AC_DEFUN([AC_PROG_FINDLIB], 228 | [dnl 229 | AC_REQUIRE([AC_PROG_OCAML])dnl 230 | 231 | # checking for ocamlfind 232 | AC_CHECK_TOOL([OCAMLFIND],[ocamlfind],[no]) 233 | AC_SUBST([OCAMLFIND]) 234 | ]) 235 | 236 | 237 | # AC_CHECK_FINDLIB_PKG(NAME, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) 238 | # -------------------------------------------------------------------- 239 | # This is the main macro that can be used to detect the presence of 240 | # OCaml findlib packages. This macro uses ocamlfind to look up findlib 241 | # packages (and thus requires that findlib itself has been installed, 242 | # and that the package has been properly packaged with a META file 243 | # etc.) If you want to find an OCaml findlib package which hasn't been 244 | # installed with findlib then you should try using 245 | # AC_CHECK_OCAML_MODULE instead. 246 | # 247 | # AC_CHECK_FINDLIB_PKG([name]) 248 | # 249 | # checks for an OCaml findlib package with the given name. 250 | 251 | AC_DEFUN([AC_CHECK_FINDLIB_PKG], 252 | [dnl 253 | AC_REQUIRE([AC_PROG_FINDLIB])dnl 254 | 255 | AC_MSG_CHECKING([for findlib package $1]) 256 | 257 | unset found 258 | unset pkg 259 | found=no 260 | for pkg in $1; do 261 | if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then 262 | AC_MSG_RESULT([found]) 263 | found=yes 264 | break 265 | fi 266 | done 267 | if test "$found" = "no" ; then 268 | AC_MSG_RESULT([not found]) 269 | fi 270 | AS_IF([test "$found" = "no"], [$3], [$2])])dnl 271 | ]) 272 | 273 | 274 | # AC_NEED_FINDLIB_PKG(NAME) 275 | # ------------------------- 276 | # If OCaml findlib package name is not found, then terminate the 277 | # configuration script with an appropriate error message. 278 | 279 | AC_DEFUN([AC_NEED_FINDLIB_PKG], 280 | [AC_CHECK_FINDLIB_PKG([$1], 281 | [], [AC_MSG_ERROR([OCaml findlib package $1 not found.])])]) 282 | 283 | 284 | # AC_CHECK_OCAML_MODULE(VARIABLE,NAME,MODULE,INCLUDE-PATHS) 285 | # --------------------------------------------------------- 286 | # AC_CHECK_OCAML_MODULE is the hairier alternative to 287 | # AC_CHECK_OCAML_PKG. You should always use AC_CHECK_OCAML_PKG and 288 | # ocamlfind/findlib if possible. 289 | # 290 | # The parameters are: 291 | # 292 | # VARIABLE 293 | # This is the environment variable that is set. It will either be 294 | # set to the include path, or to no if the module was not found. 295 | # 296 | # NAME 297 | # This is the name of the module we are looking for. This parameter 298 | # is just used for printing messages, and does not affect how the 299 | # module is found. 300 | # 301 | # MODULE 302 | # This should be an OCaml module name, representing the module name 303 | # being looked up. You can put sub-modules here, 304 | # eg. CalendarLib.Date 305 | # 306 | # INCLUDE-PATHS 307 | # This is the default list of include directories to search, 308 | # eg. +calendar 309 | 310 | AC_DEFUN([AC_CHECK_OCAML_MODULE], 311 | [dnl 312 | AC_MSG_CHECKING([for OCaml module $2]) 313 | 314 | cat > conftest.ml <&5 2>&5 ; then 320 | found=yes 321 | break 322 | fi 323 | done 324 | 325 | if test "$found" ; then 326 | AC_MSG_RESULT([$$1]) 327 | else 328 | AC_MSG_RESULT([not found]) 329 | $1=no 330 | fi 331 | AC_SUBST([$1]) 332 | ]) 333 | 334 | 335 | # AC_CHECK_OCAML_WORD_SIZE 336 | # ------------------------ 337 | # This checks the word size of the OCaml compiler, and sets 338 | # OCAML_WORD_SIZE to either 32 or 64. 339 | 340 | AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], 341 | [dnl 342 | AC_REQUIRE([AC_PROG_OCAML])dnl 343 | AC_MSG_CHECKING([for OCaml compiler word size]) 344 | cat > conftest.ml < conftest.ml <= "4.00.1" 30 | ] 31 | depends: [ 32 | "broken" {>= "0.4.2"} 33 | "bsdowl" {>= "3.0.0"} 34 | "mixture"{>= "1.0.0"} 35 | "ocamlfind" 36 | ] 37 | depexts: [ 38 | [["debian"] ["bmake"]] 39 | [["ubuntu"] ["bmake"]] 40 | [["osx" "macports"] ["bmake"]] 41 | ] 42 | -------------------------------------------------------------------------------- /ppx/Makefile: -------------------------------------------------------------------------------- 1 | ### Makefile -- Project Lemonade 2 | 3 | # Lemonade (https://github.com/michipili/lemonade) 4 | # This file is part of Lemonade 5 | # 6 | # Copyright © 2013–2015 Michael Grünewald 7 | # 8 | # This file must be used under the terms of the CeCILL-B. 9 | # This source file is licensed as described in the file COPYING, which 10 | # you should have received as part of this distribution. The terms 11 | # are also available at 12 | # http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt 13 | 14 | PROGRAM= ppx_lemonade 15 | SRCS= ppx_lemonade.ml 16 | 17 | COMPILE= native 18 | 19 | .include "ocaml.prog.mk" 20 | 21 | ### End of file `Makefile' 22 | -------------------------------------------------------------------------------- /ppx/ppx_lemonade.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade, the sparkling monad library 2 | 3 | Copyright © 2016 Michael Grünewald 4 | Copyright © 2014 Gabriel Radanne, Peter Zotov. 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU Lesser General Public License as 8 | published by the Free Software Foundation, with linking exceptions; 9 | either version 2.1 of the License, or (at your option) any later 10 | version. See COPYING file for details. 11 | 12 | This program is distributed in the hope that it will be useful, but 13 | WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | Lesser General Public License for more details. 16 | 17 | You should have received a copy of the GNU Lesser General Public 18 | License along with this program; if not, write to the Free Software 19 | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 20 | 02111-1307, USA. *) 21 | 22 | open Printf 23 | open Ast_mapper 24 | open Ast_helper 25 | open Asttypes 26 | open Parsetree 27 | open Longident 28 | open Ast_convenience 29 | 30 | module Maybe = 31 | Lemonade_Maybe 32 | 33 | (* Extend String operations. *) 34 | module String = struct 35 | include String 36 | 37 | let is_prefix s t = 38 | length t >= length s && sub t 0 (length s) = s 39 | 40 | let suffix offset t = 41 | sub t offset (length t - offset) 42 | 43 | let split delim t = 44 | let rec loop i = 45 | try 46 | let j = index_from t i delim in 47 | sub t i (j - i) :: loop (j + 1) 48 | with 49 | Not_found -> [sub t i (length t - i)] 50 | in 51 | loop 0 52 | end 53 | 54 | 55 | let extension_node_name = 56 | "lemonade" 57 | 58 | let extension_node_dot = 59 | extension_node_name ^ "." 60 | 61 | let extension_node_prefix = 62 | "__ppx_" ^ extension_node_name ^ "__" 63 | 64 | let newname i = 65 | sprintf "%s%d" extension_node_prefix i 66 | 67 | let with_loc f { txt ; loc } = 68 | (f txt) [@metaloc loc] 69 | 70 | let is_catchall case = 71 | let rec is_catchall_pattern p = 72 | match p.ppat_desc with 73 | | Ppat_any 74 | | Ppat_var _ -> true 75 | | Ppat_alias (p, _) -> is_catchall_pattern p 76 | | _ -> false 77 | in 78 | case.pc_guard = None && is_catchall_pattern case.pc_lhs 79 | 80 | let maybe_add_catchall_case cases = 81 | if not(List.exists is_catchall cases) then 82 | cases @ [Exp.case [%pat? exn] [%expr raise exn]] 83 | else 84 | cases 85 | 86 | let lid_from_extension_id name = 87 | let open Longident in 88 | let names = String.(split '.' name) in 89 | List.fold_left 90 | (fun acc name -> Ldot (acc, name)) 91 | (Lident (List.hd names)) 92 | (List.tl names) 93 | 94 | let lemonade_operators ?(loc = Location.none) = function 95 | | Some("") -> 96 | raise(Location.Error 97 | (Location.errorf "Missing lemonade argument for monadic bind")) 98 | | Some(name) -> 99 | [%expr [%e Exp.ident (lid (name ^ ".bind"))]], 100 | [%expr [%e Exp.ident (lid (name ^ ".return"))]] 101 | | None -> 102 | [%expr bind], 103 | [%expr return] 104 | 105 | let lemonade_extension ?loc txt = 106 | Maybe.map (lemonade_operators ?loc) 107 | (if String.is_prefix extension_node_dot txt then 108 | Some(Some(String.(suffix (length extension_node_dot) txt))) 109 | else if String.is_prefix extension_node_name txt then 110 | Some(None) 111 | else 112 | None) 113 | 114 | (** [p = x] ≡ [__ppx_lemonade_$i = x] *) 115 | let lemonade_bindings lst = 116 | let loop i binding = 117 | { binding with 118 | pvb_pat = (pvar @@ newname i) 119 | [@metaloc binding.pvb_expr.pexp_loc] } 120 | in 121 | List.mapi loop lst 122 | 123 | 124 | (** [p = x] and e ≡ [bind __ppx_lwt_$i (fun p -> e)] *) 125 | let lemonade_binds (bind, return) exploc lst exp = 126 | let rec loop i bindings = 127 | match bindings with 128 | | [] -> exp 129 | | binding :: t -> 130 | let name = 131 | (evar @@ newname i) 132 | [@metaloc binding.pvb_expr.pexp_loc] 133 | in 134 | let f = 135 | [%expr (fun [%p binding.pvb_pat] -> [%e loop (i+1) t])] 136 | [@metaloc binding.pvb_loc] 137 | in 138 | let new_exp = 139 | [%expr [%e bind] [%e name] [%e f]] 140 | [@metaloc exploc] 141 | in 142 | { new_exp with pexp_attributes = binding.pvb_attributes } 143 | in 144 | loop 0 lst 145 | 146 | let lemonade_expression mapper ((bind, return) as monad) exp attributes = 147 | default_loc := exp.pexp_loc; 148 | let pexp_attributes = attributes @ exp.pexp_attributes in 149 | match exp.pexp_desc with 150 | 151 | (** [let%lemonade $p$ = $e$ in $e'$] ≡ [bind $e$ (fun $p$ -> $e'$)] *) 152 | | Pexp_let (Nonrecursive, vbl, expression) -> 153 | let new_exp = 154 | Exp.let_ 155 | Nonrecursive 156 | (lemonade_bindings vbl) 157 | (lemonade_binds monad exp.pexp_loc vbl expression) 158 | in 159 | mapper.expr mapper { new_exp with pexp_attributes } 160 | 161 | 162 | (** [match%lemonade $e$ with $c$] ≡ [bind $e$ (function $c$)] 163 | [match%lemonade $e$ with exception $x$ | $c$] ≡ [try_bind (fun () -> $e$) (function $c$) (function $x$)] *) 164 | | Pexp_match (e, cases) -> 165 | let exns, cases = 166 | List.partition 167 | begin function 168 | | { pc_lhs = [%pat? exception [%p? _]] } -> true 169 | | _ -> false 170 | end 171 | cases 172 | in 173 | let exns = 174 | List.map 175 | begin function 176 | | { pc_lhs = [%pat? exception [%p? pat]]} as case -> { case with pc_lhs = pat } 177 | | _ -> assert false 178 | end 179 | exns 180 | in 181 | let exns = maybe_add_catchall_case exns in 182 | let new_exp = 183 | match exns with 184 | | [] -> [%expr bind [%e e] [%e Exp.function_ cases]] 185 | | _ -> [%expr 186 | match [%e e] with 187 | | exception exn -> [%e Exp.function_ exns] exn 188 | | m -> [%e bind] m [%e Exp.function_ cases]] 189 | in 190 | mapper.expr mapper { new_exp with pexp_attributes } 191 | 192 | (** [while%lemonade $cond$ do $body$ done] ≡ 193 | [let rec __ppx_lwt_loop () = 194 | if $cond$ then Lwt.bind $body$ __ppx_lwt_loop 195 | else Lwt.return () 196 | in __ppx_lwt_loop] 197 | *) 198 | | Pexp_while (cond, body) -> 199 | let new_exp = 200 | [%expr 201 | let rec __ppx_lemonade_loop () = 202 | if [%e cond] then [%e bind] [%e body] __ppx_lemonade_loop 203 | else [%e return] () 204 | in 205 | __ppx_lemonade_loop ()] 206 | in 207 | mapper.expr mapper { new_exp with pexp_attributes } 208 | 209 | (** [for%lemonade $p$ = $start$ (to|downto) $end$ do $body$ done] ≡ 210 | [let __ppx_lwt_bound = $end$ in 211 | let rec __ppx_lwt_loop $p$ = 212 | if $p$ COMP __ppx_lwt_bound then Lwt.return () 213 | else Lwt.bind $body$ (fun () -> __ppx_lwt_loop ($p$ OP 1)) 214 | in __ppx_lwt_loop $start$] *) 215 | | Pexp_for (({ ppat_desc = Ppat_var p_var} as p), start, bound, dir, body) -> 216 | let comp, binop = match dir with 217 | | Upto -> evar ">", evar "+" 218 | | Downto -> evar "<", evar "-" 219 | in 220 | let q = with_loc evar p_var in 221 | let exp_bound = [%expr __ppx_lemonade_bound] [@metaloc bound.pexp_loc] in 222 | let pat_bound = [%pat? __ppx_lemonade_bound] [@metaloc bound.pexp_loc] in 223 | let new_exp = 224 | [%expr 225 | let [%p pat_bound] : int = [%e bound] in 226 | let rec __ppx_lemonade_loop [%p p] = 227 | if [%e comp] [%e q] [%e exp_bound] then 228 | [%e return] () 229 | else 230 | [%e bind] [%e body] (fun () -> __ppx_lemonade_loop ([%e binop] [%e q] 1)) 231 | in 232 | __ppx_lemonade_loop [%e start] 233 | ] 234 | in 235 | mapper.expr mapper { new_exp with pexp_attributes } 236 | 237 | 238 | (** [try%lemonade $e$ with $c$] ≡ 239 | [catch (fun () -> $e$) (function $c$)] 240 | *) 241 | | Pexp_try (expr, cases) -> 242 | let cases = maybe_add_catchall_case cases in 243 | let new_exp = 244 | [%expr try [%e expr] () with exn -> [%e Exp.function_ cases] exn] 245 | in 246 | mapper.expr mapper { new_exp with pexp_attributes } 247 | 248 | (** [if%lemonade $c$ then $e1$ else $e2$] ≡ 249 | [match%lemonade $c$ with true -> $e1$ | false -> $e2$] 250 | [if%lemonade $c$ then $e1$] ≡ 251 | [match%lemonade $c$ with true -> $e1$ | false -> Lwt.return_unit] 252 | *) 253 | | Pexp_ifthenelse (cond, e1, e2) -> 254 | let e2 = 255 | match e2 with 256 | | Some e -> e 257 | | None -> [%expr [%e return] ()] 258 | in 259 | let cases = [ 260 | Exp.case [%pat? true] e1 ; 261 | Exp.case [%pat? false] e2 ; 262 | ] 263 | in 264 | let new_exp = [%expr [%e bind] [%e cond] [%e Exp.function_ cases]] in 265 | mapper.expr mapper { new_exp with pexp_attributes } 266 | 267 | | _ -> mapper.expr mapper exp 268 | 269 | let lemonade_mapper argv = 270 | let open Ast_mapper in 271 | let super = default_mapper in 272 | let expr this e = 273 | match e with 274 | | { pexp_desc = Pexp_extension ({ txt = id; loc }, PStr [{ pstr_desc = Pstr_eval (exp, attr) }]) } -> 275 | (match lemonade_extension ~loc id with 276 | | Some(monad) -> lemonade_expression this monad exp attr 277 | | None -> super.expr this e) 278 | | _ -> super.expr this e 279 | in 280 | { default_mapper with expr } 281 | 282 | let () = Ast_mapper.run_main lemonade_mapper 283 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | ### Makefile -- Monads 2 | 3 | # Lemonade (https://github.com/michipili/lemonade) 4 | # This file is part of Lemonade 5 | # 6 | # Copyright © 2013–2015 Michael Grünewald 7 | # 8 | # This file must be used under the terms of the CeCILL-B. 9 | # This source file is licensed as described in the file COPYING, which 10 | # you should have received as part of this distribution. The terms 11 | # are also available at 12 | # http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt 13 | 14 | LIBRARY= lemonade 15 | 16 | SRCS= lemonade_Type.ml 17 | SRCS+= lemonade_Continuation.ml 18 | SRCS+= lemonade_Lazy.ml 19 | SRCS+= lemonade_List.ml 20 | SRCS+= lemonade_Maybe.ml 21 | SRCS+= lemonade_Ok.ml 22 | SRCS+= lemonade_Reader.ml 23 | SRCS+= lemonade_Retry.ml 24 | SRCS+= lemonade_State.ml 25 | SRCS+= lemonade_Stream.ml 26 | SRCS+= lemonade_Success.ml 27 | SRCS+= lemonade_Writer.ml 28 | 29 | .include "ocaml.lib.mk" 30 | 31 | ### End of file `Makefile' 32 | -------------------------------------------------------------------------------- /src/lemonade_Continuation.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Continuation -- The continuation monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module type FinalType = 15 | sig 16 | type t 17 | end 18 | 19 | module type S = 20 | sig 21 | type final 22 | type 'a t = ('a -> final) -> final 23 | include Lemonade_Type.S 24 | with type 'a t := 'a t 25 | val call_cc : (('a -> 'b t) -> 'a t) -> 'a t 26 | end 27 | 28 | module Make(Final:FinalType) = 29 | struct 30 | type final = Final.t 31 | module Basis = 32 | struct 33 | type 'a t = ('a -> final) -> final 34 | 35 | let return x = 36 | fun cont -> cont x 37 | 38 | let bind m f = 39 | fun cont -> m (fun x -> (f x) cont) 40 | end 41 | 42 | module MethodsMonad = 43 | Mixture_Monad.Make(Basis) 44 | 45 | include Basis 46 | include MethodsMonad 47 | 48 | let call_cc kont = 49 | fun cont -> kont (fun x -> (fun _ -> cont x)) cont 50 | end 51 | -------------------------------------------------------------------------------- /src/lemonade_Continuation.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Continuation -- The continuation monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** Continuation monad. 15 | 16 | The Continuation monad represents computations in 17 | continuation-passing style (CPS). In continuation-passing style 18 | function result is not returned, but instead is passed to another 19 | function, received as a parameter (continuation). Computations are 20 | built up from sequences of nested continuations, terminated by a 21 | final continuation (often {i id}) which produces the final 22 | result. Since continuations are functions which represent the 23 | future of a computation, manipulation of the continuation 24 | functions can achieve complex manipulations of the future of the 25 | computation, such as interrupting a computation in the middle, 26 | aborting a portion of a computation, restarting a computation, and 27 | interleaving execution of computations. The Continuation monad 28 | adapts CPS to the structure of a monad. *) 29 | 30 | 31 | (** The input signature of the functor [Lemonade_Continuation.Make]. *) 32 | module type FinalType = 33 | sig 34 | type t 35 | end 36 | 37 | 38 | (** The output signature of the functor [Lemonade_Continuation.Make]. *) 39 | module type S = 40 | sig 41 | (** The final type. *) 42 | type final 43 | 44 | (** The type of continuations. *) 45 | type 'a t = ('a -> final) -> final 46 | 47 | include Lemonade_Type.S 48 | with type 'a t := 'a t 49 | 50 | val call_cc : (('a -> 'b t) -> 'a t) -> 'a t 51 | (** Call with current continuation. *) 52 | end 53 | 54 | (** Functor building an implementation of the [Success] monad. *) 55 | module Make(Final:FinalType): 56 | S with type final = Final.t 57 | -------------------------------------------------------------------------------- /src/lemonade_Lazy.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Lazy -- The classic lazy monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module Basis = 15 | struct 16 | 17 | type (+'a) t = 18 | 'a Lazy.t 19 | 20 | let bind m f = 21 | lazy (Lazy.force (f (Lazy.force m))) 22 | 23 | let return x = 24 | lazy x 25 | 26 | end 27 | 28 | module MethodsMonad = 29 | Mixture_Monad.Make(Basis) 30 | 31 | include Basis 32 | include MethodsMonad 33 | 34 | let exec m = 35 | Lazy.force m 36 | 37 | let pp_print f pp m = 38 | let open Format in 39 | if Lazy.is_val m then 40 | fprintf pp "Lazy(%a)" f (Lazy.force m) 41 | else 42 | fprintf pp "Lazy()" 43 | 44 | 45 | module T(M:Mixture_Monad.S) = 46 | struct 47 | 48 | module Germ = 49 | struct 50 | 51 | type 'a t = 52 | 'a Lazy.t M.t 53 | 54 | let bind m f = 55 | M.bind m (fun x -> (f (Lazy.force x))) 56 | 57 | let return x = 58 | M.return(lazy x) 59 | 60 | end 61 | 62 | include Mixture_Monad.Transformer.Make(Basis)(M)(Germ) 63 | end 64 | -------------------------------------------------------------------------------- /src/lemonade_Lazy.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Lazy -- The classic lazy monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** The classic lazy monad. *) 15 | 16 | type (+'a) t = 17 | 'a Lazy.t 18 | 19 | include Lemonade_Type.S 20 | with type 'a t := 'a t 21 | 22 | (** Execute the computation. *) 23 | val exec : 'a t -> 'a 24 | 25 | val pp_print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a Lazy.t -> unit 26 | (** A generic printer for lazy values. *) 27 | 28 | (** The lazy monad transformer. *) 29 | module T(M:Lemonade_Type.S) : 30 | sig 31 | include Lemonade_Type.S 32 | with type 'a t = 'a Lazy.t M.t 33 | 34 | val lift : 'a M.t -> 'a t 35 | end 36 | -------------------------------------------------------------------------------- /src/lemonade_List.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_List -- The classic list monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module Basis = 15 | struct 16 | 17 | type (+'a) t = 18 | 'a list 19 | 20 | let bind lst f = 21 | List.concat (List.map f lst) 22 | 23 | let return x = 24 | [ x ] 25 | 26 | end 27 | 28 | module MethodsMonad = Mixture_Monad.Make(Basis) 29 | 30 | include Basis 31 | include MethodsMonad 32 | 33 | 34 | let pp_print f ff lst = 35 | let open Format in 36 | let flag = ref false in 37 | let loop item = 38 | if !flag then fprintf ff ";@ "; 39 | flag := true; 40 | fprintf ff "%a" f item 41 | in 42 | fprintf ff "@[["; 43 | List.iter loop lst; 44 | fprintf ff "]@]" 45 | 46 | 47 | module T(M:Mixture_Monad.S) = 48 | struct 49 | 50 | module Germ = 51 | struct 52 | 53 | type 'a t = 54 | 'a list M.t 55 | 56 | let bind m f = 57 | M.bind m 58 | (fun lst -> 59 | (M.map List.concat) 60 | (M.dist (List.map f lst))) 61 | let return x = 62 | M.return([x]) 63 | 64 | end 65 | 66 | include Mixture_Monad.Transformer.Make(Basis)(M)(Germ) 67 | end 68 | -------------------------------------------------------------------------------- /src/lemonade_List.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_List -- The classic list monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** List monad. *) 15 | 16 | type (+'a) t = 17 | 'a list 18 | 19 | include Lemonade_Type.S 20 | with type 'a t := 'a t 21 | 22 | val pp_print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit 23 | (** A generic printer for list values. *) 24 | 25 | (** The list monad transformer. *) 26 | module T(M:Lemonade_Type.S) : 27 | sig 28 | include Lemonade_Type.S 29 | with type 'a t = 'a list M.t 30 | 31 | val lift : 'a M.t -> 'a t 32 | end 33 | -------------------------------------------------------------------------------- /src/lemonade_Maybe.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Maybe -- The classic maybe monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | 15 | module Basis = 16 | struct 17 | 18 | type (+'a) t = 19 | 'a option 20 | 21 | let bind opt f = 22 | match opt with 23 | | Some(x) -> f x 24 | | None -> None 25 | 26 | let return x = 27 | Some(x) 28 | 29 | end 30 | 31 | let pp_print f pp m = 32 | let open Format in 33 | match m with 34 | | Some(x) -> fprintf pp "Some(%a)" f x 35 | | None -> fprintf pp "None" 36 | 37 | let is_some = function 38 | | Some(_) -> true 39 | | None -> false 40 | 41 | let is_none = function 42 | | Some(_) -> false 43 | | None -> true 44 | 45 | let find = function 46 | | Some(b) -> b 47 | | None -> raise Not_found 48 | 49 | let default a = function 50 | | Some(b) -> b 51 | | None -> a 52 | 53 | let of_list = function 54 | | [] -> None 55 | | a :: _ -> Some(a) 56 | 57 | let to_list = function 58 | | Some(a) -> [a] 59 | | None -> [] 60 | 61 | let filter_map f lst = 62 | List.rev 63 | (List.fold_left 64 | (fun acc x -> match f x with 65 | | Some(a) -> a :: acc 66 | | None -> acc) [] lst) 67 | 68 | let filter lst = 69 | filter_map (fun x -> x) lst 70 | 71 | module MethodsMonad = 72 | Mixture_Monad.Make(Basis) 73 | 74 | include Basis 75 | include MethodsMonad 76 | 77 | module T(M:Mixture_Monad.S) = 78 | struct 79 | 80 | module Germ = 81 | struct 82 | 83 | type 'a t = 84 | 'a option M.t 85 | 86 | let bind m f = 87 | M.bind m 88 | (function 89 | | None -> M.return None 90 | | Some(x) -> f x) 91 | 92 | let return x = 93 | M.return(Some(x)) 94 | 95 | end 96 | 97 | 98 | include Mixture_Monad.Transformer.Make(Basis)(M)(Germ) 99 | end 100 | -------------------------------------------------------------------------------- /src/lemonade_Maybe.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Maybe -- The classic maybe monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** The classic maybe monad. *) 15 | 16 | type (+'a) t = 17 | 'a option 18 | 19 | val pp_print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit 20 | (** A generic printer for option values. *) 21 | 22 | val is_some : 'a option -> bool 23 | (** Predicate recognising options containing a value. *) 24 | 25 | val is_none : 'a option -> bool 26 | (** Predicate recognising empty options. *) 27 | 28 | val find : 'a option -> 'a 29 | (** Return the value held by an option or raise [Not_found] if the 30 | option is empty. *) 31 | 32 | val default : 'a -> 'a option -> 'a 33 | (** [default val opt] return the content of [opt] or [val] if it is empty. *) 34 | 35 | val of_list : 'a list -> 'a option 36 | (** Return an option containing the first element of the list if any, 37 | or empty if the list is empty. *) 38 | 39 | val to_list : 'a option -> 'a list 40 | (** Return a list containing the element held by the option if any, ot 41 | the empty list ifthe option is empty. *) 42 | 43 | val filter : 'a option list -> 'a list 44 | (** [filter lst] is the list of values held by the options in [lst]. *) 45 | 46 | val filter_map : ('a -> 'b option) -> 'a list -> 'b list 47 | (** [filter_map f lst] is the list deduced from [lst] by applying [f] 48 | to element of the list and retaining the values held by the list. *) 49 | 50 | include Lemonade_Type.S 51 | with type 'a t := 'a t 52 | 53 | (** The maybe monad transformer. *) 54 | module T(M:Lemonade_Type.S) : 55 | sig 56 | include Lemonade_Type.S 57 | with type 'a t = 'a option M.t 58 | 59 | val lift : 'a M.t -> 'a t 60 | end 61 | -------------------------------------------------------------------------------- /src/lemonade_Ok.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Ok -- A variant of the success monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | open Printf 14 | 15 | module Basis : sig 16 | type 'a t = [ `Ok of 'a | `Error of string ] 17 | val bind : 'a t -> ('a -> 'b t) -> 'b t 18 | val return : 'a -> 'a t 19 | end = struct 20 | type 'a t = [ `Ok of 'a | `Error of string ] 21 | 22 | let bind m (f : 'a -> 'b t) = 23 | match m with 24 | |`Ok(x) -> f x 25 | |`Error(_) as error -> error 26 | 27 | let return x = 28 | `Ok(x) 29 | end 30 | 31 | module Methods = 32 | Mixture_Monad.Make(Basis) 33 | 34 | include Basis 35 | include Methods 36 | 37 | let run = function 38 | |`Ok(whatever) -> whatever 39 | |`Error(mesg) -> ksprintf failwith "Error: %s" mesg 40 | 41 | let error mesg = 42 | `Error(mesg) 43 | 44 | let errorf fmt = 45 | ksprintf (fun mesg -> `Error mesg) fmt 46 | 47 | let pp_print f pp = function 48 | | `Ok(x) -> Format.fprintf pp "`Ok(%a)" f x 49 | | `Error(mesg) -> Format.fprintf pp "`Error(%S)" mesg 50 | 51 | module T(M:Mixture_Monad.S) = 52 | struct 53 | module Germ : sig 54 | type 'a t = [ `Ok of 'a | `Error of string ] M.t 55 | val bind : 'a t -> ('a -> 'b t) -> 'b t 56 | val return : 'a -> 'a t 57 | end = struct 58 | 59 | type 'a t = 60 | 'a Basis.t M.t 61 | 62 | let bind m f = 63 | M.bind m 64 | (function 65 | | `Ok(x) -> f x 66 | | `Error(err) -> M.return (`Error(err))) 67 | 68 | let return x = 69 | M.return(`Ok(x)) 70 | end 71 | 72 | include Mixture_Monad.Transformer.Make(Basis)(M)(Germ) 73 | end 74 | -------------------------------------------------------------------------------- /src/lemonade_Ok.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Ok -- A variant of the success monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** A widely spread variant of the success monad. 15 | 16 | It is mainly useful when working with Yojson. *) 17 | 18 | type (+'a) t = 19 | [ `Error of string | `Ok of 'a ] 20 | (** The type of monads computing a value of type ['a] or failing with 21 | an error message. *) 22 | 23 | include Lemonade_Type.S 24 | with type 'a t := 'a t 25 | 26 | val error : string -> 'a t 27 | (** A computation failed with the given error message. *) 28 | 29 | val errorf : ('a, unit, string, 'b t) format4 -> 'a 30 | (** A computation failed with the given error message, formatted by sprintf. *) 31 | 32 | val run : 'a t -> 'a 33 | (** [run m] return the value computed by [m] if [m] succeeded or throw 34 | a [Failure] exception with the given message otherwise. *) 35 | 36 | val pp_print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit 37 | (** A generic printer for monadic values. *) 38 | 39 | 40 | 41 | (** The maybe monad transformer. *) 42 | module T(M:Lemonade_Type.S) : 43 | sig 44 | include Lemonade_Type.S 45 | with type 'a t = [ `Error of string | `Ok of 'a ] M.t 46 | 47 | val lift : 'a M.t -> 'a t 48 | end 49 | -------------------------------------------------------------------------------- /src/lemonade_Reader.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Reader -- The classic reader monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module type EnvironmentType = 15 | sig 16 | type t 17 | end 18 | 19 | 20 | module type S = 21 | sig 22 | type environment 23 | include Lemonade_Type.S 24 | val read : environment t 25 | val run : environment -> 'a t -> 'a 26 | val local : (environment -> environment) -> 'a t -> 'a t 27 | val access : (environment -> 'a) -> 'a t 28 | end 29 | 30 | 31 | module Make(Environment:EnvironmentType) = 32 | struct 33 | type environment = Environment.t 34 | module Basis = 35 | struct 36 | type 'a t = 37 | environment -> 'a 38 | 39 | let return x = 40 | fun _ -> x 41 | 42 | let bind m f = 43 | fun env -> f (m env) env 44 | end 45 | 46 | module MethodsMonad = 47 | Mixture_Monad.Make(Basis) 48 | 49 | include Basis 50 | include MethodsMonad 51 | 52 | let read = 53 | fun env -> env 54 | 55 | let run env m = 56 | m env 57 | 58 | let local f m = 59 | fun env -> m (f env) 60 | 61 | let access f = 62 | fun env -> f env 63 | 64 | 65 | module T(M:Lemonade_Type.S) = 66 | struct 67 | type environment = Environment.t 68 | 69 | module BasisT = 70 | struct 71 | type 'a t = 72 | environment -> 'a M.t 73 | let return x = 74 | fun _ -> M.return x 75 | let bind m f = 76 | fun env -> M.bind (m env) (fun x -> f x env) 77 | end 78 | 79 | module MethodsMonadT = 80 | Mixture_Monad.Make(BasisT) 81 | 82 | include BasisT 83 | include MethodsMonadT 84 | 85 | let read = 86 | fun env -> M.return env 87 | 88 | let run env m = 89 | m env 90 | 91 | let local f m = 92 | fun env -> m (f env) 93 | 94 | let access f = 95 | fun env -> M.return(f env) 96 | 97 | let lift m = 98 | fun _ -> m 99 | end 100 | end 101 | -------------------------------------------------------------------------------- /src/lemonade_Reader.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Reader -- The classic reader monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** Reader monad. 15 | 16 | Values in a {i Reader} monad or {i Environment monad} represent a 17 | computation, which can read values from a shared environment, pass 18 | values from function to function, and execute sub-computations in 19 | a modified environment. Using a {i Reader} monad for such 20 | computations is often clearer and easier than using a {i State} 21 | monad. *) 22 | 23 | (** The input signature of the functor [Lemonade_Reader.Make]. *) 24 | module type EnvironmentType = 25 | sig 26 | type t 27 | (** The type of data consumed in a reader monad. *) 28 | end 29 | 30 | (** The output signature of the functor [Lemonade_Reader.Make]. *) 31 | module type S = 32 | sig 33 | type environment 34 | (** The type of consumed data. *) 35 | 36 | include Lemonade_Type.S 37 | 38 | val read : environment t 39 | (** Access the current environment. *) 40 | 41 | val run : environment -> 'a t -> 'a 42 | (** Perform a computation in the given environment errors. *) 43 | 44 | val local : (environment -> environment) -> 'a t -> 'a t 45 | (** Execute a computation in a modified environment. *) 46 | 47 | val access : (environment -> 'a) -> 'a t 48 | (** Access to a component of the current environment. *) 49 | 50 | end 51 | 52 | (** Functor building an implementation of the [Success] monad. *) 53 | module Make(Environment:EnvironmentType): 54 | sig 55 | include S 56 | with type environment = Environment.t 57 | 58 | (** The success monad transformer. *) 59 | module T(M:Lemonade_Type.S): sig 60 | type environment = Environment.t 61 | (** The type of consumed data. *) 62 | 63 | include Lemonade_Type.S 64 | with type 'a t = 'a M.t t 65 | 66 | val read : environment t 67 | (** Access the current environment. *) 68 | 69 | val run : environment -> 'a t -> 'a M.t 70 | (** Perform a computation in the given environment errors. *) 71 | 72 | val local : (environment -> environment) -> 'a t -> 'a t 73 | (** Execute a computation in a modified environment. *) 74 | 75 | val access : (environment -> 'a) -> 'a t 76 | (** Access to a component of the current environment. *) 77 | 78 | val lift : 'a M.t -> 'a t 79 | (** Add an environment to a monad of type ['a M.t]. *) 80 | end 81 | end 82 | -------------------------------------------------------------------------------- /src/lemonade_Retry.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Retry -- The retry monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module type RetryType = 15 | sig 16 | type error 17 | type tag 18 | type environment 19 | val policy : (tag * 'a) list -> environment -> (tag * 'a) list 20 | end 21 | 22 | module type S = 23 | sig 24 | type error 25 | type tag 26 | type environment 27 | type (+'a) outcome = 28 | | Success of 'a 29 | | Error of error 30 | 31 | include Mixture_Monad.S 32 | 33 | val throw : error -> 'a t 34 | val catch : 'a t -> (error -> 'a t) -> 'a t 35 | val retry : tag -> (environment -> 'a t) -> 'a t -> 'a t 36 | val run : environment -> 'a t -> 'a outcome 37 | end 38 | 39 | module Make(Retry:RetryType) = 40 | struct 41 | 42 | type error = 43 | Retry.error 44 | 45 | type tag = 46 | Retry.tag 47 | 48 | type environment = 49 | Retry.environment 50 | 51 | type (+'a) outcome = 52 | | Success of 'a 53 | | Error of error 54 | 55 | 56 | module Basis = 57 | struct 58 | type (+'a) t = 59 | | SUCCESS of 'a 60 | | ERROR of ((tag *(environment -> 'a t)) list) * error 61 | 62 | let return x = 63 | SUCCESS(x) 64 | 65 | let rec bind m f = 66 | match m with 67 | | SUCCESS(x) -> f x 68 | | ERROR(plan, err) -> ERROR(List.map (bind_strategy f) plan, err) 69 | and bind_strategy f (tag, strategy) = 70 | (tag, fun env -> bind (strategy env) f) 71 | end 72 | 73 | module MethodsMonad = 74 | Mixture_Monad.Make(Basis) 75 | 76 | include Basis 77 | include MethodsMonad 78 | 79 | let throw err = 80 | ERROR([], err) 81 | 82 | let catch m handler = 83 | match m with 84 | | SUCCESS(x) -> SUCCESS(x) 85 | | ERROR(_, err) -> handler err 86 | 87 | let retry tag f = function 88 | | ERROR(plan, err) -> ERROR((tag, f) :: plan, err) 89 | | whatever -> whatever 90 | 91 | let rec run env = function 92 | | SUCCESS(x) -> Success(x) 93 | | ERROR([], err) -> Error(err) 94 | | ERROR(plan, err) -> _run env err (Retry.policy plan env) 95 | and _run env err = function 96 | | [] -> Error(err) 97 | | (_,f) :: tl -> 98 | match run env (f env) with 99 | | Error(_) -> run env (ERROR(tl, err)) 100 | | whatever -> whatever 101 | end 102 | -------------------------------------------------------------------------------- /src/lemonade_Retry.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Retry -- The retry monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** Retry monad. 15 | 16 | The retry monad is a monad in which one can run computations 17 | throwing errors, which can be handled by retry strategies 18 | according to a policy. This is implemented as a functor 19 | parametrised by the error type and the policy. 20 | 21 | Note that the [throw] and [catch] operations defined below are 22 | totally independant of exceptions. *) 23 | 24 | (** The input signature of the functor [Lemonade_Retry.Make]. *) 25 | module type RetryType = 26 | sig 27 | type error 28 | (** The type of error messages. *) 29 | 30 | type tag 31 | (** The type of tags identifying retry strategies. *) 32 | 33 | type environment 34 | (** The type of computation environment. *) 35 | 36 | val policy : (tag * 'a) list -> environment -> (tag * 'a) list 37 | (** The type of policies, used to select a retry strategy. 38 | 39 | The policy filters applyable retry strategies under a given 40 | environment. *) 41 | end 42 | 43 | (** The output signature of the functor [Lemonade_Retry.Make]. *) 44 | module type S = 45 | sig 46 | type error 47 | (** The type of error messages. *) 48 | 49 | type tag 50 | (** The type of tags identifying retry strategies. *) 51 | 52 | type environment 53 | (** The type of computation environment. *) 54 | 55 | (** The type of computations throwing errors. *) 56 | type (+'a) outcome = 57 | | Success of 'a 58 | | Error of error 59 | 60 | include Lemonade_Type.S 61 | 62 | val throw : error -> 'a t 63 | (** Throw the given error. *) 64 | 65 | val catch : 'a t -> (error -> 'a t) -> 'a t 66 | (** [catch m handler] is a monad containing the same value as [m] 67 | and thrown errors are interepreted by the [handler]. *) 68 | 69 | val retry : tag -> (environment -> 'a t) -> 'a t -> 'a t 70 | (** [retry tag strategy m] compute the same value as [m] having the 71 | chance let the retry policy use [strategy] on errors. *) 72 | 73 | val run : environment -> 'a t -> 'a outcome 74 | (** Run the given retryable computation. *) 75 | end 76 | 77 | (** Functor building an implementation of the [Retry] monad. *) 78 | module Make(Retry:RetryType) : S 79 | with type error = Retry.error 80 | and type tag = Retry.tag 81 | and type environment = Retry.environment 82 | -------------------------------------------------------------------------------- /src/lemonade_State.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_State -- The classic state monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module type StateType = 15 | sig 16 | type t 17 | end 18 | 19 | module type S = 20 | sig 21 | type state 22 | type (+'a) t 23 | include Lemonade_Type.S 24 | with type 'a t := 'a t 25 | val state : (state -> (state * 'a)) -> 'a t 26 | val read : state t 27 | val write : state -> unit t 28 | val modify : (state -> state) -> unit t 29 | val run : 'a t -> state -> (state * 'a) 30 | val eval : 'a t -> state -> 'a 31 | val exec : 'a t -> state -> state 32 | val maps : (state * 'a -> state * 'b) -> 'a t -> 'b t 33 | val with_state : (state -> state) -> 'a t -> 'a t 34 | end 35 | 36 | module Make(State:StateType) = 37 | struct 38 | type state = State.t 39 | module Basis = 40 | struct 41 | type 'a t = 42 | state -> (state * 'a) 43 | 44 | let return x = 45 | fun s -> (s, x) 46 | 47 | let bind m f = 48 | fun state -> let state',x = m state in f x state' 49 | end 50 | 51 | module MethodsMonad = 52 | Mixture_Monad.Make(Basis) 53 | 54 | include Basis 55 | include MethodsMonad 56 | 57 | let state m = 58 | m 59 | 60 | let read = 61 | fun state -> (state, state) 62 | 63 | let write x = 64 | fun _ -> (x,()) 65 | 66 | let modify f = 67 | bind read (fun s -> write (f s)) 68 | 69 | let run m state = 70 | m state 71 | 72 | let eval m state = 73 | snd (m state) 74 | 75 | let exec m state = 76 | fst (m state) 77 | 78 | let maps f m = 79 | fun state -> f(m state) 80 | 81 | let with_state f m = 82 | fun state -> m (f state) 83 | 84 | 85 | module T(M:Lemonade_Type.S) = 86 | struct 87 | type state = State.t 88 | 89 | module BasisT = 90 | struct 91 | type 'a t = 92 | state -> (state * 'a) M.t 93 | 94 | let return x = 95 | fun s -> M.return (s, x) 96 | 97 | let bind m f = 98 | fun state -> M.bind(m state)(fun (state', x) -> (f x) state') 99 | end 100 | 101 | module MethodsMonadT = 102 | Mixture_Monad.Make(BasisT) 103 | 104 | include BasisT 105 | include MethodsMonadT 106 | 107 | let state m = 108 | fun state -> M.return (m state) 109 | 110 | let read = 111 | fun state -> M.return(state, state) 112 | 113 | let write x = 114 | fun state -> M.return(x,()) 115 | 116 | let modify f = 117 | bind read (fun s -> write (f s)) 118 | 119 | let run m state = 120 | m state 121 | 122 | let eval m state = 123 | M.map snd (m state) 124 | 125 | let exec m state = 126 | M.map fst (m state) 127 | 128 | let maps f m = 129 | fun state -> (M.map f) (m state) 130 | 131 | let with_state f m = 132 | fun state -> m (f state) 133 | 134 | let lift m = 135 | fun state -> M.map (fun x -> (state,x)) m 136 | end 137 | end 138 | -------------------------------------------------------------------------------- /src/lemonade_State.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_State -- The classic state monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** State monad. *) 15 | 16 | (** The input signature of the functor [Lemonade_State.Make]. *) 17 | module type StateType = 18 | sig 19 | type t 20 | (** The type of states carried by the monad. *) 21 | end 22 | 23 | 24 | (** The output signature of the functor [Lemonade_State.Make]. *) 25 | module type S = 26 | sig 27 | type state 28 | (** The type of states carried by the monad. *) 29 | 30 | type (+'a) t 31 | (** The type of computations of an ['a], carrying a state of type 32 | [state]. *) 33 | 34 | include Lemonade_Type.S 35 | with type 'a t := 'a t 36 | 37 | val state : (state -> (state * 'a)) -> 'a t 38 | (** Embed a simple state action in the monad. *) 39 | 40 | val read : state t 41 | (** Return the state from the internals of the monad. *) 42 | 43 | val write : state -> unit t 44 | (** Replace the state inside the monad. *) 45 | 46 | val modify : (state -> state) -> unit t 47 | (** Maps an old state to a new state inside a state monad. The old 48 | state is discarded. *) 49 | 50 | val run : 'a t -> state -> (state * 'a) 51 | (** Unwrap a computation in the state monad as a function. (The 52 | converse of state.). *) 53 | 54 | val eval : 'a t -> state -> 'a 55 | (** Evaluate a state computation with the given initial state and 56 | return the final value, discarding the final state. *) 57 | 58 | val exec : 'a t -> state -> state 59 | (** Evaluate a state computation with the given initial state and 60 | return the final state, discarding the final value. *) 61 | 62 | val maps : (state *'a -> state * 'b) -> 'a t -> 'b t 63 | (** Map both the return value and final state of a computation using 64 | the given function. 65 | 66 | {b Note:} The derivation of the notation [maps] is similar to 67 | the derivation of the notation [mapi] from the standard 68 | library.*) 69 | 70 | val with_state : (state -> state) -> 'a t -> 'a t 71 | (** [with_state f m] is the monad executing action [m] on a state 72 | modified by applying [f]. *) 73 | end 74 | 75 | (** Functor building an implementation of the [State] monad. *) 76 | module Make(State:StateType) : 77 | sig 78 | include S 79 | with type state = State.t 80 | 81 | (** The state monad transformer. *) 82 | module T(M:Lemonade_Type.S): sig 83 | type state = State.t 84 | include Lemonade_Type.S 85 | 86 | val state : (state -> (state * 'a)) -> 'a t 87 | (** Embed a simple state action in the monad. *) 88 | 89 | val read : state t 90 | (** Return the state from the internals of the monad. *) 91 | 92 | val write : state -> unit t 93 | (** Replace the state inside the monad. *) 94 | 95 | val modify : (state -> state) -> unit t 96 | (** Maps an old state to a new state inside a state monad. The old 97 | state is discarded. *) 98 | 99 | val run : 'a t -> state -> (state * 'a) M.t 100 | (** Unwrap a computation in the state monad as a function. (The 101 | converse of state.). *) 102 | 103 | val eval : 'a t -> state -> 'a M.t 104 | (** Evaluate a state computation with the given initial state and 105 | return the final value, discarding the final state. *) 106 | 107 | val exec : 'a t -> state -> state M.t 108 | (** Evaluate a state computation with the given initial state and 109 | return the final state, discarding the final value. *) 110 | 111 | val maps : (state *'a -> state * 'b) -> 'a t -> 'b t 112 | (** Map both the return value and final state of a computation using 113 | the given function. 114 | 115 | {b Note:} The derivation of the notation [maps] is similar to 116 | the derivation of the notation [mapi] from the standard 117 | library.*) 118 | 119 | val with_state : (state -> state) -> 'a t -> 'a t 120 | (** [with_state f m] is the monad executing action [m] on a state 121 | modified by applying [f]. *) 122 | 123 | val lift : 'a M.t -> 'a t 124 | (** Embed the monad [M] in the associated state monad. *) 125 | end 126 | end 127 | -------------------------------------------------------------------------------- /src/lemonade_Stream.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Stream -- Monadic streams 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2016 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | exception Empty 15 | 16 | module type S = 17 | sig 18 | type 'a t 19 | type (+ 'a) monad 20 | val from : (int -> 'a option monad) -> 'a t 21 | val of_list : 'a list -> 'a t 22 | val of_array : 'a array -> 'a t 23 | val of_string : string -> char t 24 | val to_list : 'a t -> 'a list monad 25 | val to_string : char t -> string monad 26 | val peek : 'a t -> 'a option monad 27 | val npeek : int -> 'a t -> 'a list monad 28 | val get : 'a t -> 'a option monad 29 | val nget : int -> 'a t -> 'a list monad 30 | val get_while : ('a -> bool) -> 'a t -> 'a list monad 31 | val next : 'a t -> 'a monad 32 | val junk : 'a t -> unit monad 33 | val njunk : int -> 'a t -> unit monad 34 | val junk_while : ('a -> bool) -> 'a t -> unit monad 35 | val is_empty : 'a t -> bool monad 36 | val map : ('a -> 'b) -> 'a t -> 'b t 37 | val map_list : ('a -> 'b list) -> 'a t -> 'b t 38 | val filter : ('a -> bool) -> 'a t -> 'a t 39 | val filter_map : ('a -> 'b option) -> 'a t -> 'b t 40 | val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b monad 41 | val iter : ('a -> unit) -> 'a t -> unit monad 42 | val find : ('a -> bool) -> 'a t -> 'a option monad 43 | val find_map : ('a -> 'b option) -> 'a t -> 'b option monad 44 | val combine : 'a t -> 'b t -> ('a * 'b) t 45 | val append : 'a t -> 'a t -> 'a t 46 | val concat : 'a t t -> 'a t 47 | val flatten : 'a list t -> 'a t 48 | end 49 | 50 | module Make(Monad:Lemonade_Type.S) = 51 | struct 52 | open Monad.Infix 53 | 54 | type 'a monad = 55 | 'a Monad.t 56 | 57 | type 'a t = 58 | 'a cell option monad 59 | and 'a cell = { 60 | mutable count : int; 61 | mutable data : 'a data; 62 | } 63 | and 'a data = 64 | | Sempty 65 | | Scons of 'a * 'a data 66 | | Sgen of 'a gen 67 | and 'a gen = { 68 | mutable curr : 'a option option; 69 | func : int -> 'a option monad; 70 | } 71 | 72 | let _count = function 73 | | None -> 0 74 | | Some { count } -> count 75 | 76 | let _data = function 77 | | None -> Sempty 78 | | Some { data } -> data 79 | 80 | let from f = 81 | Monad.return(Some { 82 | count = 0; 83 | data = Sgen { curr = None; func = f }; 84 | }) 85 | 86 | let of_list lst = 87 | Monad.return (Some { 88 | count = 0; 89 | data = List.fold_right (fun x l -> Scons (x, l)) lst Sempty; 90 | }) 91 | 92 | let of_array a = 93 | let count = ref 0 in 94 | from 95 | (fun _ -> 96 | let c = !count in 97 | if c < Array.length a 98 | then (incr count; Monad.return(Some a.(c))) 99 | else Monad.return None) 100 | 101 | let of_string a = 102 | let count = ref 0 in 103 | from 104 | (fun _ -> 105 | let c = !count in 106 | if c < String.length a 107 | then (incr count; Monad.return(Some a.[c])) 108 | else Monad.return None) 109 | 110 | let rec get_data : type v. int -> v data -> v data monad = fun count d -> 111 | match d with 112 | (* Returns either Sempty or Scons(a, _) even when d is a generator 113 | or a buffer. In those cases, the item a is seen as extracted from 114 | the generator/buffer. 115 | The count parameter is used for calling `Sgen-functions'. *) 116 | | Sempty 117 | | Scons (_, _) -> Monad.return d 118 | | Sgen {curr = Some None; func = _ } -> Monad.return Sempty 119 | | Sgen({curr = Some(Some x); func = f } as g) -> 120 | g.curr <- None; 121 | Monad.return (Scons(x, d)) 122 | | Sgen({ curr = None; func = f} as g) -> 123 | Monad.bind (g.func count) 124 | (function 125 | | None -> g.curr <- Some None; Monad.return Sempty 126 | | Some x -> Monad.return(Scons(x, d))) 127 | 128 | let rec peek_data : type v. v cell -> v option monad = fun s -> 129 | (* consult the first item of s *) 130 | match s.data with 131 | | Sempty -> Monad.return None 132 | | Scons (x, _) -> Monad.return (Some(x)) 133 | | Sgen {curr = Some x} -> Monad.return x 134 | | Sgen g -> 135 | Monad.bind (g.func s.count) 136 | (fun x -> g.curr <- Some x; Monad.return x) 137 | 138 | let peek m = Monad.bind m 139 | (function 140 | | None -> Monad.return None 141 | | Some s -> peek_data s) 142 | 143 | let rec junk_data : type v. v cell -> unit monad = fun s -> 144 | match s.data with 145 | | Scons (_, d) -> 146 | Monad.return(s.count <- (succ s.count); s.data <- d) 147 | | Sgen ({curr = Some _} as g) -> 148 | Monad.return(s.count <- (succ s.count); g.curr <- None) 149 | | _ -> 150 | Monad.bind (peek_data s) 151 | (function 152 | | None -> Monad.return () 153 | | Some _ -> junk_data s) 154 | 155 | let junk m = Monad.bind m 156 | (function 157 | | None -> Monad.return () 158 | | Some data -> junk_data data) 159 | 160 | 161 | let get m = 162 | Monad.bind (peek m) 163 | (function 164 | | Some(a) -> junk m >>= fun () -> Monad.return(Some(a)) 165 | | None -> Monad.return None) 166 | 167 | let rec nget_data n s = 168 | if n <= 0 then 169 | Monad.return ([], s.data, 0) 170 | else 171 | Monad.bind (peek_data s) 172 | (function 173 | | None -> 174 | Monad.return([], s.data, 0) 175 | | Some a -> 176 | junk_data s >>= 177 | fun () -> 178 | nget_data (pred n) s >>= 179 | fun (al, d, k) -> 180 | Monad.return(a :: al, Scons (a, d), succ k)) 181 | 182 | let nget n m = 183 | Monad.bind m 184 | (function 185 | | None -> Monad.return [] 186 | | Some d -> 187 | nget_data n d 188 | >>= fun (al, _, len) -> 189 | if len < n then 190 | raise Empty 191 | else 192 | Monad.return al) 193 | 194 | let npeek_data n s = 195 | nget_data n s 196 | >>= fun (al, d, len) -> 197 | s.count <- (s.count - len); 198 | s.data <- d; 199 | Monad.return al 200 | 201 | let npeek n m = 202 | Monad.bind m 203 | (function 204 | | None -> Monad.return [] 205 | | Some d -> npeek_data n d) 206 | 207 | let next s = 208 | peek s >>= function 209 | | Some a -> (junk s >>= fun () -> Monad.return a) 210 | | None -> raise Empty 211 | 212 | let get_while p m = 213 | let rec loop ax = 214 | Monad.bind (peek m) 215 | (function 216 | | Some a -> 217 | (junk m >>= fun () -> 218 | if p a then loop (a :: ax) else Monad.return (List.rev ax)) 219 | | None -> Monad.return (List.rev ax)) 220 | in 221 | loop [] 222 | 223 | let junk_while p m = 224 | let rec loop () = 225 | Monad.bind (peek m) 226 | (function 227 | | Some a -> 228 | if p a then junk m >>= loop else Monad.return () 229 | | None -> 230 | Monad.return ()) 231 | in 232 | loop () 233 | 234 | let is_empty m = 235 | Monad.bind (peek m) 236 | (function 237 | | Some(_) -> Monad.return false 238 | | None -> Monad.return true) 239 | 240 | let map f m = 241 | let f _ = 242 | peek m >>= function 243 | | Some a -> (junk m >>= fun () -> Monad.return(Some (f a))) 244 | | None -> Monad.return None 245 | in 246 | from f 247 | 248 | let map_list f m = 249 | let page = ref [] in 250 | let rec loop n = 251 | match !page with 252 | | [] -> 253 | Monad.bind (get m) 254 | (function 255 | | Some(a) -> page := f a; loop n 256 | | None -> Monad.return None) 257 | | hd :: tl -> page := tl; Monad.return (Some hd) 258 | in 259 | from loop 260 | 261 | let filter p m = 262 | let not_p x = 263 | not(p x) 264 | in 265 | from (fun _ -> junk_while not_p m >>= fun () -> get m) 266 | 267 | let filter_map f m = 268 | let rec next serial = 269 | Monad.bind (get m) 270 | begin function 271 | | Some(a) -> begin match f a with 272 | | Some(x) -> Monad.return(Some x) 273 | | None -> next serial 274 | end 275 | | None -> Monad.return None 276 | end 277 | in 278 | from next 279 | 280 | let flatten m = 281 | map_list (fun lst -> lst) m 282 | 283 | let append m1 m2 = 284 | let m = ref m1 in 285 | let rec loop n = 286 | Monad.bind (get !m) 287 | (function 288 | | (Some _) as x -> Monad.return x 289 | | None -> 290 | if !m == m2 then 291 | Monad.return None 292 | else 293 | (m := m2; loop n)) 294 | in 295 | from loop 296 | 297 | let concat m_top = 298 | let m = ref (from (fun _ -> Monad.return None)) in 299 | let rec loop n = 300 | Monad.bind (get !m) 301 | (function 302 | | (Some _) as x -> Monad.return x 303 | | None -> 304 | Monad.bind (get m_top) 305 | (function 306 | | Some(nextm) -> 307 | (m := nextm; loop n) 308 | | None -> Monad.return None)) 309 | in 310 | from loop 311 | 312 | 313 | let combine m1 m2 = 314 | let rec loop _ = 315 | Monad.bind (get m1) 316 | (function 317 | | Some a -> 318 | Monad.bind (get m2) 319 | (function 320 | | Some b -> Monad.return (Some(a, b)) 321 | | None -> Monad.return None) 322 | | None -> Monad.return None) 323 | in 324 | from loop 325 | 326 | let fold f m ax0 = 327 | let rec loop ax = 328 | Monad.bind (get m) 329 | (function 330 | | Some(x) -> loop (f x ax) 331 | | None -> Monad.return ax) 332 | in 333 | loop ax0 334 | 335 | let iter f m = 336 | let rec loop () = 337 | Monad.bind (get m) 338 | (function 339 | | Some(a) -> f a; loop () 340 | | None -> Monad.return ()) 341 | in 342 | loop () 343 | 344 | let find p m = 345 | let rec loop () = 346 | Monad.bind (get m) 347 | (function 348 | | Some(a) -> if p a then Monad.return(Some a) else loop() 349 | | None -> Monad.return None) 350 | in 351 | loop () 352 | 353 | let find_map f m = 354 | let rec loop () = 355 | Monad.bind (get m) 356 | (function 357 | | Some(a) -> 358 | (match f a with 359 | | Some _ as x -> Monad.return x 360 | | None -> loop ()) 361 | | None -> Monad.return None) 362 | in 363 | loop () 364 | 365 | let rec njunk n m = 366 | if n <= 0 then 367 | Monad.return () 368 | else 369 | Monad.bind (junk m) 370 | (fun () -> njunk (pred n) m) 371 | 372 | let to_list m = 373 | let rec loop ax = 374 | Monad.bind (get m) 375 | (function 376 | | Some x -> loop (x :: ax) 377 | | None -> Monad.return(List.rev ax)) 378 | in 379 | loop [] 380 | 381 | let to_string m = 382 | let b = Buffer.create 100 in 383 | let rec loop () = 384 | Monad.bind (get m) 385 | (function 386 | | Some c -> Buffer.add_char b c; loop () 387 | | None -> Monad.return (Buffer.contents b)) 388 | in 389 | loop () 390 | end 391 | -------------------------------------------------------------------------------- /src/lemonade_Stream.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Stream -- Monadic streams 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2016 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** Monadic streams. *) 15 | 16 | exception Empty 17 | (** Exception raised when trying to read from an empty stream. *) 18 | 19 | (** The output signature of the functor [Lemonade_Stream.Make]. *) 20 | module type S = 21 | sig 22 | 23 | type 'a t 24 | (** The type of streams, holding values of type ['a]. *) 25 | 26 | type (+ 'a) monad 27 | (** The type of monadic computations, yielding a value of type ['a]. *) 28 | 29 | val from : (int -> 'a option monad) -> 'a t 30 | (** [from f] create a stream from the given input function. [f] is 31 | called each time more input is needed, and the stream ends when [f] 32 | returns [None]. *) 33 | 34 | val of_list : 'a list -> 'a t 35 | (** [of_list l] create a stream returning all elements of [l]. *) 36 | 37 | val of_array : 'a array -> 'a t 38 | (** [of_array a] create a stream returning all elements of [a]. *) 39 | 40 | val of_string : string -> char t 41 | (** [of_string str] create a stream returning all characters of [str]. *) 42 | 43 | val to_list : 'a t -> 'a list monad 44 | (** Return the list of elements of the given stream. *) 45 | 46 | val to_string : char t -> string monad 47 | (** Return the word composed of all characters of the given 48 | stream. *) 49 | 50 | val peek : 'a t -> 'a option monad 51 | (** [peek st] return the first element of the stream, if any, 52 | without removing it. *) 53 | 54 | val npeek : int -> 'a t -> 'a list monad 55 | (** [npeek n st] return at most the first [n] elements of [st], 56 | without removing them. *) 57 | 58 | val get : 'a t -> 'a option monad 59 | (** [get st] remove and return the first element of the stream, if 60 | any. *) 61 | 62 | val nget : int -> 'a t -> 'a list monad 63 | (** [nget n st] remove and return at most the first [n] elements of 64 | [st]. *) 65 | 66 | val get_while : ('a -> bool) -> 'a t -> 'a list monad 67 | (** [get_while f st] return the longest prefix of [st] where all 68 | elements satisfy [f]. *) 69 | 70 | val next : 'a t -> 'a monad 71 | (** [next st] remove and return the next element of the stream, of 72 | fail with {!Empty} if the stream is empty. *) 73 | 74 | val junk : 'a t -> unit monad 75 | (** [junk st] remove the first element of [st]. *) 76 | 77 | val njunk : int -> 'a t -> unit monad 78 | (** [njunk n st] removes at most the first [n] elements of the 79 | stream. *) 80 | 81 | val junk_while : ('a -> bool) -> 'a t -> unit monad 82 | (** [junk_while f st] removes all elements at the beginning of the 83 | streams which satisfy [f]. *) 84 | 85 | val is_empty : 'a t -> bool monad 86 | (** [is_empty st] return wether the given stream is empty *) 87 | 88 | 89 | (** {2 Stream transversal} *) 90 | 91 | val map : ('a -> 'b) -> 'a t -> 'b t 92 | (** [map f st] maps the value returned by [st] with [f] *) 93 | 94 | val map_list : ('a -> 'b list) -> 'a t -> 'b t 95 | (** [map_list f st] applies [f] on each element of [st] and flattens 96 | the lists returned *) 97 | 98 | val filter : ('a -> bool) -> 'a t -> 'a t 99 | (** [filter f st] keeps only value [x] such that [f x] is [true] *) 100 | 101 | val filter_map : ('a -> 'b option) -> 'a t -> 'b t 102 | (** [filter_map f st] filter and map [st] at the same time *) 103 | 104 | val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b monad 105 | (** [fold f s x] fold_like function for streams. *) 106 | 107 | val iter : ('a -> unit) -> 'a t -> unit monad 108 | (** [iter f s] iterates over all elements of the stream *) 109 | 110 | val find : ('a -> bool) -> 'a t -> 'a option monad 111 | (** [find f s] find an element in a stream. *) 112 | 113 | val find_map : ('a -> 'b option) -> 'a t -> 'b option monad 114 | (** [find f s] find and map at the same time. *) 115 | 116 | val combine : 'a t -> 'b t -> ('a * 'b) t 117 | (** [combine s1 s2] combine two streams. The stream will ends when 118 | the first stream ends. *) 119 | 120 | val append : 'a t -> 'a t -> 'a t 121 | (** [append s1 s2] return a stream which return all elements of 122 | [s1], then all elements of [s2] *) 123 | 124 | val concat : 'a t t -> 'a t 125 | (** [concat st] return the concatenation of all streams of [st]. *) 126 | 127 | val flatten : 'a list t -> 'a t 128 | (** [flatten st = map_list (fun l -> l) st] *) 129 | end 130 | 131 | (** The functor [Lemonade_Stream.Make]. *) 132 | module Make(Monad:Lemonade_Type.S): S 133 | with type 'a monad = 'a Monad.t 134 | -------------------------------------------------------------------------------- /src/lemonade_Success.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Success -- The classic success monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | 15 | module type ErrorType = 16 | sig 17 | type t 18 | end 19 | 20 | module type S = 21 | sig 22 | include Mixture_Monad.S 23 | type error 24 | type (+'a) outcome = 25 | | Success of 'a 26 | | Error of error 27 | val error : error -> 'a t 28 | val recover : 'a t -> (error -> 'a t) -> 'a t 29 | val run : 'a t -> 'a outcome 30 | end 31 | 32 | 33 | module Make(Error:ErrorType) = 34 | struct 35 | 36 | type error = 37 | Error.t 38 | 39 | type (+'a) outcome = 40 | | Success of 'a 41 | | Error of error 42 | 43 | module Basis = 44 | struct 45 | 46 | type 'a t = 'a outcome 47 | 48 | let bind succ f = 49 | match succ with 50 | | Success(x) -> f x 51 | | Error(s) -> Error(s) 52 | 53 | let return x = 54 | Success(x) 55 | end 56 | 57 | module MethodsMonad = 58 | Mixture_Monad.Make(Basis) 59 | 60 | include Basis 61 | include MethodsMonad 62 | 63 | let error err = 64 | Error(err) 65 | 66 | let recover m handler = 67 | match m with 68 | | Success(x) -> Success(x) 69 | | Error(err) -> handler err 70 | 71 | let run m = 72 | m 73 | 74 | 75 | module T(M:Mixture_Monad.S) = 76 | struct 77 | module Germ = 78 | struct 79 | 80 | type 'a t = 81 | 'a Basis.t M.t 82 | 83 | let bind m f = 84 | M.bind m 85 | (function 86 | | Success(x) -> f x 87 | | Error(err) -> M.return (Error(err))) 88 | 89 | let return x = 90 | M.return(Success(x)) 91 | end 92 | 93 | include Mixture_Monad.Transformer.Make(Basis)(M)(Germ) 94 | end 95 | end 96 | -------------------------------------------------------------------------------- /src/lemonade_Success.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Success -- The classic success monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** Success monad. 15 | 16 | The success monad is a monad in which one can run computations 17 | throwing errors. This is implemented as a functor parametrised by the 18 | error type. 19 | 20 | Note that the [throw] and [catch] operations defined below are 21 | totally independant of exceptions. *) 22 | 23 | (** The input signature of the functor [Lemonade_Success.Make]. *) 24 | module type ErrorType = 25 | sig 26 | type t 27 | (** The type of error messages. *) 28 | end 29 | 30 | (** The output signature of the functor [Lemonade_Success.Make]. *) 31 | module type S = 32 | sig 33 | type error 34 | (** The type of error messages. *) 35 | 36 | (** The outcome of computations throwing errors. *) 37 | type (+'a) outcome = 38 | | Success of 'a 39 | | Error of error 40 | 41 | include Lemonade_Type.S 42 | 43 | val error : error -> 'a t 44 | (** Fail with the given error. *) 45 | 46 | val recover : 'a t -> (error -> 'a t) -> 'a t 47 | (** [recover m handler] is a monad containing the same value as [m] 48 | and thrown errors are interepreted by the [handler]. *) 49 | 50 | val run : 'a t -> 'a outcome 51 | (** Perform a computation with errors. *) 52 | end 53 | 54 | (** Functor building an implementation of the [Success] monad. *) 55 | module Make(Error:ErrorType): 56 | sig 57 | include S 58 | with type error = Error.t 59 | 60 | (** The success monad transformer. *) 61 | module T(M:Lemonade_Type.S): sig 62 | include Lemonade_Type.S 63 | with type 'a t = 'a t M.t 64 | 65 | val lift : 'a M.t -> 'a t 66 | end 67 | end 68 | -------------------------------------------------------------------------------- /src/lemonade_Type.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Type -- The classic type monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module type S = 15 | sig 16 | type (+'a) t 17 | val bind : 'a t -> ('a -> 'b t) -> 'b t 18 | val return : 'a -> 'a t 19 | val apply : ('a -> 'b) t -> 'a t -> 'b t 20 | val join : ('a t) t -> 'a t 21 | val map : ('a -> 'b) -> 'a t -> 'b t 22 | val bind2 : 'a t -> 'b t -> ('a -> 'b -> 'c t) -> 'c t 23 | val bind3 : 'a t -> 'b t -> 'c t -> ('a -> 'b -> 'c -> 'd t) -> 'd t 24 | val bind4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a -> 'b -> 'c -> 'd -> 'e t) -> 'e t 25 | val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 26 | val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t 27 | val map4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t 28 | val dist : 'a t list -> 'a list t 29 | val ignore : 'a t -> unit t 30 | val filter : ('a -> bool t) -> 'a t list -> 'a list t 31 | val only_if : bool -> unit t -> unit t 32 | val unless : bool -> unit t -> unit t 33 | val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t 34 | module Infix : sig 35 | val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t 36 | val ( <$> ) : ('a -> 'b) -> 'a t -> 'b t 37 | val ( <* ) : 'a t -> 'b t -> 'a t 38 | val ( >* ) : 'a t -> 'b t -> 'b t 39 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 40 | val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t 41 | val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t 42 | val ( >=> ) : ('a -> 'b t) -> ('b -> 'c t) -> ('a -> 'c t) 43 | val ( <=< ) : ('b -> 'c t) -> ('a -> 'b t) -> ('a -> 'c t) 44 | end 45 | end 46 | -------------------------------------------------------------------------------- /src/lemonade_Type.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Type -- The classic type monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** The monad definition. *) 15 | 16 | (** The general signature of a monad. *) 17 | module type S = 18 | sig 19 | type (+'a) t 20 | (** The type of monads. *) 21 | 22 | val bind : 'a t -> ('a -> 'b t) -> 'b t 23 | (** [bind m f] bind [f] to the monad [m]. *) 24 | 25 | val return : 'a -> 'a t 26 | (** [return a] embed the value [a] in the monad. *) 27 | 28 | val apply : ('a -> 'b) t -> 'a t -> 'b t 29 | (** [apply f] sequence computations and combine their results with [f]. *) 30 | 31 | val join : ('a t) t -> 'a t 32 | (** [join mm] bind [mm] to the identity, reducing the monad. *) 33 | 34 | val map : ('a -> 'b) -> 'a t -> 'b t 35 | (** [map f] is the natural tranformation between monads, 36 | induced by [f]. *) 37 | 38 | val bind2 : 'a t -> 'b t -> ('a -> 'b -> 'c t) -> 'c t 39 | (** Similar to [bind], but works on two arguments. *) 40 | 41 | val bind3 : 'a t -> 'b t -> 'c t -> ('a -> 'b -> 'c -> 'd t) -> 'd t 42 | (** Similar to [bind], but works on three arguments. *) 43 | 44 | val bind4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a -> 'b -> 'c -> 'd -> 'e t) -> 'e t 45 | (** Similar to [bind], but works on four arguments. *) 46 | 47 | val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 48 | (** A version of [map] for binary functions. *) 49 | 50 | val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t 51 | (** A version of [map] for ternary functions. *) 52 | 53 | val map4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t 54 | (** A version of [map] for quaternary functions. *) 55 | 56 | val dist : 'a t list -> 'a list t 57 | (** The applicative distributor for list, that is, the natural 58 | transformation of a list of computations in the computation of a 59 | list. *) 60 | 61 | val ignore : 'a t -> unit t 62 | (** Monadic ignore. *) 63 | 64 | val filter : ('a -> bool t) -> 'a t list -> 'a list t 65 | (** Filter a list of computations with the given monadic predicate. *) 66 | 67 | val only_if : bool -> unit t -> unit t 68 | (** [only_if flag m] returns [m] only if [flag] is [true]. *) 69 | 70 | val unless : bool -> unit t -> unit t 71 | (** [unless flag m] returns [m] only if [flag] is [false]. *) 72 | 73 | val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t 74 | (** [catch f h] is a computation yielding the same result as [f ()] 75 | if this computation does not throw an exception. If this computation 76 | raises an exception, then it is passed to [h] to determine the 77 | result of the overall computation. *) 78 | 79 | module Infix : sig 80 | val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t 81 | (** A shorthand for [apply], the sequential application. *) 82 | 83 | val ( <$> ) : ('a -> 'b) -> 'a t -> 'b t 84 | (** A shorthand for [map]. *) 85 | 86 | val ( <* ) : 'a t -> 'b t -> 'a t 87 | (** Sequence actions, discarding the value of the first 88 | argument. *) 89 | 90 | val ( >* ) : 'a t -> 'b t -> 'b t 91 | (** Sequence actions, discarding the value of the second 92 | argument. *) 93 | 94 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 95 | (** [ m >>= f] is equivalent to [bind m f]. *) 96 | 97 | val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t 98 | (** A composable shorthand for [map]. *) 99 | 100 | val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t 101 | (** [m >> f] binds [m] to [f], a context function. *) 102 | 103 | val ( >=> ) : ('a -> 'b t) -> ('b -> 'c t) -> ('a -> 'c t) 104 | (** [g >=> f] is the (contravariant) monadic composition of [g] 105 | followed by [f]. *) 106 | 107 | val ( <=< ) : ('b -> 'c t) -> ('a -> 'b t) -> ('a -> 'c t) 108 | (** [f <=< g] is the monadic composition of [g] followed by [f]. *) 109 | end 110 | end 111 | -------------------------------------------------------------------------------- /src/lemonade_Writer.ml: -------------------------------------------------------------------------------- 1 | (* Lemonade_Writer -- The classic writer monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | module type OutputType = 15 | sig 16 | type t 17 | val empty : unit -> t 18 | val append : t -> t -> t 19 | end 20 | 21 | 22 | module type S = 23 | sig 24 | type output 25 | include Lemonade_Type.S 26 | val writer : output * 'a -> 'a t 27 | val tell : output -> unit t 28 | val listen : 'a t -> (output * 'a) t 29 | val pass : ((output -> output) * 'a) t -> 'a t 30 | val listens : (output -> 'b) -> 'a t -> ('a * 'b) t 31 | val censor : (output -> output) -> 'a t -> 'a t 32 | val run : 'a t -> output * 'a 33 | val eval : 'a t -> 'a 34 | val exec : 'a t -> output 35 | end 36 | 37 | module Make(Output:OutputType)= 38 | struct 39 | type output = Output.t 40 | module Basis = 41 | struct 42 | type 'a t = output * 'a 43 | let return x = 44 | (Output.empty(), x) 45 | let bind (out, x) f = 46 | let more, y = f x in 47 | (Output.append out more, y) 48 | end 49 | 50 | module MethodsMonad = 51 | Mixture_Monad.Make(Basis) 52 | 53 | include Basis 54 | include MethodsMonad 55 | 56 | let writer m = 57 | m 58 | 59 | let tell out = 60 | (out, ()) 61 | 62 | let listen ((out, x) as m) = 63 | (out, m) 64 | 65 | let pass (out, (filter, x)) = 66 | (filter out, x) 67 | 68 | let listens f (out, x) = 69 | (out, (x, f out)) 70 | 71 | let censor f (out, x) = 72 | (f out, x) 73 | 74 | let run m = 75 | m 76 | 77 | let exec (out, _) = 78 | out 79 | 80 | let eval (_, x) = 81 | x 82 | 83 | module T(M:Lemonade_Type.S)= 84 | struct 85 | type output = Output.t 86 | module BasisT = 87 | struct 88 | type 'a t = 89 | 'a Basis.t M.t 90 | let return x = 91 | M.return(Basis.return x) 92 | let bind m f = 93 | M.bind m 94 | (fun (out, x) -> 95 | M.bind 96 | (f x) 97 | (fun (more, y) -> M.return(Output.append out more, y))) 98 | end 99 | 100 | module MethodsMonadT = 101 | Mixture_Monad.Make(BasisT) 102 | 103 | include BasisT 104 | include MethodsMonadT 105 | 106 | let writer m = 107 | M.return m 108 | 109 | let tell out = 110 | M.return (out, ()) 111 | 112 | let listen m = 113 | M.bind m (fun ((out, x) as m) -> M.return (out, m)) 114 | 115 | let pass m = 116 | M.bind m (fun (out, (filter, x)) -> M.return (filter out, x)) 117 | 118 | let listens f m = 119 | M.bind m (fun (out, x) -> M.return (out, (x, f out))) 120 | 121 | let censor f m = 122 | M.bind m (fun (out, x) -> M.return (f out, x)) 123 | 124 | let run m = 125 | m 126 | 127 | let exec m = 128 | M.map fst m 129 | 130 | let eval m = 131 | M.map snd m 132 | 133 | let lift m = 134 | M.bind m (fun x -> BasisT.return x) 135 | end 136 | end 137 | -------------------------------------------------------------------------------- /src/lemonade_Writer.mli: -------------------------------------------------------------------------------- 1 | (* Lemonade_Writer -- The classic writer monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | (** Writer monad. 15 | 16 | Values in a {i Writer} monad represent a computation accumulating 17 | some output. *) 18 | 19 | (** The input signature of the functor [Lemonade_Writer.Make]. *) 20 | module type OutputType = 21 | sig 22 | type t 23 | (** The type of output to accumulate. *) 24 | 25 | val empty : unit -> t 26 | (** The empty output. *) 27 | 28 | val append : t -> t -> t 29 | (** Catenate two output. *) 30 | end 31 | 32 | 33 | (** The output signature of the functor [Lemonade_Writer.Make]. *) 34 | module type S = 35 | sig 36 | type output 37 | (** The type of output. *) 38 | 39 | include Lemonade_Type.S 40 | 41 | val writer : output * 'a -> 'a t 42 | (** Embed a simple writer action. *) 43 | 44 | val tell : output -> unit t 45 | (** [tell w] is an action that produces the output [w]. *) 46 | 47 | val listen : 'a t -> (output * 'a) t 48 | (** [listen m] is an action that executes the action m and adds its 49 | output to the value of the computation. *) 50 | 51 | val pass : ((output -> output) * 'a) t -> 'a t 52 | (** [pass m] is an action that executes the action [m], which 53 | returns a value and a function, and returns the value, applying 54 | the function to the output. *) 55 | 56 | val listens : (output -> 'b) -> 'a t -> ('a * 'b) t 57 | (** [listens f m] is an action that executes the action [m] and adds 58 | the result of applying [f] to its output to the value of the 59 | computation. *) 60 | 61 | val censor : (output -> output) -> 'a t -> 'a t 62 | (** [censor f m] is an action action that executes the computation 63 | [m] and filters its output with [f], leaving its return values 64 | unchanged. *) 65 | 66 | val run : 'a t -> output * 'a 67 | (** Execute a computation and examine its output and return value. *) 68 | 69 | val eval : 'a t -> 'a 70 | (** Execute a computation and examine its return value 71 | while discarding its output. *) 72 | 73 | val exec : 'a t -> output 74 | (** Execute a computation and examine its output while discarding 75 | its return value. *) 76 | end 77 | 78 | (** Functor building an implementation of the [Writer] monad. *) 79 | module Make(Output:OutputType): 80 | sig 81 | include S 82 | with type output = Output.t 83 | 84 | (** The writer monad transformer. *) 85 | module T(M:Lemonade_Type.S): sig 86 | type output = Output.t 87 | (** The type of consumed data. *) 88 | 89 | include Lemonade_Type.S 90 | 91 | val writer : output * 'a -> 'a t 92 | (** Embed a simple writer action. *) 93 | 94 | val tell : output -> unit t 95 | (** [tell w] is an action that produces the output [w]. *) 96 | 97 | val listen : 'a t -> (output * 'a) t 98 | (** [listen m] is an action that executes the action m and adds its 99 | output to the value of the computation. *) 100 | 101 | val pass : ((output -> output) * 'a) t -> 'a t 102 | (** [pass m] is an action that executes the action [m], which 103 | returns a value and a function, and returns the value, applying 104 | the function to the output. *) 105 | 106 | val listens : (output -> 'b) -> 'a t -> ('a * 'b) t 107 | (** [listens f m] is an action that executes the action [m] and adds 108 | the result of applying [f] to its output to the value of the 109 | computation. *) 110 | 111 | val censor : (output -> output) -> 'a t -> 'a t 112 | (** [censor f m] is an action action that executes the computation 113 | [m] and filters its output with [f], leaving its return values 114 | unchanged. *) 115 | 116 | val run : 'a t -> (output * 'a) M.t 117 | (** Execute a computation and examine its output and return value. *) 118 | 119 | val eval : 'a t -> 'a M.t 120 | (** Execute a computation and examine its return value 121 | while discarding its output. *) 122 | 123 | val exec : 'a t -> output M.t 124 | (** Execute a computation and examine its output while discarding 125 | its return value. *) 126 | 127 | val lift : 'a M.t -> 'a t 128 | (** Add an environment to a monad of type ['a M.t]. *) 129 | end 130 | end 131 | -------------------------------------------------------------------------------- /testsuite/Makefile: -------------------------------------------------------------------------------- 1 | ### Makefile -- Test suite 2 | 3 | # Lemonade (https://github.com/michipili/lemonade) 4 | # This file is part of Lemonade 5 | # 6 | # Copyright © 2013–2015 Michael Grünewald 7 | # 8 | # This file must be used under the terms of the CeCILL-B. 9 | # This source file is licensed as described in the file COPYING, which 10 | # you should have received as part of this distribution. The terms 11 | # are also available at 12 | # http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt 13 | 14 | PROGRAM= unit-testing 15 | 16 | .sinclude "${SRCDIR}/Makefile.config" 17 | 18 | SRCS= testList.ml 19 | SRCS+= testMaybe.ml 20 | 21 | .if!empty(ENABLE_PPX_REWRITER:Myes) 22 | SRCS+= testPPX.ml 23 | .endif 24 | 25 | SRCS+= testStream.ml 26 | SRCS+= testSuccessReader.ml 27 | SRCS+= main.ml 28 | 29 | OCAMLLFLAGS+= -linkall 30 | .if!empty(ENABLE_PPX_REWRITER:Myes) 31 | OCAMLCFLAGS+= -ppx ${.OBJDIR}/../ppx/ppx_lemonade 32 | .endif 33 | 34 | 35 | test: ${PROGRAM} 36 | ${PROGRAM:tA} 37 | 38 | install: 39 | ${NOP} 40 | 41 | .include "ocaml.prog.mk" 42 | 43 | ### End of file `Makefile' 44 | -------------------------------------------------------------------------------- /testsuite/main.ml: -------------------------------------------------------------------------------- 1 | (* Main -- Entry point of the test suite 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | let () = Broken.main () 15 | -------------------------------------------------------------------------------- /testsuite/testList.ml: -------------------------------------------------------------------------------- 1 | (* TestList -- Test the list monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | open Broken 15 | 16 | module ListMaybe = 17 | Lemonade_List.T(Lemonade_Maybe) 18 | 19 | let pp_print_listmaybe_int pp m = 20 | Lemonade_Maybe.pp_print (Lemonade_List.pp_print Format.pp_print_int) pp m 21 | 22 | 23 | let assert_listmaybe_int id ?expected_failure f a b = 24 | assert_equal 25 | id 26 | ?expected_failure 27 | ~printer:pp_print_listmaybe_int 28 | ~equal:( (=) ) 29 | f a b 30 | 31 | let divisors n = 32 | let rec loop acc k = 33 | match (k >= n), (n mod k = 0) with 34 | | true, _ -> acc 35 | | _, true -> loop (k :: acc) (k+1) 36 | | _, false -> loop acc (k+1) 37 | in 38 | loop [] 2 39 | 40 | let safe_divisors n = 41 | if n > 0 then Some(divisors n) else None 42 | 43 | let () = 44 | register_suite "listtransform" "Test list transformation features" [ 45 | 46 | assert_listmaybe_int "1" 47 | (ListMaybe.bind (Some[ 21; 16; 7; 14 ])) 48 | safe_divisors 49 | (Some(Lemonade_List.bind [ 21; 16; 7; 14 ] divisors)); 50 | 51 | assert_listmaybe_int "2" 52 | (ListMaybe.bind (Some[ 21; 16; 7; -1; 14 ])) 53 | safe_divisors 54 | None 55 | ] 56 | -------------------------------------------------------------------------------- /testsuite/testMaybe.ml: -------------------------------------------------------------------------------- 1 | (* TestMaybe -- Test the maybe monad 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | open Broken 15 | 16 | module MaybeList = 17 | Lemonade_Maybe.T(Lemonade_List) 18 | 19 | let pp_print_maybelist_int pp m = 20 | Lemonade_List.pp_print (Lemonade_Maybe.pp_print Format.pp_print_int) pp m 21 | 22 | let assert_maybelist_int id ?expected_failure f a b = 23 | assert_equal 24 | id 25 | ?expected_failure 26 | ~printer:pp_print_maybelist_int 27 | ~equal:( (=) ) 28 | f a b 29 | 30 | let assert_list_int id ?expected_failure f a b = 31 | assert_equal 32 | id 33 | ?expected_failure 34 | ~printer:(Lemonade_List.pp_print Format.pp_print_int) 35 | ~equal:( (=) ) 36 | f a b 37 | 38 | let sieve p lst = 39 | Lemonade_Maybe.filter_map 40 | (fun x -> if x mod p <> 0 then Some(x) else None) 41 | lst 42 | 43 | let ( $ ) f g = 44 | fun x -> f (g x) 45 | 46 | let () = 47 | register_suite "maybe" "Test the Maybe monad" [ 48 | 49 | assert_list_int "sieve" 50 | ((sieve 2) $ (sieve 3) $ (sieve 5)) 51 | [2; 3; 4; 5; 6; 7; 8; 9; 10 ] 52 | [ 7 ]; 53 | ] 54 | -------------------------------------------------------------------------------- /testsuite/testPPX.ml: -------------------------------------------------------------------------------- 1 | (* TestPPX -- Test Preprocessor 2 | 3 | Mixture (https://github.com/michipili/mixture) 4 | This file is part of Mixture 5 | 6 | Copyright © 2013–2015 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | open Printf 15 | open Broken 16 | 17 | module Maybe = 18 | Lemonade_Maybe 19 | 20 | let pp_print_maybe_bool pp m = 21 | Lemonade_Maybe.pp_print Format.pp_print_bool pp m 22 | 23 | let assert_maybe id ?expected_failure f = 24 | assert_equal 25 | id 26 | ?expected_failure 27 | ~printer:pp_print_maybe_bool 28 | ~equal:( (=) ) 29 | f () (Some true) 30 | 31 | let maybe_assoc lst name = 32 | try Some(List.assoc name lst) 33 | with Not_found -> None 34 | 35 | let () = 36 | let open Maybe in 37 | register_suite "ppx" "Test Lemonade PPX rewriter" [ 38 | 39 | assert_maybe "let%lemonade" 40 | begin function () -> 41 | let%lemonade a = Some true in 42 | return a 43 | end; 44 | 45 | assert_maybe "nested let%lemonade" 46 | begin function () -> 47 | let%lemonade a = Some 1 in 48 | let%lemonade b = Some 1 in 49 | return (a = b) 50 | end; 51 | 52 | assert_maybe "and let%lemonade" 53 | begin function () -> 54 | let%lemonade a = Some 1 55 | and b = Some 1 in 56 | return (a = b) 57 | end; 58 | 59 | assert_maybe "match%lemonade" 60 | begin function () -> 61 | let x = return (Some 0) in 62 | match%lemonade x with 63 | | Some x -> return (x + 1 = 1) 64 | | None -> return false 65 | end; 66 | 67 | assert_maybe "match-exn" 68 | begin function () -> 69 | let x = return (Some 3) in 70 | let%lemonade a = 71 | match%lemonade x with 72 | | exception Not_found -> return false 73 | | Some x -> return (x = 3) 74 | | None -> return false 75 | and b = 76 | match%lemonade (raise Not_found) with 77 | | exception Not_found -> return true 78 | | _ -> return false 79 | in 80 | return (a && b) 81 | end; 82 | 83 | assert_maybe "if%lemonade" 84 | begin function () -> 85 | let open Maybe.Infix in 86 | let x = return true in 87 | let%lemonade a = 88 | if%lemonade x then return true else return false 89 | in 90 | let%lemonade b = 91 | if%lemonade x >|= not then return false else return true 92 | in 93 | (if%lemonade x >|= not then return ()) 94 | >>= fun () -> return (a && b) 95 | end; 96 | 97 | assert_maybe "for%lemonade" (* Test for proper sequencing *) 98 | begin function () -> 99 | let r = ref [] in 100 | let f x = 101 | return (r := x :: !r) 102 | in 103 | let%lemonade () = 104 | for%lemonade x = 3 to 5 do f x done 105 | in return (!r = [5 ; 4 ; 3]) 106 | end; 107 | 108 | assert_maybe "while%lemonade" (* Test for proper sequencing *) 109 | begin function () -> 110 | let r = ref [] in 111 | let f x = 112 | return (r := x :: !r) 113 | in 114 | let%lemonade () = 115 | let c = ref 2 in 116 | while%lemonade !c < 5 do incr c ; f !c done 117 | in return (!r = [5 ; 4 ; 3]) 118 | end; 119 | 120 | (* assert_maybe "assert%lemonade" 121 | begin function () -> 122 | let%lemonade () = assert%lemonade true 123 | in return true 124 | end; 125 | 126 | assert_maybe "sequence" 127 | begin function () -> 128 | let lst = ref [] in 129 | (lst := 2 :: !lst; return()) >> 130 | (lst := 1 :: !lst; return()) >> 131 | (return (!lst = [1;2])) 132 | end; 133 | 134 | assert_maybe "structure let" 135 | begin function () -> 136 | let module M = 137 | struct 138 | let%lemonade result = return true 139 | end 140 | in 141 | return M.result 142 | end; *) 143 | ] 144 | -------------------------------------------------------------------------------- /testsuite/testStream.ml: -------------------------------------------------------------------------------- 1 | (* TestStream -- Test monadic streams 2 | 3 | Lemonade (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2016 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | open Broken 15 | open Format 16 | 17 | module Success = 18 | Lemonade_Success.Make(struct type t = string end) 19 | 20 | module SStream = 21 | Lemonade_Stream.Make(Success) 22 | 23 | let pp_print_outcome f pp outcome = 24 | let open Success in 25 | match outcome with 26 | | Success(x) -> fprintf pp "Success(%a)" f x 27 | | Error(mesg) -> fprintf pp "Error(%S)" mesg 28 | 29 | let assert_success_int id ?expected_failure f a b = 30 | assert_equal 31 | id 32 | ?expected_failure 33 | ~printer:(pp_print_outcome pp_print_int) 34 | ~equal:( (=) ) 35 | (fun x -> Success.run (f x)) a b 36 | 37 | let enumerate n = 38 | SStream.from 39 | Success.(fun i -> if i >= 0 && i < n then return(Some i) else return None) 40 | 41 | let fail n = 42 | SStream.from 43 | Success.(fun i -> if i >= 0 && i < n then return(Some i) else error "Error") 44 | 45 | let () = 46 | register_suite "stream" "Test monadic streams" [ 47 | assert_success_int "enumerate" 48 | (fun () -> SStream.fold ( + ) (enumerate 10) 0) 49 | () 50 | (Success.Success 45); 51 | 52 | assert_success_int "fail" 53 | (fun () -> SStream.fold ( + ) (fail 10) 0) 54 | () 55 | (Success.Error "Error"); 56 | 57 | assert_success_int "map" 58 | (fun () -> 59 | SStream.fold 60 | ( + ) 61 | (SStream.map (fun x -> 2 * x) (enumerate 10)) 62 | 0) 63 | () 64 | (Success.Success 90); 65 | 66 | assert_success_int "npeek" 67 | (fun () -> 68 | Success.map List.length 69 | (SStream.npeek 15 (enumerate 10))) 70 | () 71 | (Success.Success 10); 72 | 73 | 74 | assert_success_int "concat" 75 | (fun () -> 76 | let pyramid n = 77 | SStream.from 78 | Success.(fun i -> if i >= 0 && i < n then return(Some(enumerate i)) else return None) 79 | in 80 | SStream.fold 81 | ( + ) 82 | (SStream.concat (pyramid 5)) 83 | 0) 84 | () 85 | (Success.Success (3 + 2 + 1 + 2 + 1 + 1)); 86 | 87 | 88 | assert_success_int "filter_map" 89 | (fun () -> 90 | let stream = 91 | SStream.filter_map 92 | (fun n -> if n mod 2 = 0 then Some(n) else None) 93 | (enumerate 10) 94 | in 95 | SStream.fold ( + ) stream 0) 96 | () 97 | (Success.Success (2 + 4 + 6 + 8)); 98 | 99 | assert_success_int "of_list" 100 | (fun () -> 101 | SStream.fold 102 | ( + ) 103 | (SStream.of_list [1; 2; 3; 4; 5]) 104 | 0) 105 | () 106 | (Success.Success 15); 107 | 108 | 109 | assert_success_int "filter" 110 | (fun () -> 111 | SStream.fold 112 | ( + ) 113 | (SStream.filter (fun x -> x mod 2 = 1) 114 | (SStream.of_list [1; 2; 3; 4; 5])) 115 | 0) 116 | () 117 | (Success.Success 9); 118 | ] 119 | -------------------------------------------------------------------------------- /testsuite/testSuccessReader.ml: -------------------------------------------------------------------------------- 1 | (* TestSuccessReader -- Test natural transformation 2 | 3 | Mixture (https://github.com/michipili/lemonade) 4 | This file is part of Lemonade 5 | 6 | Copyright © 2013–2016 Michael Grünewald 7 | 8 | This file must be used under the terms of the CeCILL-B. 9 | This source file is licensed as described in the file COPYING, which 10 | you should have received as part of this distribution. The terms 11 | are also available at 12 | http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.txt *) 13 | 14 | open Format 15 | open Broken 16 | 17 | module Error = 18 | struct 19 | type t = string * string 20 | end 21 | 22 | module Success = 23 | Lemonade_Success.Make(Error) 24 | 25 | module Environment = 26 | struct 27 | type t = string 28 | end 29 | 30 | module Reader = 31 | Lemonade_Reader.Make(Environment) 32 | 33 | module Basis = 34 | Reader.T(Success) 35 | 36 | include Basis 37 | 38 | type 'a outcome = 'a Success.outcome = 39 | | Success of 'a 40 | | Error of Error.t 41 | 42 | let error err = 43 | Basis.lift(Success.error err) 44 | 45 | 46 | (* Lift operations from the success monad *) 47 | 48 | let run env m = 49 | Success.run(Basis.run env m) 50 | 51 | let recover m f = 52 | let g x = 53 | Success.return(f x) 54 | in 55 | let m' = 56 | Reader.bind m 57 | (fun s -> Reader.return(Success.recover (Success.map Basis.return s) g)) 58 | in 59 | Basis.join m' 60 | 61 | (* Pretty printing *) 62 | 63 | let pp_print_outcome_list_string pp m = 64 | let pp_print_list_string pp lst = 65 | Lemonade_List.pp_print pp_print_string pp lst 66 | in 67 | let pp_print_outcome f pp = 68 | function 69 | | Success(x) -> fprintf pp "Success(%a)" f x 70 | | Error(name, mesg) -> fprintf pp "Error(%S, %S)" name mesg 71 | in 72 | pp_print_outcome pp_print_list_string pp m 73 | 74 | let assert_outcome name env f expected = 75 | assert_equal ~printer:pp_print_outcome_list_string 76 | name (fun () -> run env f) () expected 77 | 78 | let () = 79 | register_suite "success_reader" 80 | "Test the Success Reader natural transformation" 81 | [ 82 | assert_outcome "prefix" 83 | "prefix" 84 | (Basis.access begin fun prefix -> [ prefix ^ "-a"; prefix ^ "-b"] end) 85 | (Success [ "prefix-a"; "prefix-b"]); 86 | 87 | assert_outcome "join" 88 | "join" 89 | (Basis.join (Basis.access begin 90 | fun prefix -> Reader.return(Success.return [ prefix ^ "-a" ]) end)) 91 | (Success ["join-a"]); 92 | ] 93 | --------------------------------------------------------------------------------