├── .dockerignore ├── .gitignore ├── .gitlab-ci.yml ├── .gitmodules ├── LICENSE ├── Makefile ├── README.md ├── READMEExample.hs ├── Setup.hs ├── Vagrantfile ├── apps ├── gists │ ├── .gitignore │ ├── LICENSE │ ├── Makefile │ ├── Setup.hs │ ├── app │ │ └── Main.hs │ ├── gists │ ├── gists.cabal │ └── stack.yaml └── markd │ ├── .gitignore │ ├── LICENSE │ ├── Makefile │ ├── README.md │ ├── Setup.hs │ ├── app │ └── Main.hs │ ├── markd.cabal │ └── stack.yaml ├── build.dockerfile ├── cbits └── mapview.m ├── circle.yml ├── examples ├── ControlGallery.hs ├── ReactiveBananaClickToResize.hs ├── ReactiveBananaControlGallery.hs ├── SimpleControlGallery.hs ├── SimpleCounter.hs ├── SimpleMapview.hs ├── SimpleProgressBar.lhs └── SimpleWebview.hs ├── ghci-linux.el ├── ghci.el ├── libui.cabal ├── provision.sh ├── provision_fedora.sh ├── screenshot-linux.png ├── screenshot.png ├── src ├── Graphics │ ├── LibUI.hs │ └── LibUI │ │ ├── FFI.hs │ │ ├── FFI │ │ ├── Raw.hs │ │ ├── Raw │ │ │ └── OSX.hs │ │ ├── Wrapped.hs │ │ └── Wrapped │ │ │ └── OSX.hs │ │ ├── MonadUI.hs │ │ ├── OSX.hs │ │ └── Types.hs ├── System │ ├── Info │ │ ├── Class.hs │ │ └── Class │ │ │ └── TH.hs │ └── Vagrant.hs ├── common ├── darwin ├── ui.h ├── ui_darwin.h ├── ui_unix.h ├── ui_windows.h ├── uitable.h ├── unix └── windows ├── stack.yaml ├── stuff.hs └── test ├── SanitySpec.hs └── Spec.hs /.dockerignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Created by https://www.gitignore.io/api/haskell 3 | 4 | ### Haskell ### 5 | dist 6 | dist-* 7 | cabal-dev 8 | *.o 9 | *.hi 10 | *.chi 11 | *.chs.h 12 | *.dyn_o 13 | *.dyn_hi 14 | .hpc 15 | .hsenv 16 | .cabal-sandbox/ 17 | cabal.sandbox.config 18 | *.prof 19 | *.aux 20 | *.hp 21 | *.eventlog 22 | .stack-work/ 23 | cabal.project.local 24 | research 25 | .vagrant 26 | READMEExample 27 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | stages: 2 | - build 3 | 4 | stack-build: 5 | stage: build 6 | script: 7 | - stack build 8 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "vendor/libui"] 2 | path = vendor/libui 3 | url = git@github.com:beijaflor-io/libui 4 | [submodule "vendor/haskell-ascii-progress"] 5 | path = vendor/haskell-ascii-progress 6 | url = git@github.com:yamadapc/haskell-ascii-progress 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | build: FORCE 2 | git submodule update --init 3 | stack build --install-ghc --allow-different-user 4 | 5 | READMEExample: FORCE 6 | stack ghc --package libui ./READMEExample.hs 7 | rm READMEExample.{o,hi} 8 | 9 | vagrant-build: FORCE 10 | vagrant up && vagrant provision && vagrant ssh -c 'cd /vagrant && make build' 11 | 12 | markd: FORCE 13 | cd ./apps/markd/ && make 14 | 15 | gists: FORCE 16 | cd ./apps/gists/ && make 17 | 18 | libui: FORCE 19 | cd ./vendor/libui && mkdir -p build && cd build && rm -rf * && cmake .. && make examples 20 | 21 | run: FORCE 22 | stack run -i 23 | 24 | test: FORCE 25 | stack test 26 | 27 | provision-ubuntu: FORCE 28 | bash -e provision.sh 29 | 30 | ./vendor/libui/build/out/libui.so: FORCE 31 | cd ./vendor/libui && rm -rf build && mkdir build && cd build && cmake .. && make 32 | 33 | ghci: FORCE 34 | make ./vendor/libui/build/out/libui.so 35 | stack ghc --verbose -- --interactive -L./vendor/libui/build/out/ -lui -optl-Wl,-rpath,'$ORIGIN' 36 | 37 | ghci-linux: FORCE 38 | stack ghc -- --interactive -L./vendor/libui/build/out/ -lcairo -lui 39 | 40 | FORCE: 41 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # haskell-libui 2 | **GPLv3** 3 | - - - 4 | 5 | Haskell bindings to the [`libui`](https://github.com/andlabs/libui) C library. 6 | 7 | The library is currently only an FFI wrapper. 8 | 9 | Useful top-level modules are: 10 | - `Graphics.LibUI` 11 | - `Graphics.LibUI.OSX` 12 | 13 | They export general and OSX specific functionality in raw C and "wrapped" 14 | Haskell APIs. Currently implemented for OSX only are wrappers for Webkit and a 15 | partial wrapper to Mapviews, both of which have examples. This should go back to 16 | upstream `libui` once it's solid. 17 | 18 | **Important** 19 | 20 | This package needs some splitting and cleaning-up, as well as some more work, 21 | but the bits exposed by `Graphics.LibUI.FFI` (`Graphics.LibUI.FFI.Wrapped`, 22 | `Graphics.LibUI.FFI.Raw` & OSX variants) should be ok to use. 23 | 24 | They aren't used in anything serious right now. You'd be courageous to do it. 25 | 26 | ## Usage 27 | ```haskell 28 | import Graphics.LibUI 29 | main = do 30 | uiInit 31 | wn <- uiNewWindow "Haskell on GUIs" 220 100 True 32 | btn <- uiNewButton "Click me" 33 | wn `setChild` btn 34 | wn `setMargined` True 35 | uiShow wn 36 | uiMain 37 | ``` 38 | ![](/screenshot.png) 39 | ![](/screenshot-linux.png) 40 | 41 | You can run this example with: 42 | ``` 43 | git clone https://github.com/beijaflor-io/haskell-libui 44 | cd haskell-libui 45 | make READMEExample 46 | ./READMEExample 47 | ``` 48 | 49 | ## Examples 50 | There're several examples on the `examples` directory. The `Simple...` examples 51 | only use the `Graphics.LibUI.FFI` part of the library and are what you want to 52 | look at first. 53 | 54 | The `ReactiveBanana...` examples are playgrounds for showing how you could wrap 55 | the callback based API with FRP without much work. 56 | 57 | ### markd - A simple GUI for Pandoc using a webview 58 | `apps/markd` is an example application (currently only working on OSX), which 59 | previews how a file is rendered by `pandoc`. 60 | ![](https://www.dropbox.com/s/oxva6l87qjg24yf/Screenshot%202016-08-16%2000.15.01.png?dl=1) 61 | 62 | - - - 63 | ## Roadmap 64 | 65 | - [x] Raw FFI available in `Graphics.LibUI.FFI.Raw` 66 | * [x] All functions from the FFI mirror their `libui` names prefixed with `c_` 67 | * [x] Document the FFI 68 | - [x] Haskell callback based API in `Graphics.LibUI.FFI.Wrapped` 69 | * [x] Data-wrappers for `uiControl` type 70 | * [x] Callback based API 71 | - [ ] Higher-level API on `examples` and `Graphics.LibUI.Types` and 72 | `Graphics.LibUI.MonadUI` 73 | * [x] Building concrete representations of UI controls based on declarative 74 | code 75 | * [ ] _Currently in the examples_ Wrap the callback based code under an FRP 76 | layer 77 | * [ ] Library consistency 78 | - Containers return their concrete representation and their children's 79 | return value 80 | - `MonadUI` shouldn't wrap IO actions, but abstract commands: 81 | * `data UI = UI [UIControl]` 82 | * `class MonadUI m b where runUI :: UI -> m b` 83 | * `instance MonadUI IO CUIControl where runUI = toCUIControlIO` 84 | 85 | - - - 86 | 87 | The aim of `Graphics.LibUI.Types` and friends is to end-up with code that looks 88 | like: 89 | ```haskell 90 | runUILoop do 91 | menu "File" [ "Open" 92 | , "Save" 93 | , UIMenuItemQuit 94 | ] 95 | void $ window "libui Control Gallery" 640 300 True $ 96 | void $ tabs $ do 97 | tab "Basic Controls" $ do 98 | hbox $ 99 | button "Button" 100 | checkbox "Checkbox" 101 | label "This is a label. Right now, labels can only span one line." 102 | void $ group "Entries" $ 103 | form [ formItem "Entry" (entry "") 104 | , formItem "Entry" (entry "") 105 | , formItem "Search Entry" (searchEntry "") 106 | ] 107 | tab "Basic Controls" $ hbox $ do 108 | void $ group "Numbers" (return ()) 109 | void $ group "Lists" (return ()) 110 | tab "Data Choosers" mempty 111 | ``` 112 | 113 | - - - 114 | 115 | Tested on OSX, Fedora and Ubuntu 14.04. A Vagrantfile is available. 116 | 117 | ## License 118 | This code is published under the **GPLv3** license 119 | -------------------------------------------------------------------------------- /READMEExample.hs: -------------------------------------------------------------------------------- 1 | import Graphics.LibUI 2 | main = do 3 | uiInit 4 | wn <- uiNewWindow "Haskell on GUIs" 220 100 True 5 | btn <- uiNewButton "Click me" 6 | wn `setChild` btn 7 | wn `setMargined` True 8 | uiShow wn 9 | uiMain 10 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /Vagrantfile: -------------------------------------------------------------------------------- 1 | # -*- mode: ruby -*- 2 | # vi: set ft=ruby : 3 | 4 | # All Vagrant configuration is done below. The "2" in Vagrant.configure 5 | # configures the configuration version (we support older styles for 6 | # backwards compatibility). Please don't change it unless you know what 7 | # you're doing. 8 | Vagrant.configure(2) do |config| 9 | # The most common configuration options are documented and commented below. 10 | # For a complete reference, please see the online documentation at 11 | # https://docs.vagrantup.com. 12 | 13 | # Every Vagrant development environment requires a box. You can search for 14 | # boxes at https://atlas.hashicorp.com/search. 15 | config.vm.box = "ubuntu/trusty64" 16 | 17 | # Disable automatic box update checking. If you disable this, then 18 | # boxes will only be checked for updates when the user runs 19 | # `vagrant box outdated`. This is not recommended. 20 | # config.vm.box_check_update = false 21 | 22 | # Create a forwarded port mapping which allows access to a specific port 23 | # within the machine from a port on the host machine. In the example below, 24 | # accessing "localhost:8080" will access port 80 on the guest machine. 25 | # config.vm.network "forwarded_port", guest: 80, host: 8080 26 | 27 | # Create a private network, which allows host-only access to the machine 28 | # using a specific IP. 29 | # config.vm.network "private_network", ip: "192.168.33.10" 30 | 31 | # Create a public network, which generally matched to bridged network. 32 | # Bridged networks make the machine appear as another physical device on 33 | # your network. 34 | # config.vm.network "public_network" 35 | 36 | # Share an additional folder to the guest VM. The first argument is 37 | # the path on the host to the actual folder. The second argument is 38 | # the path on the guest to mount the folder. And the optional third 39 | # argument is a set of non-required options. 40 | # config.vm.synced_folder "../data", "/vagrant_data" 41 | 42 | # Provider-specific configuration so you can fine-tune various 43 | # backing providers for Vagrant. These expose provider-specific options. 44 | # Example for VirtualBox: 45 | # 46 | config.vm.provider "virtualbox" do |vb| 47 | # Customize the amount of memory on the VM: 48 | vb.memory = "4096" 49 | vb.cpus = 4 50 | end 51 | # 52 | # View the documentation for the provider you are using for more 53 | # information on available options. 54 | 55 | # Define a Vagrant Push strategy for pushing to Atlas. Other push strategies 56 | # such as FTP and Heroku are also available. See the documentation at 57 | # https://docs.vagrantup.com/v2/push/atlas.html for more information. 58 | # config.push.define "atlas" do |push| 59 | # push.app = "YOUR_ATLAS_USERNAME/YOUR_APPLICATION_NAME" 60 | # end 61 | 62 | # Enable provisioning with a shell script. Additional provisioners such as 63 | # Puppet, Chef, Ansible, Salt, and Docker are also available. Please see the 64 | # documentation for more information about their specific syntax and use. 65 | config.vm.provision "shell", inline: <<-SHELL 66 | sudo bash -e /vagrant/provision.sh 67 | cd /vagrant && sudo make 68 | SHELL 69 | end 70 | -------------------------------------------------------------------------------- /apps/gists/.gitignore: -------------------------------------------------------------------------------- 1 | markd 2 | -------------------------------------------------------------------------------- /apps/gists/Makefile: -------------------------------------------------------------------------------- 1 | gists: FORCE 2 | stack build --ghc-options=-O2 --ghc-options=-threaded 3 | cp .stack-work/dist/x86_64-osx/Cabal-1.24.0.0/build/gists/gists . 4 | strip ./gists 5 | upx ./gists 6 | du -h gists 7 | 8 | build: FORCE 9 | stack build 10 | 11 | FORCE: 12 | -------------------------------------------------------------------------------- /apps/gists/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /apps/gists/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Concurrent 3 | import Control.Lens 4 | import Control.Monad 5 | import Data.Aeson 6 | import Data.Aeson.Lens 7 | import qualified Data.ByteString.Lazy.Char8 as ByteString (pack, unpack) 8 | import qualified Data.Text as Text (unpack) 9 | import Graphics.LibUI 10 | import Graphics.LibUI.OSX 11 | import Network.Wreq 12 | 13 | data FileMenu c = FileMenu c c c c 14 | 15 | uiNewFileMenu = uiNewMenu "File" >>= \menu -> do 16 | uiMenuAppendQuitItem menu 17 | FileMenu 18 | <$> uiMenuAppendItemWithDefaultTarget menu "New" "n" "onClicked:" 19 | <*> uiMenuAppendItemWithDefaultTarget menu "Open" "o" "onClicked:" 20 | <*> uiMenuAppendItemWithDefaultTarget menu "Save" "s" "onClicked:" 21 | <*> uiMenuAppendItemWithDefaultTarget menu "Save As" "S" "onClicked:" 22 | 23 | uiNewEditMenu = uiNewMenu "Edit" >>= \menu -> do 24 | uiMenuAppendItemWith menu "Undo" "z" "undo:" 25 | uiMenuAppendItemWith menu "Redo" "r" "redo:" 26 | uiMenuAppendSeparator menu 27 | uiMenuAppendItemWith menu "Copy" "c" "copy:" 28 | uiMenuAppendItemWith menu "Cut" "x" "cut:" 29 | uiMenuAppendItemWith menu "Paste" "v" "paste:" 30 | uiMenuAppendItemWith menu "Select All" "a" "selectAll:" 31 | 32 | makeControls = do 33 | g <- uiNewGroup "Languages" 34 | vb <- uiNewVerticalBox 35 | g `setChild` vb 36 | let languages = [ "Haskell" 37 | , "JavaScript" 38 | , "D" 39 | ] 40 | 41 | forM_ languages $ 42 | \l -> do 43 | l' <- uiNewButton l 44 | vb `appendChild` l' 45 | 46 | return g 47 | 48 | makeGist :: Value -> IO CUIGroup 49 | makeGist gist = do 50 | g <- uiNewGroup (Text.unpack (gist ^. key "url" . _String)) 51 | l <- uiNewLabel (Text.unpack (gist ^. key "created_at" . _String)) 52 | g `setChild` l 53 | return g 54 | 55 | makeWindow gistsC (FileMenu n o s sa) = do 56 | hb <- uiNewHorizontalBox 57 | hb `setPadded` True 58 | 59 | hb `appendIOChild` makeControls 60 | 61 | g <- uiNewGroup "Gists" 62 | vb <- uiNewVerticalBox 63 | -- me <- uiNewMultilineEntry 64 | -- vb `appendChildStretchy` me 65 | g `setChild` vb 66 | hb `appendChild` g 67 | 68 | wn <- uiNewWindow "gists" 700 500 True 69 | wn `setChild` hb 70 | wn `setMargined` True 71 | wn `onClosing` uiQuit 72 | 73 | uiOnShouldQuit $ do 74 | uiQuit 75 | return 1 76 | 77 | forkIO $ forever $ do 78 | gists <- readChan gistsC 79 | uiQueueMain $ do 80 | forM_ gists $ \gist -> do 81 | gist <- makeGist (head gists) 82 | vb `appendChild` gist 83 | print gists 84 | -- me `setText` show gists 85 | 86 | return wn 87 | 88 | getGists :: String -> IO [Value] 89 | getGists str = do 90 | res <- get "https://api.github.com/gists" >>= asJSON 91 | return $ res ^. responseBody 92 | 93 | main :: IO () 94 | main = do 95 | uiInit 96 | 97 | gistsC <- newChan 98 | forkIO $ do 99 | gists <- getGists "yamadapc" 100 | writeChan gistsC gists 101 | 102 | fileMenu <- uiNewFileMenu 103 | uiNewEditMenu 104 | 105 | wn <- makeWindow gistsC fileMenu 106 | 107 | uiShow wn 108 | uiMain 109 | -------------------------------------------------------------------------------- /apps/gists/gists: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/beijaflor-io/haskell-libui/4d1fad25e220071c4c977f79f05b482c2c36af84/apps/gists/gists -------------------------------------------------------------------------------- /apps/gists/gists.cabal: -------------------------------------------------------------------------------- 1 | name: gists 2 | version: 0.1.0.0 3 | synopsis: Initial project template from stack 4 | description: Please see README.md 5 | homepage: https://github.com/yamadapc/gists#readme 6 | license: GPLv3 7 | license-file: LICENSE 8 | author: Pedro Tacla Yamada 9 | maintainer: tacla.yamada@gmail.com 10 | copyright: Copyright (c) 2015 Pedro Tacla Yamada 11 | category: Web 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | executable gists 17 | hs-source-dirs: app 18 | main-is: Main.hs 19 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 20 | build-depends: aeson 21 | , base 22 | , bytestring 23 | , github 24 | , lens 25 | , lens-aeson 26 | , libui 27 | , text 28 | , wreq 29 | default-language: Haskell2010 30 | -------------------------------------------------------------------------------- /apps/gists/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | extra-package-dbs: [] 3 | packages: 4 | - '.' 5 | - ../.. 6 | extra-deps: 7 | - pqueue-1.3.1.1 8 | - reactive-banana-1.1.0.1 9 | - c-storable-deriving-0.1.3 10 | resolver: lts-6.8 11 | -------------------------------------------------------------------------------- /apps/markd/.gitignore: -------------------------------------------------------------------------------- 1 | markd 2 | -------------------------------------------------------------------------------- /apps/markd/Makefile: -------------------------------------------------------------------------------- 1 | markd: FORCE 2 | stack build --ghc-options=-O2 --ghc-options=-threaded 3 | cp .stack-work/dist/x86_64-osx/Cabal-1.24.0.0/build/markd/markd . 4 | strip ./markd 5 | upx ./markd 6 | du -h markd 7 | 8 | build: FORCE 9 | stack build 10 | 11 | FORCE: 12 | -------------------------------------------------------------------------------- /apps/markd/README.md: -------------------------------------------------------------------------------- 1 | # markd 2 | **markd** is an example usage of **haskell-libui**. It exposes a very simple 3 | interface using a webview and a textbox that packs **pandoc** into an OSX GUI. 4 | 5 | The resulting binary is 11MB compressed. 6 | 7 | ![](https://www.dropbox.com/s/oxva6l87qjg24yf/Screenshot%202016-08-16%2000.15.01.png?dl=1) 8 | -------------------------------------------------------------------------------- /apps/markd/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /apps/markd/app/Main.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Graphics.LibUI 3 | import Graphics.LibUI.OSX 4 | import Text.Pandoc 5 | import qualified Data.ByteString.Lazy.Char8 as ByteString (pack, unpack) 6 | 7 | runRender cr cw me webview = do 8 | r <- getValue cr 9 | w <- getValue cw 10 | e <- getText me 11 | 12 | when (r /= -1 && w /= -1) $ do 13 | einp <- case (readers !! r) of 14 | (_, StringReader rf) -> rf def e 15 | (_, ByteStringReader rf) -> do 16 | ei <- rf def (ByteString.pack e) 17 | return $ fmap fst ei 18 | case einp of 19 | Left err -> print err 20 | Right inp -> do 21 | out <- case (writers !! w) of 22 | (_, PureStringWriter wf) -> 23 | return (wf def inp) 24 | (_, IOStringWriter wf) -> 25 | wf def inp 26 | (_, IOByteStringWriter wf) -> 27 | ByteString.unpack <$> wf def inp 28 | webview `loadHtml` 29 | ( unlines [ "
" 30 | , out 31 | , "
" 32 | ] 33 | , "" 34 | ) 35 | 36 | makeInputs = do 37 | cr <- uiNewCombobox 38 | cr `appendOptions` (map fst readers) 39 | cr `setValue` 2 40 | 41 | lhb <- uiNewVerticalBox 42 | lhb `setPadded` True 43 | me <- uiNewMultilineEntry 44 | 45 | lhb `appendChild` cr 46 | lhb `appendChildStretchy` me 47 | inpC <- uiNewGroup "Input" 48 | inpC `setMargined` True 49 | inpC `setChild` lhb 50 | return (inpC, cr, me) 51 | 52 | makeOutputs = do 53 | webview <- uiNewWebview 54 | cw <- uiNewCombobox 55 | cw `appendOptions` (map fst writers) 56 | cw `setValue` 8 57 | 58 | rhb <- uiNewVerticalBox 59 | rhb `setPadded` True 60 | rhb `appendChild` cw 61 | rhb `appendChildStretchy` webview 62 | outC <- uiNewGroup "Output" 63 | outC `setMargined` True 64 | outC `setChild` rhb 65 | return (outC, cw, webview) 66 | 67 | data FileMenu c = FileMenu c c c c 68 | 69 | uiNewFileMenu = uiNewMenu "File" >>= \menu -> do 70 | uiMenuAppendQuitItem menu 71 | FileMenu 72 | <$> uiMenuAppendItemWithDefaultTarget menu "New" "n" "onClicked:" 73 | <*> uiMenuAppendItemWithDefaultTarget menu "Open" "o" "onClicked:" 74 | <*> uiMenuAppendItemWithDefaultTarget menu "Save" "s" "onClicked:" 75 | <*> uiMenuAppendItemWithDefaultTarget menu "Save As" "S" "onClicked:" 76 | 77 | uiNewEditMenu = uiNewMenu "Edit" >>= \menu -> do 78 | uiMenuAppendItemWith menu "Undo" "z" "undo:" 79 | uiMenuAppendItemWith menu "Redo" "r" "redo:" 80 | uiMenuAppendSeparator menu 81 | uiMenuAppendItemWith menu "Copy" "c" "copy:" 82 | uiMenuAppendItemWith menu "Cut" "x" "cut:" 83 | uiMenuAppendItemWith menu "Paste" "v" "paste:" 84 | uiMenuAppendItemWith menu "Select All" "a" "selectAll:" 85 | 86 | makeWindow (FileMenu n o s sa) = do 87 | (inpC, cr, me) <- makeInputs 88 | (outC, cw, webview) <- makeOutputs 89 | 90 | let runRender' = runRender cr cw me webview 91 | me `onChange` runRender' 92 | cr `onChange` runRender' 93 | cw `onChange` runRender' 94 | 95 | hb <- uiNewHorizontalBox 96 | hb `setPadded` True 97 | hb `appendChildStretchy` inpC 98 | hb `appendChildStretchy` outC 99 | 100 | wn <- uiNewWindow "markd - Pandoc on GUIs" 700 500 True 101 | wn `setChild` hb 102 | wn `setMargined` True 103 | wn `onClosing` uiQuit 104 | uiOnShouldQuit $ do 105 | uiQuit 106 | return 1 107 | 108 | n `onClick` do 109 | me `setText` "" 110 | runRender' 111 | o `onClick` do 112 | mfp <- uiOpenFile wn 113 | case mfp of 114 | Just fp -> do 115 | fc <- readFile fp 116 | me `setText` fc 117 | runRender' 118 | Nothing -> return () 119 | -- TODO - On "Save" & "Save As..." save pandoc's output 120 | -- s `onClick` do 121 | -- sa `onClick` do 122 | -- mfp <- uiOpenFile wn 123 | -- print mfp 124 | return wn 125 | 126 | main :: IO () 127 | main = do 128 | uiInit 129 | 130 | fileMenu <- uiNewFileMenu 131 | uiNewEditMenu 132 | 133 | wn <- makeWindow fileMenu 134 | 135 | uiShow wn 136 | uiMain 137 | -------------------------------------------------------------------------------- /apps/markd/markd.cabal: -------------------------------------------------------------------------------- 1 | name: markd 2 | version: 0.1.0.0 3 | synopsis: Initial project template from stack 4 | description: Please see README.md 5 | homepage: https://github.com/yamadapc/markd#readme 6 | license: GPLv3 7 | license-file: LICENSE 8 | author: Pedro Tacla Yamada 9 | maintainer: tacla.yamada@gmail.com 10 | copyright: Copyright (c) 2015 Pedro Tacla Yamada 11 | category: Web 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | executable markd 17 | hs-source-dirs: app 18 | main-is: Main.hs 19 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 20 | build-depends: base 21 | , bytestring 22 | , libui 23 | , pandoc 24 | default-language: Haskell2010 25 | -------------------------------------------------------------------------------- /apps/markd/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | extra-package-dbs: [] 3 | packages: 4 | - '.' 5 | - '../..' 6 | extra-deps: 7 | - pqueue-1.3.1.1 8 | - reactive-banana-1.1.0.1 9 | - c-storable-deriving-0.1.3 10 | resolver: lts-6.8 11 | -------------------------------------------------------------------------------- /build.dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu 2 | RUN sudo apt-get update 3 | RUN sudo apt-get install wget -y 4 | RUN wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add - 5 | RUN echo 'deb http://download.fpcomplete.com/ubuntu/precise stable main'|sudo tee /etc/apt/sources.list.d/fpco.list 6 | RUN sudo apt-get update 7 | RUN sudo apt-get install stack -y 8 | RUN sudo apt-get install libgtk-3-dev -y 9 | RUN sudo apt-get install build-essential -y 10 | ADD . /app 11 | WORKDIR /app 12 | RUN make 13 | -------------------------------------------------------------------------------- /cbits/mapview.m: -------------------------------------------------------------------------------- 1 | // 15 august 2015 2 | #import "uipriv_darwin.h" 3 | #import "MapKit/MapKit.h" 4 | 5 | struct uiMapview { 6 | uiDarwinControl c; 7 | 8 | MKMapView *mapview; 9 | }; 10 | 11 | @interface mapviewDelegateClass : NSObject { 12 | struct mapTable *maps; 13 | } 14 | - (void)registerMap:(uiMapview *)m; 15 | @end 16 | 17 | @implementation mapviewDelegateClass 18 | - (id)init { 19 | self = [super init]; 20 | if (self) 21 | self->maps = newMap(); 22 | return self; 23 | } 24 | - (void)dealloc { 25 | mapDestroy(self->maps); 26 | [super dealloc]; 27 | } 28 | 29 | - (void)registerMap:(uiMapview *)m { 30 | mapSet(self->maps, m->mapview, m); 31 | m->mapview.delegate = self; 32 | } 33 | @end 34 | 35 | static mapviewDelegateClass *mapDelegate = nil; 36 | 37 | uiDarwinControlAllDefaultsExceptDestroy(uiMapview, mapview) 38 | 39 | static void uiMapviewDestroy(uiControl *c) { 40 | uiMapview* m = uiMapview(c); 41 | [m->mapview release]; 42 | uiFreeControl(c); 43 | } 44 | 45 | void uiMapviewSetRegion(uiMapview *m) { 46 | NSLog(@"Setting region"); 47 | 48 | CLLocationCoordinate2D coord; 49 | coord.latitude = 37.423617; 50 | coord.longitude = -122.220154; 51 | NSLog(@"Created coord"); 52 | 53 | MKCoordinateSpan span; 54 | span.latitudeDelta = 10; 55 | span.longitudeDelta = 10; 56 | NSLog(@"Created span"); 57 | 58 | MKCoordinateRegion region = {coord, span}; 59 | NSLog(@"Created region"); 60 | 61 | MKCoordinateRegion aregion = [m->mapview regionThatFits:region]; 62 | NSLog(@"Adjusted region"); 63 | [m->mapview setRegion:aregion animated:YES]; 64 | NSLog(@"Region set"); 65 | } 66 | 67 | uiMapview *uiNewMapview() { 68 | uiMapview *m; 69 | uiDarwinNewControl(uiMapview, m); 70 | 71 | m->mapview = [[MKMapView alloc] initWithFrame:NSZeroRect]; 72 | m->mapview.mapType = MKMapTypeStandard; 73 | 74 | if (mapDelegate == nil) { 75 | mapDelegate = [[mapviewDelegateClass new] autorelease]; 76 | [delegates addObject:mapDelegate]; 77 | } 78 | [mapDelegate registerMap:m]; 79 | 80 | return m; 81 | } 82 | -------------------------------------------------------------------------------- /circle.yml: -------------------------------------------------------------------------------- 1 | machine: 2 | services: 3 | - docker 4 | 5 | checkout: 6 | post: 7 | - git submodule sync 8 | - git submodule update --init --recursive || (rm -fr .git/config .git/modules && git submodule deinit -f . && git submodule update --init --recursive) 9 | 10 | dependencies: 11 | cache_directories: 12 | - "~/.stack" 13 | - ".stack" 14 | # - "cmake-3.2.2" 15 | # - "vendor/libui/build" 16 | pre: 17 | - sudo apt-get update 18 | - sudo apt-get install upstart upstart-job libgtk-3-dev libgtk-3-0 libgtk-3-bin libgtk-3-common -y 19 | - wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add - 20 | - echo 'deb http://download.fpcomplete.com/ubuntu/precise stable main'|sudo tee /etc/apt/sources.list.d/fpco.list 21 | - sudo apt-get update && sudo apt-get install stack -y 22 | - sudo apt-get install build-essential 23 | 24 | override: 25 | # - wget http://www.cmake.org/files/v3.2/cmake-3.2.2.tar.gz 26 | # - tar xf cmake-3.2.2.tar.gz 27 | # - cd cmake-3.2.2 && ./bootstrap && make 28 | # - cd vendor/libui && mkdir build && cd build && ../../../cmake-3.2.2/bin/cmake .. && make 29 | - stack build --only-dependencies --install-ghc --test 30 | 31 | test: 32 | pre: [] 33 | override: 34 | - make 35 | - stack test 36 | - cp -r `stack path --dist-dir` $CIRCLE_ARTIFACTS/ 37 | # - docker build -f ./build.dockerfile . 38 | -------------------------------------------------------------------------------- /examples/ControlGallery.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | import Control.Concurrent 4 | import Data.Time 5 | import Graphics.LibUI 6 | 7 | main :: IO () 8 | main = runUILoop $ 9 | window' def { uiWindowTitle = "Control Gallery" 10 | , uiWindowWidth = 200 11 | , uiWindowChild = vbox $ 12 | mdo time <- label "Simple UI" 13 | countM <- liftIO $ newMVar 0 :: UI (MVar Int) 14 | counter <- label "" 15 | btn <- button def { uiButtonText = "Should be simple" 16 | , uiButtonOnClicked = Just $ 17 | mdo currentTime <- getCurrentTime 18 | time `setText` 19 | ("Simple UI at " ++ 20 | show currentTime) 21 | currentCount <- modifyMVar countM 22 | (\c -> return ( c + 23 | 1 24 | , c + 25 | 1 26 | )) 27 | counter `setText` 28 | show currentCount 29 | btn `setText` 30 | ("Should be simple " ++ 31 | show currentCount) 32 | } 33 | wrap btn 34 | } 35 | -------------------------------------------------------------------------------- /examples/ReactiveBananaClickToResize.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | import Debug.Trace 4 | import Control.Concurrent 5 | import Control.Monad 6 | import Data.Time 7 | import Graphics.LibUI 8 | 9 | import Reactive.Banana 10 | import Reactive.Banana.Frameworks 11 | 12 | -- | A button that updates it's text to reflect how many times it's been clicked 13 | counterButton :: UIButton -> UI CUIButton 14 | counterButton opts = do 15 | btn <- button opts { uiButtonText = "0" } 16 | escounter <- clickSource btn 17 | liftIO $ do 18 | network <- compile $ do 19 | ecounter <- fromAddHandler (addHandler escounter) 20 | ecount <- accumE 0 $ (+1) <$ ecounter 21 | reactimate $ showText btn <$> ecount 22 | actuate network 23 | return btn 24 | where 25 | updateUI btn currentCount = 26 | btn `setText` (uiButtonText opts ++ " " ++ show currentCount) 27 | 28 | showText c = uiQueueMain . setText c . show 29 | 30 | clickSource c = liftIO $ do 31 | esclick <- newAddHandler 32 | c `onClick` fire esclick c 33 | return esclick 34 | 35 | main :: IO () 36 | main = do 37 | escounter <- newAddHandler 38 | 39 | runUILoop $ mdo 40 | (wnd, _) <- window' def { uiWindowTitle = "Click to resize" 41 | , uiWindowWidth = 200 42 | , uiWindowHeight = 100 43 | , uiWindowChild = vbox $ mdo 44 | btn <- counterButton def 45 | return () 46 | } 47 | wrap wnd 48 | 49 | return () 50 | 51 | -- newtype AddHandler = AddHandler { register :: Handler a -> IO (IO ()) } 52 | -- type Handler = a -> IO () 53 | type EventSource a = (AddHandler a, Handler a) 54 | 55 | addHandler :: EventSource a -> AddHandler a 56 | addHandler = fst 57 | 58 | fire :: EventSource a -> a -> IO () 59 | fire = snd 60 | -------------------------------------------------------------------------------- /examples/ReactiveBananaControlGallery.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | import Control.Concurrent 4 | import Control.Monad 5 | import Data.Time 6 | import Graphics.LibUI 7 | 8 | import Reactive.Banana 9 | import Reactive.Banana.Frameworks 10 | 11 | main :: IO () 12 | main = do 13 | escounter <- newAddHandler 14 | 15 | runUILoop $ 16 | window' def { uiWindowTitle = "Control Gallery" 17 | , uiWindowWidth = 200 18 | , uiWindowChild = vbox $ 19 | mdo time <- label "Simple UI" 20 | countM <- liftIO $ newMVar 0 :: UI (MVar Int) 21 | counter <- label "" 22 | btn <- button def { uiButtonText = "Should be simple" 23 | , uiButtonOnClicked = Just (fire escounter 24 | ()) 25 | } 26 | liftIO $ do 27 | network <- setupNetwork escounter 28 | (btn, counter, time) 29 | actuate network 30 | return () 31 | } 32 | 33 | -- newtype AddHandler = AddHandler { register :: Handler a -> IO (IO ()) } 34 | -- type Handler = a -> IO () 35 | type EventSource a = (AddHandler a, Handler a) 36 | 37 | addHandler :: EventSource a -> AddHandler a 38 | addHandler = fst 39 | 40 | fire :: EventSource a -> a -> IO () 41 | fire = snd 42 | 43 | setupNetwork escounter (btn, counter, time) = compile $ do 44 | ecounter <- fromAddHandler (addHandler escounter) 45 | ecount <- accumE 0 $ (+1) <$ ecounter 46 | reactimate $ fmap updateUI ecount 47 | where 48 | updateUI currentCount = do 49 | currentTime <- getCurrentTime 50 | time `setText` ("Simple UI at " ++ show currentTime) 51 | counter `setText` show currentCount 52 | btn `setText` ("Should be simple " ++ show currentCount) 53 | -------------------------------------------------------------------------------- /examples/SimpleControlGallery.hs: -------------------------------------------------------------------------------- 1 | import Control.Concurrent 2 | import Control.Monad 3 | import Control.Monad.Loops 4 | import Data.Maybe 5 | 6 | import Graphics.LibUI.FFI 7 | 8 | makeBasicControlsTab :: IO CUIBox 9 | makeBasicControlsTab = do 10 | vb <- uiNewVerticalBox 11 | vb `setPadded` True 12 | 13 | hb <- uiNewHorizontalBox 14 | hb `setPadded` True 15 | vb `appendChild` hb 16 | 17 | hb `appendIOChild` uiNewButton "Button" 18 | hb `appendIOChild` uiNewCheckbox "Checkbox" 19 | vb `appendIOChild` uiNewLabel "This is a label. Right now, labels can only span one line" 20 | vb `appendIOChild` uiNewHorizontalSeparator 21 | 22 | group <- uiNewGroup "Entries" 23 | group `setMargined` True 24 | vb `appendChild` group 25 | 26 | entryForm <- uiNewForm 27 | entryForm `setPadded` True 28 | group `setChild` entryForm 29 | 30 | entry <- uiNewEntry 31 | entryForm `appendInput` ("Entry", entry) 32 | passwordEntry <- uiNewPasswordEntry 33 | entryForm `appendInput` ("Password Entry", passwordEntry) 34 | searchEntry <- uiNewSearchEntry 35 | entryForm `appendInput` ("Search Entry", searchEntry) 36 | multilineEntry <- uiNewMultilineEntry 37 | entryForm `appendInput` ("Multiline Entry", multilineEntry) 38 | nonWrappingMultilineEntry <- uiNewNonWrappingMultilineEntry 39 | entryForm `appendInput` ("NonWrappingMultiline Entry", nonWrappingMultilineEntry) 40 | 41 | return vb 42 | 43 | makeNumbersTab :: IO CUIBox 44 | makeNumbersTab = do 45 | hb <- uiNewHorizontalBox 46 | hb `setPadded` True 47 | 48 | numbersGroup <- uiNewGroup "Numbers" 49 | numbersGroup `setMargined` True 50 | 51 | hb `appendChildStretchy` numbersGroup 52 | 53 | numbersGroupVb <- uiNewVerticalBox 54 | numbersGroupVb `setPadded` True 55 | numbersGroup `setChild` numbersGroupVb 56 | 57 | spinbox <- uiNewSpinbox 0 100 58 | numbersGroupVb `appendChild` spinbox 59 | slider <- uiNewSlider 0 100 60 | numbersGroupVb `appendChild` slider 61 | pbar <- uiNewProgressBar 62 | numbersGroupVb `appendChild` pbar 63 | 64 | spinbox `onChange` do 65 | svalue <- getValue spinbox 66 | pbar `setValue` svalue 67 | slider `onChange` do 68 | svalue <- getValue slider 69 | pbar `setValue` svalue 70 | 71 | ipbar <- uiNewProgressBar 72 | ipbar `setValue` (-1) 73 | numbersGroupVb `appendChild` ipbar 74 | 75 | listsGroup <- uiNewGroup "Lists" 76 | listsGroup `setMargined` True 77 | hb `appendChildStretchy` listsGroup 78 | 79 | listsGroupVb <- uiNewVerticalBox 80 | listsGroupVb `setPadded` True 81 | listsGroup `setChild` listsGroupVb 82 | combobox <- uiNewCombobox 83 | combobox `appendOptions` [ "Combobox Item 1" 84 | , "Combobox Item 2" 85 | , "Combobox Item 3" 86 | ] 87 | listsGroupVb `appendChild` combobox 88 | 89 | ecombobox <- uiNewEditableCombobox 90 | ecombobox `appendOptions` [ "Editable Combobox Item 1" 91 | , "Editable Combobox Item 2" 92 | , "Editable Combobox Item 3" 93 | ] 94 | listsGroupVb `appendChild` ecombobox 95 | 96 | rb <- uiNewRadioButtons 97 | rb `appendOptions` [ "Radio Button 1" 98 | , "Radio Button 2" 99 | , "Radio Button 3" 100 | ] 101 | listsGroupVb `appendChild` rb 102 | 103 | return hb 104 | 105 | makeDataChoosersTab :: CUIWindow -> IO CUIBox 106 | makeDataChoosersTab window = do 107 | hb <- uiNewHorizontalBox 108 | hb `setPadded` True 109 | 110 | vbLeft <- uiNewVerticalBox 111 | vbLeft `setPadded` True 112 | hb `appendChild` vbLeft 113 | 114 | vbLeft `appendIOChild` uiNewDatePicker 115 | vbLeft `appendIOChild` uiNewTimePicker 116 | vbLeft `appendIOChild` uiNewDateTimePicker 117 | 118 | vbLeft `appendIOChild` uiNewFontButton 119 | vbLeft `appendIOChild` uiNewColorButton 120 | 121 | hb `appendIOChild` uiNewVerticalSeparator 122 | 123 | vbRight <- uiNewVerticalBox 124 | vbRight `setPadded` True 125 | hb `appendChildStretchy` vbRight 126 | 127 | grid <- uiNewGrid 128 | grid `setPadded` True 129 | vbRight `appendChild` grid 130 | 131 | openFileBtn <- uiNewButton "Open file" 132 | openFileEntry <- uiNewEntry 133 | openFileEntry `setReadOnly` True 134 | 135 | openFileBtn `onClick` do 136 | mfp <- uiOpenFile window 137 | let fp = fromMaybe "(cancelled)" mfp 138 | openFileEntry `setText` fp 139 | 140 | uiGridAppend grid openFileBtn 0 0 1 1 0 UIAlignFill 0 UIAlignFill 141 | uiGridAppend grid openFileEntry 1 0 1 1 1 UIAlignFill 0 UIAlignFill 142 | 143 | saveFileBtn <- uiNewButton "Save file" 144 | saveFileEntry <- uiNewEntry 145 | saveFileEntry `setReadOnly` True 146 | saveFileBtn `onClick` do 147 | mfp <- uiSaveFile window 148 | case mfp of 149 | Just fp -> uiMsgBox window "File selected (don't worry, it's still there)" fp 150 | Nothing -> uiMsgBoxError window "No file selected" "Don't be alarmed!" 151 | 152 | 153 | uiGridAppend grid saveFileBtn 0 1 1 1 0 UIAlignFill 0 UIAlignFill 154 | uiGridAppend grid saveFileEntry 1 1 1 1 1 UIAlignFill 0 UIAlignFill 155 | 156 | msgGrid <- uiNewGrid 157 | msgGrid `setPadded` True 158 | uiGridAppend grid msgGrid 0 2 2 1 0 UIAlignCenter 0 UIAlignStart 159 | 160 | msgBtn <- uiNewButton "Message box" 161 | msgBtn `onClick` 162 | uiMsgBox window "This is a normal message box." "More detailed information can be shown here." 163 | uiGridAppend msgGrid msgBtn 0 0 1 1 0 UIAlignFill 0 UIAlignFill 164 | 165 | errBtn <- uiNewButton "Error box" 166 | errBtn `onClick` 167 | uiMsgBoxError window "This is a normal message box." "More detailed information can be shown here." 168 | uiGridAppend msgGrid errBtn 1 0 1 1 0 UIAlignFill 0 UIAlignFill 169 | 170 | return hb 171 | 172 | main :: IO () 173 | main = do 174 | uiInit 175 | wn <- uiNewWindow "haskell-libui - Simple Control Gallery" 640 480 True 176 | wn `onClosing` uiQuit 177 | uiOnShouldQuit $ do 178 | uiQuit 179 | return 0 180 | 181 | tabs <- uiNewTabs 182 | wn `setChild` tabs 183 | wn `setMargined` True 184 | 185 | basicControlsTab <- makeBasicControlsTab 186 | tabs `appendTab` ("Basic Controls", basicControlsTab) 187 | (tabs, 0 :: Int) `setMargined` True 188 | numbersTab <- makeNumbersTab 189 | tabs `appendTabMargined` ("Numbers and Lists", numbersTab) 190 | dataChoosersTab <- makeDataChoosersTab wn 191 | tabs `appendTabMargined` ("Data Choosers", dataChoosersTab) 192 | 193 | uiShow wn 194 | 195 | uiMainSteps 196 | whileM_ getHasMain $ do 197 | h <- uiMainStep 0 198 | when (h == 0) $ threadDelay (1000 * 1000 * 16) 199 | -------------------------------------------------------------------------------- /examples/SimpleCounter.hs: -------------------------------------------------------------------------------- 1 | import Control.Concurrent 2 | import Control.Monad 3 | import Control.Monad.Loops 4 | import Graphics.LibUI 5 | 6 | main :: IO () 7 | main = do 8 | uiInit 9 | 10 | opChan <- newChan :: IO (Chan Int) 11 | addBtn <- uiNewButton "Add" 12 | subBtn <- uiNewButton "Subtract" 13 | cntLbl <- uiNewLabel "Count: 0" 14 | 15 | addBtn `onClick` writeChan opChan 1 16 | subBtn `onClick` writeChan opChan (-1) 17 | 18 | let go opChan count = do 19 | op <- readChan opChan 20 | let count' = count + op 21 | cntLbl `setText` ("Count: " ++ show count') 22 | go opChan count' 23 | 24 | forkIO $ go opChan 0 25 | 26 | wn <- uiNewWindow "SimpleCounter.hs" 220 100 True 27 | vb <- uiNewVerticalBox 28 | 29 | wn `setMargined` True 30 | wn `setChild` vb 31 | 32 | vb `appendChild` addBtn 33 | vb `appendChild` subBtn 34 | vb `appendChild` cntLbl 35 | 36 | wn `onClosing` uiQuit 37 | uiOnShouldQuit (uiQuit >> return 0) 38 | 39 | uiShow wn 40 | 41 | uiMainSteps 42 | whileM_ getHasMain $ do 43 | h <- uiMainStep 0 44 | when (h == 0) $ threadDelay (1000 * 1000 * 16) 45 | -------------------------------------------------------------------------------- /examples/SimpleMapview.hs: -------------------------------------------------------------------------------- 1 | import Control.Concurrent 2 | import Control.Monad 3 | import Control.Monad.Loops 4 | import Graphics.LibUI 5 | import Graphics.LibUI.OSX 6 | 7 | main :: IO () 8 | main = do 9 | uiInit 10 | 11 | mapview <- c_uiNewMapview 12 | {-forkIO $ do-} 13 | {-threadDelay (1000 * 1000)-} 14 | {-uiQueueMain $-} 15 | print mapview 16 | 17 | wn <- uiNewWindow "SimpleMapview.hs" 600 500 True 18 | 19 | wn `setMargined` False 20 | putStrLn "[haskell] Appending map..." 21 | wn `setChild` mapview 22 | putStrLn "[haskell] Map appended" 23 | 24 | putStrLn "[haskell] Displaying GUI..." 25 | wn `onClosing` uiQuit 26 | uiOnShouldQuit (uiQuit >> return 0) 27 | uiShow wn 28 | 29 | putStrLn "[haskell] GUI displayed..." 30 | 31 | uiMain 32 | -------------------------------------------------------------------------------- /examples/SimpleProgressBar.lhs: -------------------------------------------------------------------------------- 1 | This is a "raw" API demo. 2 | 3 | The API exposed by `Graphics.LibUI.FFI` follows the imperative spirit with some 4 | type-class sugars, but essentially is just throwing pointers around on the IO 5 | monad. 6 | 7 | Since this example involves a background-thread with a timer, that updates the 8 | progress-bar's value, we import `Control.Concurrent`. 9 | 10 | > import Control.Concurrent (forkIO, threadDelay) 11 | 12 | We also import `forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()` 13 | 14 | > import Control.Monad (forM_) 15 | 16 | `Graphics.LibUI.FFI` is the entry-point for the raw FFI module. It exports both 17 | the raw C API, as well as Haskell typed, type-class structured helpers. 18 | 19 | > import Graphics.LibUI.FFI 20 | 21 | > main :: IO () 22 | > main = do 23 | 24 | `uiInit` needs to be called to initialize `libui` before calling any other FFI 25 | functions. 26 | 27 | > uiInit 28 | 29 | We create our `CUILabel` and `CUIProgressBar` controls 30 | 31 | > lb <- uiNewLabel "Starting" 32 | > pg <- uiNewProgressBar 33 | 34 | `forkIO` forks a thread to iterate through the numbers from 0 to 100, waiting 35 | 100ms between iterations and updating the progress-bar and label's contents. 36 | 37 | > forkIO $ do 38 | > forM_ [0..100] $ \i -> do 39 | > threadDelay (1000 * 100) 40 | 41 | `uiQueueMain` is necessary when the code is multi-threaded. Haskell may or may 42 | not be using the `-threaded` RTS, but this should be used unless the updates 43 | are inside callbacks, in which case they'll be executed by the main C thread. 44 | 45 | > uiQueueMain $ do 46 | 47 | As you can see throughout, the code is based on abstract type-classes. This 48 | makes it easier to write more generic code. 49 | 50 | > lb `setText` (show i ++ "% Done") 51 | > pg `setValue` i 52 | > uiQuit 53 | 54 | We create the layout for the controls with two layout controls in `Graphics.LibUI.FFI`: 55 | - `CUIBox`, exposed from the module in `uiNewVerticalBox` 56 | and `uiNewHorizontalBox` variants 57 | - `CUIWindow`, exposed through `uiNewWindow` 58 | 59 | > hb <- uiNewVerticalBox 60 | > hb `appendChild` lb 61 | > hb `appendChild` pg 62 | > wn <- uiNewWindow "SimpleProgressBar.hs" 300 100 True 63 | > wn `setMargined` True 64 | > wn `onClosing` uiQuit 65 | > wn `setChild` hb 66 | 67 | > uiOnShouldQuit (uiQuit >> return 0) 68 | > uiShow wn 69 | > uiMain 70 | -------------------------------------------------------------------------------- /examples/SimpleWebview.hs: -------------------------------------------------------------------------------- 1 | import Control.Concurrent 2 | import Control.Monad 3 | import Control.Monad.Loops 4 | import Graphics.LibUI 5 | import Graphics.LibUI.OSX 6 | 7 | uiNewLogPanel = do 8 | e <- uiNewNonWrappingMultilineEntry 9 | e `setReadOnly` True 10 | uiSetEnabled e False 11 | wc <- newChan 12 | forkIO $ forever $ do 13 | str <- readChan wc 14 | uiQueueMain $ do 15 | e `appendText` str 16 | e `appendText` "\n" 17 | return (e, wc) 18 | 19 | main :: IO () 20 | main = do 21 | uiInit 22 | 23 | webview <- uiNewWebview 24 | webview `loadHtml` 25 | ( unlines [ "
" 26 | , "

Hello

" 27 | , " " 28 | , " " 29 | , " " 30 | , "
" 31 | , "
" 32 | ] 33 | , "" 34 | ) 35 | 36 | wn <- uiNewWindow "SimpleCounter.hs" 600 500 True 37 | 38 | hb <- uiNewHorizontalBox 39 | vb <- uiNewVerticalBox 40 | 41 | hb `appendChildStretchy` vb 42 | wn `setMargined` True 43 | wn `setChild` hb 44 | 45 | vb `appendChildStretchy` webview 46 | 47 | (e, wc) <- uiNewLogPanel 48 | hb `appendChild` e 49 | 50 | webview `onLoad` do 51 | writeChan wc "Webview loaded" 52 | c <- webview `evalJs` 53 | unlines [ "(function() {" 54 | , " $(function() {" 55 | , " var button = $('button');" 56 | , " button.click(function() {" 57 | , " button.text('Click (' + Math.round(new Date().getTime() / 1000) + ')');" 58 | , " });" 59 | , " });" 60 | , " return 'OK';" 61 | , "})();" 62 | ] 63 | writeChan wc (show ("JavaScript button starts with", c)) 64 | 65 | btn <- uiNewButton "Click to evaluate JS" 66 | btn `onClick` do 67 | r <- webview `evalJs` 68 | unlines [ "(function() {" 69 | , " var now = new Date().getTime();" 70 | , " var log = document.createElement('div');" 71 | , " log.className = 'container';" 72 | , " var pre = document.createElement('pre');" 73 | , " var code = document.createElement('code');" 74 | , " code.appendChild(" 75 | , " document.createTextNode('Hello Haskell (' + Math.round(now / 1000) + ')')" 76 | , " );" 77 | , " pre.appendChild(code);" 78 | , " log.appendChild(pre);" 79 | , " document.body.appendChild(log);" 80 | , " return now;" 81 | , "})()" 82 | ] 83 | writeChan wc (show ("JavaScript sent us", r)) 84 | vb `appendChild` btn 85 | 86 | wn `onClosing` uiQuit 87 | 88 | uiOnShouldQuit (uiQuit >> return 0) 89 | uiShow wn 90 | uiMain 91 | -------------------------------------------------------------------------------- /ghci-linux.el: -------------------------------------------------------------------------------- 1 | "stack ghc -- --interactive -L./vendor/libui/build/out/ -lui -optl-Wl,-rpath,'$ORIGIN' src/Graphics/LibUI.hs" 2 | 3 | (setq haskell-process-path-ghci '("stack")) 4 | (setq haskell-process-args-ghci '("ghc" "--" "--interactive" "-L./vendor/libui/build/out/" "-lui" "-lcairo")) 5 | (setq haskell-process-type 'ghci) 6 | -------------------------------------------------------------------------------- /ghci.el: -------------------------------------------------------------------------------- 1 | "stack ghc -- --interactive -L./vendor/libui/build/out/ -lui -optl-Wl,-rpath,'$ORIGIN' src/Graphics/LibUI.hs" 2 | 3 | (setq haskell-process-path-ghci '("stack")) 4 | (setq haskell-process-args-ghci '("ghc" "--" "--interactive" "-L./vendor/libui/build/out/" "-lui" "-optl-Wl,-rpath,'$ORIGIN'")) 5 | (setq haskell-process-type 'ghci) 6 | -------------------------------------------------------------------------------- /libui.cabal: -------------------------------------------------------------------------------- 1 | name: libui 2 | version: 0.1.0.0 3 | synopsis: Bindings to the libui C library 4 | description: Full bindings and OSX extensions to the libui C library. The 5 | packaged version of this library might not work properly yet. 6 | Please refer to the GitHub project page. 7 | homepage: https://github.com/beijaflor-io/haskell-libui 8 | license: GPL-3 9 | license-file: LICENSE 10 | author: Pedro Tacla Yamada 11 | maintainer: tacla.yamada@gmail.com 12 | category: Graphics 13 | build-type: Simple 14 | cabal-version: >= 1.10 15 | extra-tmp-files: 16 | ./vendor/libui/ui.h 17 | ./vendor/libui/uipriv.h 18 | ./vendor/libui/common/uipriv.h 19 | if os(darwin) 20 | ./vendor/libui/darwin/uipriv_darwin.h 21 | if os(linux) 22 | ./vendor/libui/unix/uipriv_unix.h 23 | 24 | library 25 | -- ld-options: -Wl,-rpath,'$ORIGIN' 26 | -- ghc-options: -optl-Wl,-rpath,'$ORIGIN'" 27 | if os(darwin) 28 | frameworks: Foundation CoreFoundation AppKit Cocoa WebKit MapKit 29 | if os(linux) 30 | extra-libraries: gtk-3 glib-2.0 gdk-3 pango-1.0 gobject-2.0 pangocairo-1.0 cairo X11 31 | include-dirs: 32 | /usr/lib/x86_64-linux-gnu/ 33 | /usr/lib/x86_64-linux-gnu/glib-2.0/include/ 34 | /usr/lib64/glib-2.0/include/ 35 | /usr/include/glib-2.0/ 36 | /usr/include/cairo/ 37 | /usr/include/pango-1.0/ 38 | /usr/include/atk-1.0/ 39 | /usr/include/gtk-3.0/ 40 | /usr/include/gdk-pixbuf-2.0/ 41 | /usr/include/gdk-pixbuf-2.0/gdk-pix/ 42 | ./vendor/libui/unix/ 43 | ./vendor/libui/unix/ 44 | -- extra-libraries: ui 45 | -- extra-lib-dirs: /Users/yamadapc/program/github.com/beijaflor-io/haskell-libui/vendor/libui/build/out/ 46 | include-dirs: . ./vendor/libui/ ./vendor/libui/common/ ./vendor/libui/darwin/ 47 | 48 | includes: 49 | ui.h 50 | uipriv.h 51 | install-includes: 52 | ui.h 53 | uipriv.h 54 | 55 | if os(linux) 56 | install-includes: 57 | ui_unix.h 58 | uipriv_unix.h 59 | 60 | if os(darwin) 61 | install-includes: 62 | ui_darwin.h 63 | uipriv_darwin.h 64 | 65 | c-sources: 66 | ./vendor/libui/common/areaevents.c 67 | ./vendor/libui/common/control.c 68 | ./vendor/libui/common/debug.c 69 | ./vendor/libui/common/matrix.c 70 | ./vendor/libui/common/shouldquit.c 71 | ./vendor/libui/common/userbugs.c 72 | if os(linux) 73 | c-sources: 74 | ./vendor/libui/unix/alloc.c 75 | ./vendor/libui/unix/area.c 76 | ./vendor/libui/unix/box.c 77 | ./vendor/libui/unix/button.c 78 | ./vendor/libui/unix/checkbox.c 79 | ./vendor/libui/unix/child.c 80 | ./vendor/libui/unix/colorbutton.c 81 | ./vendor/libui/unix/combobox.c 82 | ./vendor/libui/unix/control.c 83 | ./vendor/libui/unix/datetimepicker.c 84 | ./vendor/libui/unix/debug.c 85 | ./vendor/libui/unix/draw.c 86 | ./vendor/libui/unix/draw.h 87 | ./vendor/libui/unix/drawmatrix.c 88 | ./vendor/libui/unix/drawpath.c 89 | ./vendor/libui/unix/drawtext.c 90 | ./vendor/libui/unix/editablecombo.c 91 | ./vendor/libui/unix/entry.c 92 | ./vendor/libui/unix/fontbutton.c 93 | ./vendor/libui/unix/form.c 94 | ./vendor/libui/unix/graphemes.c 95 | ./vendor/libui/unix/grid.c 96 | ./vendor/libui/unix/group.c 97 | ./vendor/libui/unix/label.c 98 | ./vendor/libui/unix/main.c 99 | ./vendor/libui/unix/menu.c 100 | ./vendor/libui/unix/multilineentry.c 101 | ./vendor/libui/unix/progressbar.c 102 | ./vendor/libui/unix/radiobuttons.c 103 | ./vendor/libui/unix/separator.c 104 | ./vendor/libui/unix/slider.c 105 | ./vendor/libui/unix/spinbox.c 106 | ./vendor/libui/unix/stddialogs.c 107 | ./vendor/libui/unix/tab.c 108 | ./vendor/libui/unix/text.c 109 | ./vendor/libui/unix/util.c 110 | ./vendor/libui/unix/window.c 111 | if os(darwin) 112 | c-sources: 113 | ./cbits/mapview.m 114 | 115 | ./vendor/libui/darwin/alloc.m 116 | ./vendor/libui/darwin/area.m 117 | ./vendor/libui/darwin/areaevents.m 118 | ./vendor/libui/darwin/autolayout.m 119 | ./vendor/libui/darwin/box.m 120 | ./vendor/libui/darwin/button.m 121 | ./vendor/libui/darwin/checkbox.m 122 | ./vendor/libui/darwin/colorbutton.m 123 | ./vendor/libui/darwin/combobox.m 124 | ./vendor/libui/darwin/control.m 125 | ./vendor/libui/darwin/datetimepicker.m 126 | ./vendor/libui/darwin/debug.m 127 | ./vendor/libui/darwin/draw.m 128 | ./vendor/libui/darwin/drawtext.m 129 | ./vendor/libui/darwin/editablecombo.m 130 | ./vendor/libui/darwin/entry.m 131 | ./vendor/libui/darwin/fontbutton.m 132 | ./vendor/libui/darwin/form.m 133 | ./vendor/libui/darwin/grid.m 134 | ./vendor/libui/darwin/group.m 135 | ./vendor/libui/darwin/label.m 136 | ./vendor/libui/darwin/main.m 137 | ./vendor/libui/darwin/map.m 138 | ./vendor/libui/darwin/menu.m 139 | ./vendor/libui/darwin/multilineentry.m 140 | ./vendor/libui/darwin/progressbar.m 141 | ./vendor/libui/darwin/radiobuttons.m 142 | ./vendor/libui/darwin/scrollview.m 143 | ./vendor/libui/darwin/separator.m 144 | ./vendor/libui/darwin/slider.m 145 | ./vendor/libui/darwin/spinbox.m 146 | ./vendor/libui/darwin/stddialogs.m 147 | ./vendor/libui/darwin/tab.m 148 | ./vendor/libui/darwin/text.m 149 | ./vendor/libui/darwin/util.m 150 | ./vendor/libui/darwin/webview.m 151 | ./vendor/libui/darwin/window.m 152 | ./vendor/libui/darwin/winmoveresize.m 153 | build-depends: async 154 | , base >=4.8 && <5 155 | , c-storable-deriving 156 | , data-default 157 | , free 158 | , monad-loops 159 | , mtl 160 | , reactive-banana 161 | , template-haskell 162 | , time 163 | , transformers 164 | exposed-modules: Graphics.LibUI 165 | , Graphics.LibUI.OSX 166 | 167 | , Graphics.LibUI.FFI 168 | , Graphics.LibUI.FFI.Raw 169 | , Graphics.LibUI.FFI.Raw.OSX 170 | , Graphics.LibUI.FFI.Wrapped 171 | , Graphics.LibUI.FFI.Wrapped.OSX 172 | 173 | , Graphics.LibUI.Types 174 | , Graphics.LibUI.MonadUI 175 | other-modules: System.Info.Class 176 | , System.Info.Class.TH 177 | hs-source-dirs: 178 | src 179 | default-language: Haskell2010 180 | ghc-options: -threaded 181 | 182 | executable libui-simple-progressbar-example 183 | main-is: SimpleProgressBar.lhs 184 | hs-source-dirs: 185 | examples 186 | build-depends: async 187 | , base 188 | , c-storable-deriving 189 | , data-default 190 | , free 191 | , libui 192 | , monad-loops 193 | , mtl 194 | , reactive-banana 195 | , template-haskell 196 | , time 197 | , transformers 198 | default-language: Haskell2010 199 | ghc-options: -threaded 200 | 201 | executable libui-simple-counter-example 202 | main-is: SimpleCounter.hs 203 | hs-source-dirs: 204 | examples 205 | build-depends: async 206 | , base 207 | , c-storable-deriving 208 | , data-default 209 | , free 210 | , libui 211 | , monad-loops 212 | , mtl 213 | , reactive-banana 214 | , template-haskell 215 | , time 216 | , transformers 217 | default-language: Haskell2010 218 | ghc-options: -threaded 219 | 220 | executable libui-simple-control-gallery 221 | main-is: SimpleControlGallery.hs 222 | hs-source-dirs: 223 | examples 224 | build-depends: async 225 | , base 226 | , c-storable-deriving 227 | , data-default 228 | , free 229 | , libui 230 | , monad-loops 231 | , mtl 232 | , reactive-banana 233 | , template-haskell 234 | , time 235 | , transformers 236 | default-language: Haskell2010 237 | ghc-options: -threaded 238 | 239 | executable libui-simple-webview 240 | main-is: SimpleWebview.hs 241 | if os(darwin) 242 | buildable: True 243 | else 244 | buildable: False 245 | hs-source-dirs: 246 | examples 247 | build-depends: async 248 | , base 249 | , c-storable-deriving 250 | , data-default 251 | , free 252 | , libui 253 | , monad-loops 254 | , mtl 255 | , reactive-banana 256 | , template-haskell 257 | , time 258 | , transformers 259 | default-language: Haskell2010 260 | ghc-options: -threaded 261 | 262 | executable libui-simple-mapview 263 | main-is: SimpleMapview.hs 264 | if os(darwin) 265 | buildable: True 266 | else 267 | buildable: False 268 | hs-source-dirs: 269 | examples 270 | build-depends: async 271 | , base 272 | , c-storable-deriving 273 | , data-default 274 | , free 275 | , libui 276 | , monad-loops 277 | , mtl 278 | , reactive-banana 279 | , template-haskell 280 | , time 281 | , transformers 282 | default-language: Haskell2010 283 | ghc-options: -threaded 284 | 285 | executable libui-types-control-gallery 286 | main-is: ControlGallery.hs 287 | hs-source-dirs: 288 | examples 289 | build-depends: async 290 | , base 291 | , c-storable-deriving 292 | , data-default 293 | , free 294 | , libui 295 | , monad-loops 296 | , mtl 297 | , reactive-banana 298 | , template-haskell 299 | , time 300 | , transformers 301 | default-language: Haskell2010 302 | ghc-options: -threaded 303 | 304 | executable libui-reactive-banana-control-gallery 305 | main-is: ReactiveBananaControlGallery.hs 306 | hs-source-dirs: 307 | examples 308 | build-depends: async 309 | , base 310 | , c-storable-deriving 311 | , data-default 312 | , free 313 | , libui 314 | , monad-loops 315 | , mtl 316 | , reactive-banana 317 | , template-haskell 318 | , time 319 | , transformers 320 | default-language: Haskell2010 321 | ghc-options: -threaded 322 | 323 | executable libui-reactive-banana-click-to-resize 324 | main-is: ReactiveBananaClickToResize.hs 325 | hs-source-dirs: 326 | examples 327 | build-depends: async 328 | , base 329 | , c-storable-deriving 330 | , data-default 331 | , free 332 | , libui 333 | , monad-loops 334 | , mtl 335 | , reactive-banana 336 | , template-haskell 337 | , time 338 | , transformers 339 | default-language: Haskell2010 340 | ghc-options: -threaded 341 | 342 | test-suite hspec 343 | main-is: Spec.hs 344 | type: exitcode-stdio-1.0 345 | build-depends: QuickCheck 346 | , base 347 | , c-storable-deriving 348 | , free 349 | , hspec 350 | , monad-loops 351 | , reactive-banana 352 | , template-haskell 353 | hs-source-dirs: test 354 | default-language: Haskell2010 355 | -------------------------------------------------------------------------------- /provision.sh: -------------------------------------------------------------------------------- 1 | if ! [ -f /provisioned ]; then 2 | sudo apt-get update 3 | sudo apt-get install upstart upstart-job -y 4 | sudo apt-get install upstart upstart-job libgtk-3-dev libgtk-3-0 libgtk-3-bin libgtk-3-common -y 5 | wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add - 6 | echo 'deb http://download.fpcomplete.com/ubuntu/precise stable main'|sudo tee /etc/apt/sources.list.d/fpco.list 7 | sudo apt-get update && sudo apt-get install stack -y 8 | sudo apt-get install build-essential 9 | fi 10 | 11 | sudo touch /provisioned 12 | -------------------------------------------------------------------------------- /provision_fedora.sh: -------------------------------------------------------------------------------- 1 | sudo dnf install gtk3-devel 2 | -------------------------------------------------------------------------------- /screenshot-linux.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/beijaflor-io/haskell-libui/4d1fad25e220071c4c977f79f05b482c2c36af84/screenshot-linux.png -------------------------------------------------------------------------------- /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/beijaflor-io/haskell-libui/4d1fad25e220071c4c977f79f05b482c2c36af84/screenshot.png -------------------------------------------------------------------------------- /src/Graphics/LibUI.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-# LANGUAGE InterruptibleFFI #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE RecordWildCards #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE TupleSections #-} 9 | module Graphics.LibUI 10 | ( module Graphics.LibUI.FFI 11 | , module Graphics.LibUI.MonadUI 12 | , module Graphics.LibUI.Types 13 | 14 | , MonadIO (..) 15 | , Default (..) 16 | ) 17 | where 18 | 19 | import Control.Applicative 20 | import Control.Concurrent 21 | import Control.Concurrent.Async 22 | import Control.Exception 23 | import Control.Monad 24 | import Control.Monad.IO.Class 25 | import Control.Monad.Trans 26 | import Data.Default 27 | import Data.String 28 | import Foreign hiding (void) 29 | import qualified Foreign as Foreign 30 | import Foreign.C 31 | 32 | import Graphics.LibUI.FFI 33 | import Graphics.LibUI.MonadUI 34 | import Graphics.LibUI.Types 35 | 36 | import Control.Monad.Free 37 | import Control.Monad.Free.TH 38 | 39 | $(makeFree ''UIControl) 40 | 41 | type Grammar child result = Free (UIControl child) result 42 | 43 | ui :: Grammar CUIControl () 44 | ui = do 45 | uIControlWindow def 46 | uIControlButton def 47 | 48 | runUILibUI :: Grammar CUIControl CUIControl -> IO CUIControl 49 | runUILibUI = iterM $ \ctrl -> 50 | case ctrl of 51 | UIControlWindow c more -> 52 | toCUIControl <$> (toCUIIO c :: IO CUIWindow) 53 | UIControlButton c more -> 54 | toCUIControl <$> (toCUIIO c :: IO CUIButton) 55 | UIControlBox c more -> 56 | toCUIControl <$> (toCUIIO c :: IO CUIBox) 57 | UIControlCheckbox c more -> 58 | toCUIControl <$> (toCUIIO c :: IO CUICheckbox) 59 | UIControlEntry c more -> 60 | toCUIControl <$> (toCUIIO c :: IO CUIEntry) 61 | UIControlLabel c more -> 62 | toCUIControl <$> (toCUIIO c :: IO CUILabel) 63 | UIControlTab c more -> 64 | toCUIControl <$> (toCUIIO c :: IO CUITabs) 65 | UIControlGroup c more -> 66 | toCUIControl <$> (toCUIIO c :: IO CUIGroup) 67 | UIControlSpinbox c more -> 68 | toCUIControl <$> (toCUIIO c :: IO CUISpinbox) 69 | UIControlSlider c more -> 70 | toCUIControl <$> (toCUIIO c :: IO CUISlider) 71 | UIControlProgressBar c more -> 72 | toCUIControl <$> (toCUIIO c :: IO CUIProgressBar) 73 | UIControlSeparator c more -> 74 | toCUIControl <$> (toCUIIO c :: IO CUISeparator) 75 | UIControlCombobox c more -> 76 | toCUIControl <$> (toCUIIO c :: IO CUICombobox) 77 | UIControlEditableCombobox c more -> 78 | toCUIControl <$> (toCUIIO c :: IO CUIEditableCombobox) 79 | UIControlRadioButtons c more -> 80 | toCUIControl <$> (toCUIIO c :: IO CUIRadioButtons) 81 | UIControlMultlineEntry c more -> 82 | toCUIControl <$> (toCUIIO c :: IO CUIMultilineEntry) 83 | UIControlMenuItem c more -> 84 | error "Undefined behavior" 85 | -- toCUIControl <$> (toCUIIO c :: IO CUIMenuItem) 86 | UIControlMenu c more -> 87 | toCUIControl <$> (toCUIIO c :: IO CUIMenu) 88 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/FFI.hs: -------------------------------------------------------------------------------- 1 | module Graphics.LibUI.FFI 2 | ( 3 | -- * Imperative API that isn't C 4 | module Graphics.LibUI.FFI.Wrapped 5 | -- * Imperative API that is C 6 | , module Graphics.LibUI.FFI.Raw 7 | ) 8 | where 9 | 10 | import Graphics.LibUI.FFI.Raw 11 | import Graphics.LibUI.FFI.Wrapped 12 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/FFI/Raw.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE CApiFFI #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE ForeignFunctionInterface #-} 7 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 8 | {-# LANGUAGE InterruptibleFFI #-} 9 | {-# LANGUAGE MultiParamTypeClasses #-} 10 | {-# LANGUAGE RankNTypes #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TypeFamilies #-} 13 | {-# LANGUAGE UndecidableInstances #-} 14 | -- | 15 | -- Provides a raw Haskell C FFI to libui 16 | -- 17 | -- All functions and newtype pointer wrappers imported from the library are 18 | -- prefixed with @CUI...@ or @c_...@ 19 | -- 20 | -- You can use this module if you want to have access to the C API or write an 21 | -- efficient abstraction layer. For most of the cases, using the 22 | -- 'Graphics.LibUI.FFI' module is a better idea. 23 | -- 24 | -- It wraps every function here to make sense within Haskell semantics, namely: 25 | -- respecting that threads may be interrupted asynchronously by exceptions 26 | -- (including the "C" main loop), making it easier to construct controls and 27 | -- combine them and writting code that isn't dependend on the control's type. 28 | module Graphics.LibUI.FFI.Raw 29 | where 30 | 31 | import Foreign 32 | import Foreign.C 33 | import Foreign.CStorable 34 | import GHC.Generics 35 | 36 | -- * Basic API 37 | 38 | -- | 39 | -- Start the main loop. Will block a thread, use 'runUILoop' instead. 40 | -- 41 | -- 'c_uiInit' is required for proper window switcher and menubar support. 42 | foreign import capi safe "ui.h uiMain" 43 | c_uiMain :: IO () 44 | 45 | -- | 46 | -- Initialize main loop 47 | foreign import capi safe "ui.h uiMainSteps" 48 | c_uiMainSteps :: IO () 49 | 50 | -- | 51 | -- Step through the UI loop 52 | foreign import capi safe "ui.h uiMainStep" 53 | c_uiMainStep 54 | :: CInt 55 | -- ^ How many events to block for 56 | -> IO CInt 57 | -- ^ How many events were handled 58 | 59 | -- | 60 | -- Destroy the UI 61 | foreign import capi "ui.h uiQuit" 62 | c_uiQuit :: IO () 63 | 64 | -- | 65 | -- Uninitialize the UI options 66 | foreign import capi "ui.h uiUninit" 67 | c_uiUninit :: IO () 68 | 69 | -- | 70 | -- Initialize the UI options 71 | foreign import capi "ui.h uiInit" 72 | c_uiInit :: Ptr CSize -> IO () 73 | 74 | -- | 75 | -- Queue action on the UI thread (multi-threaded needs this) 76 | foreign import ccall interruptible "uiQueueMain" 77 | c_uiQueueMain :: FunPtr (DataPtr -> IO ()) -> DataPtr -> IO () 78 | 79 | -- | 80 | -- Callback for when the application is going to quit 81 | foreign import capi "ui.h uiOnShouldQuit" 82 | c_uiOnShouldQuit :: FunPtr (DataPtr -> IO CInt) -> DataPtr -> IO () 83 | 84 | 85 | -- ** CUIControl 86 | -- libui is decently object-oriented though written in C 87 | -- 88 | -- All objects are subclasses of uiControl and casted to it for general 89 | -- operations; we get a similar interface with type-safety 90 | 91 | -- | 92 | -- 'CUIControl' is a `uiControl` 93 | -- 94 | -- Everything displayed on the UI should be convertible to a 'CUIControl'. It 95 | -- gives us access to UI tree building functions. 96 | newtype CUIControl = CUIControl (Ptr ()) 97 | 98 | -- | 99 | -- Something that we can convert to a 'CUIControl' and use it's functions 100 | -- 101 | -- Default instances are generated for all imported pointer types, because 102 | -- they're all castable to 'CUIControl' 103 | class ToCUIControl a where 104 | toCUIControl :: a -> CUIControl 105 | 106 | instance ToCUIControl CUIControl where 107 | toCUIControl = id 108 | 109 | instance ToCUIControl (Ptr a) where 110 | toCUIControl = CUIControl . castPtr 111 | 112 | -- | 113 | -- Something that we can convert to a 'CUIControl', but need IO 114 | class ToCUIControlIO a where 115 | -- type CUIType a -- :: ToCUIControl b => b 116 | toCUIControlIO :: a -> IO CUIControl 117 | 118 | class ToCUIControl b => ToCUIControlIO' a b where 119 | toCUIIO :: ToCUIControl b => a -> IO b 120 | 121 | instance ToCUIControl a => ToCUIControlIO' a CUIControl where 122 | toCUIIO x = return $ toCUIControl x 123 | 124 | instance ToCUIControlIO' a CUIControl => ToCUIControlIO a where 125 | toCUIControlIO = toCUIIO 126 | 127 | foreign import capi "ui.h uiControlDestroy" 128 | c_uiControlDestroy :: CUIControl -> IO () 129 | 130 | foreign import capi "ui.h uiControlParent" 131 | c_uiControlParent :: CUIControl -> IO CUIControl 132 | 133 | foreign import capi "ui.h uiControlSetParent" 134 | c_uiControlSetParent :: CUIControl -> CUIControl -> IO () 135 | 136 | foreign import capi "ui.h uiControlToplevel" 137 | c_uiControlToplevel :: CUIControl -> IO CInt 138 | 139 | foreign import capi "ui.h uiControlVisible" 140 | c_uiControlVisible :: CUIControl -> IO CInt 141 | 142 | foreign import capi "ui.h uiControlShow" 143 | c_uiControlShow :: CUIControl -> IO () 144 | 145 | foreign import capi "ui.h uiControlHide" 146 | c_uiControlHide :: CUIControl -> IO () 147 | 148 | foreign import capi "ui.h uiControlEnabled" 149 | c_uiControlEnabled :: CUIControl -> IO CInt 150 | 151 | foreign import capi "ui.h uiControlEnable" 152 | c_uiControlEnable :: CUIControl -> IO () 153 | 154 | foreign import capi "ui.h uiControlDisable" 155 | c_uiControlDisable :: CUIControl -> IO () 156 | 157 | -- * UI Controls 158 | -- ** Windows 159 | -- *** CUIWindow <- uiWindow 160 | 161 | -- | 162 | -- A C window 163 | -- 164 | -- @ 165 | -- -- | An action that creates a window with a child 166 | -- main = do 167 | -- uiInit 168 | -- let title = "Hello World" 169 | -- width = 680 170 | -- height = 400 171 | -- hasMenubar = True 172 | -- win <- 'uiNewWindow' title width height hasMenubar 173 | -- -- ^ Get hold of the window pointer 174 | -- lbl <- 'uiNewLabel' 175 | -- win ``setChild`` lbl 176 | -- -- ^ Add a label as a child of the window 177 | -- uiShow win 178 | -- uiMain 179 | -- @ 180 | newtype CUIWindow = CUIWindow (Ptr RawWindow) 181 | deriving(Show, ToCUIControl) 182 | 183 | data RawWindow 184 | 185 | -- | Get the window title 186 | foreign import capi "ui.h uiWindowTitle" 187 | c_uiWindowTitle :: CUIWindow -> IO CString 188 | 189 | -- | Set the window title 190 | foreign import capi "ui.h uiWindowSetTitle" 191 | c_uiWindowSetTitle 192 | :: CUIWindow 193 | -> CString 194 | -- ^ A new title 195 | -> IO () 196 | 197 | -- | Get the size of the window's content 198 | foreign import capi "ui.h uiWindowContentSize" 199 | c_uiWindowContentSize :: CUIWindow -> Ptr CInt -> Ptr CInt -> IO () 200 | 201 | -- | Set the size of the window's content 202 | foreign import capi "ui.h uiWindowSetContentSize" 203 | c_uiWindowSetContentSize :: CUIWindow -> CInt -> CInt -> IO () 204 | 205 | -- | Is the window full-screen? 206 | foreign import capi "ui.h uiWindowFullscreen" 207 | c_uiWindowFullscreen :: CUIWindow -> IO CInt 208 | 209 | -- | Set the window to be full-screen 210 | foreign import capi "ui.h uiWindowSetFullscreen" 211 | c_uiWindowSetFullscreen :: CUIWindow -> CInt -> IO () 212 | 213 | -- | Add a callback to when content changes 214 | foreign import capi "ui.h uiWindowOnContentSizeChanged" 215 | c_uiWindowOnContentSizeChanged :: CUIWindow -> FunPtr (CUIWindow -> DataPtr -> IO ()) -> DataPtr -> IO () 216 | 217 | -- | Add a callback to when the window is closed 218 | foreign import capi "ui.h uiWindowOnClosing" 219 | c_uiWindowOnClosing :: CUIWindow -> FunPtr (CUIWindow -> DataPtr -> IO ()) -> DataPtr -> IO () 220 | 221 | -- | Is the window borderless? 222 | foreign import capi "ui.h uiWindowBorderless" 223 | c_uiWindowBorderless :: CUIWindow -> IO CInt 224 | 225 | -- | Set the window as borderless 226 | foreign import capi "ui.h uiWindowSetBorderless" 227 | c_uiWindowSetBorderless :: CUIWindow -> CInt -> IO () 228 | 229 | -- | Set a child on the window 230 | foreign import capi "ui.h uiWindowSetChild" 231 | c_uiWindowSetChild :: CUIWindow -> CUIControl -> IO () 232 | 233 | -- | Is the window margined 234 | foreign import capi "ui.h uiWindowMargined" 235 | c_uiWindowMargined :: CUIWindow -> IO CInt 236 | 237 | -- | Make the window margined 238 | foreign import capi "ui.h uiWindowSetMargined" 239 | c_uiWindowSetMargined :: CUIWindow -> CInt -> IO () 240 | 241 | -- | Create a new window 242 | foreign import capi "ui.h uiNewWindow" 243 | c_uiNewWindow 244 | :: CString 245 | -- ^ The window title 246 | -> CInt 247 | -- ^ The window width 248 | -> CInt 249 | -- ^ The window height 250 | -> CInt 251 | -- ^ Whether the window has a menubar 252 | -> IO CUIWindow 253 | 254 | -- ** Labels 255 | -- *** CUILabel <- uiLabel 256 | -- | A text label, which can currently only span one line 257 | -- 258 | -- @ 259 | -- -- ... 260 | -- lbl <- uiNewLabel "Before 10 seconds" 261 | -- forkIO $ do 262 | -- threadDelay (1000 * 1000 * 10) 263 | -- uiQueueMain $ lbl `setText` "After 10 seconds" 264 | -- -- ... 265 | -- @ 266 | newtype CUILabel = CUILabel (Ptr RawLabel) 267 | deriving(Show, ToCUIControl) 268 | data RawLabel 269 | 270 | foreign import capi "ui.h uiLabelText" 271 | c_uiLabelText :: CUILabel -> IO CString 272 | 273 | foreign import capi "ui.h uiLabelSetText" 274 | c_uiLabelSetText :: CUILabel -> CString -> IO () 275 | 276 | foreign import capi "ui.h uiNewLabel" 277 | c_uiNewLabel :: CString -> IO CUILabel 278 | 279 | -- ** Layout 280 | -- *** CUIBox <- uiBox 281 | -- | Either a vertical or horizontal box of items 282 | -- 283 | -- @ 284 | -- -- ... 285 | -- hbox <- uiNewHorizontalBox 286 | -- btn <- uiNewButton "Click me" 287 | -- hbox `setPadded` True 288 | -- hbox `appendChild` btn 289 | -- hbox `appendChildIO` uiNewLabel "Label" 290 | -- -- ... 291 | -- @ 292 | newtype CUIBox = CUIBox (Ptr RawBox) 293 | deriving(Show, ToCUIControl) 294 | data RawBox 295 | 296 | -- | 297 | -- Appends an item to the box 298 | foreign import capi "ui.h uiBoxAppend" 299 | c_uiBoxAppend 300 | :: CUIBox 301 | -> CUIControl 302 | -> CInt 303 | -- ^ Whether the box is stretchy 304 | -> IO () 305 | 306 | foreign import capi "ui.h uiBoxDelete" 307 | c_uiBoxDelete :: CUIBox -> CInt -> IO () 308 | 309 | foreign import capi "ui.h uiBoxPadded" 310 | c_uiBoxPadded :: CUIBox -> IO CInt 311 | 312 | foreign import capi "ui.h uiBoxSetPadded" 313 | c_uiBoxSetPadded :: CUIBox -> CInt -> IO () 314 | 315 | foreign import capi "ui.h uiNewHorizontalBox" 316 | c_uiNewHorizontalBox :: IO CUIBox 317 | 318 | foreign import capi "ui.h uiNewVerticalBox" 319 | c_uiNewVerticalBox :: IO CUIBox 320 | 321 | -- *** CUITabs <- uiTab 322 | -- | Tabbed Interface 323 | -- 324 | -- @ 325 | -- -- ... 326 | -- tabs <- uiNewTabs 327 | -- tabs `appendTab` ("Some other control", c1) 328 | -- tabs `appendTabMargined` ("Some other control with a margin", c2) 329 | -- -- ... 330 | -- @ 331 | newtype CUITabs = CUITab (Ptr RawTab) 332 | deriving(Show, ToCUIControl) 333 | data RawTab 334 | 335 | foreign import capi "ui.h uiTabAppend" 336 | c_uiTabAppend 337 | :: CUITabs 338 | -- ^ The tab group pointer 339 | -> CString 340 | -- ^ The tab title 341 | -> CUIControl 342 | -- ^ The tab contents 343 | -> IO () 344 | 345 | foreign import capi "ui.h uiTabInsertAt" 346 | c_uiTabInsertAt :: CUITabs -> CString -> CInt -> CUIControl -> IO () 347 | 348 | foreign import capi "ui.h uiTabDelete" 349 | c_uiTabDelete :: CUITabs -> CInt -> IO () 350 | 351 | foreign import capi "ui.h uiTabNumPages" 352 | c_uiTabNumPages :: CUITabs -> IO CInt 353 | 354 | foreign import capi "ui.h uiTabMargined" 355 | c_uiTabMargined :: CUITabs -> CInt -> IO CInt 356 | 357 | foreign import capi "ui.h uiTabSetMargined" 358 | c_uiTabSetMargined :: CUITabs -> CInt -> CInt -> IO () 359 | 360 | foreign import capi "ui.h uiNewTab" 361 | c_uiNewTab :: IO CUITabs 362 | 363 | -- *** CUIGroup <- uiGroup 364 | -- | Named Control Groups 365 | -- 366 | -- @ 367 | -- -- ... 368 | -- group <- uiNewGroup "Group Name" 369 | -- group `setMargined` True 370 | -- group `setChild` c1 371 | -- -- ... 372 | -- @ 373 | newtype CUIGroup = CUIGroup (Ptr RawGroup) 374 | deriving(Show, ToCUIControl) 375 | data RawGroup 376 | 377 | foreign import capi "ui.h uiGroupTitle" 378 | c_uiGroupTitle :: CUIGroup -> IO CString 379 | 380 | foreign import capi "ui.h uiGroupSetTitle" 381 | c_uiGroupSetTitle :: CUIGroup -> CString -> IO () 382 | 383 | foreign import capi "ui.h uiGroupSetChild" 384 | c_uiGroupSetChild :: CUIGroup -> CUIControl -> IO () 385 | 386 | foreign import capi "ui.h uiGroupMargined" 387 | c_uiGroupMargined :: CUIGroup -> IO CInt 388 | 389 | foreign import capi "ui.h uiGroupSetMargined" 390 | c_uiGroupSetMargined :: CUIGroup -> CInt -> IO () 391 | 392 | foreign import capi "ui.h uiNewGroup" 393 | c_uiNewGroup :: CString -> IO CUIGroup 394 | 395 | -- *** CUIGrid <- uiGrid 396 | -- | Layout Grids 397 | newtype CUIGrid = CUIGrid (Ptr RawGrid) 398 | deriving(Show, ToCUIControl) 399 | data RawGrid 400 | 401 | newtype CUIAlign = CUIAlign CInt 402 | deriving(Show) 403 | 404 | newtype CUIAt = CUIAt CInt 405 | deriving(Show) 406 | 407 | foreign import capi "ui.h uiGridAppend" 408 | c_uiGridAppend 409 | :: CUIGrid 410 | -> CUIControl 411 | -> CInt 412 | -- ^ Left 413 | -> CInt 414 | -- ^ Top 415 | -> CInt 416 | -- ^ Xspan 417 | -> CInt 418 | -- ^ Yspan 419 | -> CInt 420 | -- ^ Hexpand 421 | -> CUIAlign 422 | -- ^ Halign 423 | -> CInt 424 | -- ^ Vexpand 425 | -> CUIAlign 426 | -- ^ Valign 427 | -> IO () 428 | 429 | foreign import capi "ui.h uiGridInsertAt" 430 | c_uiGridInsertAt 431 | :: CUIGrid 432 | -> CUIControl 433 | -- ^ New control 434 | -> CUIControl 435 | -- ^ Old, existing control 436 | -> CUIAt 437 | -- ^ At 438 | -> CInt 439 | -- ^ Xspan 440 | -> CInt 441 | -- ^ Yspan 442 | -> CInt 443 | -- ^ Hexpand 444 | -> CUIAlign 445 | -- ^ Halign 446 | -> CInt 447 | -- ^ Vexpand 448 | -> CUIAlign 449 | -- ^ Valign 450 | -> IO () 451 | 452 | foreign import capi "ui.h uiGridPadded" 453 | c_uiGridPadded :: CUIGrid -> IO CInt 454 | 455 | foreign import capi "ui.h uiGridSetPadded" 456 | c_uiGridSetPadded :: CUIGrid -> CInt -> IO () 457 | 458 | foreign import capi "ui.h uiNewGrid" 459 | c_uiNewGrid :: IO CUIGrid 460 | 461 | -- *** CUISeparator <- uiSeparator 462 | -- | Separators 463 | newtype CUISeparator = CUISeparator (Ptr RawSeparator) 464 | deriving(Show, ToCUIControl) 465 | data RawSeparator 466 | 467 | foreign import capi "ui.h uiNewHorizontalSeparator" 468 | c_uiNewHorizontalSeparator :: IO CUISeparator 469 | 470 | foreign import capi "ui.h uiNewVerticalSeparator" 471 | c_uiNewVerticalSeparator :: IO CUISeparator 472 | 473 | -- ** Input Types 474 | -- *** Buttons 475 | -- **** CUIButton <- uiButton 476 | 477 | -- | 478 | -- Buttons 479 | -- 480 | -- @ 481 | -- import Graphics.LibUI.FFI 482 | -- makeMyButton :: IO 'CUIButton' 483 | -- makeMyButton = do 484 | -- btn <- 'uiNewButton' "Hello world" 485 | -- -- ^ Get hold of the button pointer 486 | -- btn ``onClick`` print "Clicked!" 487 | -- -- ^ Add a 'onClick' handler to the control 488 | -- return btn 489 | -- -- ^ Return the pointer for later use 490 | -- @ 491 | newtype CUIButton = CUIButton (Ptr RawButton) 492 | deriving(Show, ToCUIControl) 493 | data RawButton 494 | 495 | foreign import capi "ui.h uiButtonOnClicked" 496 | c_uiButtonOnClicked :: CUIButton -> FunPtr (CUIButton -> DataPtr -> IO ()) -> DataPtr -> IO () 497 | 498 | foreign import capi "ui.h uiButtonSetText" 499 | c_uiButtonSetText :: CUIButton -> CString -> IO () 500 | 501 | foreign import capi "ui.h uiButtonText" 502 | c_uiButtonText :: CUIButton -> IO CString 503 | 504 | foreign import capi "ui.h uiNewButton" 505 | c_uiNewButton :: CString -> IO CUIButton 506 | 507 | -- *** CUICheckbox <- uiCheckbox 508 | -- | A checkbox 509 | newtype CUICheckbox = CUICheckbox (Ptr RawCheckbox) 510 | deriving(Show, ToCUIControl) 511 | data RawCheckbox 512 | 513 | foreign import capi "ui.h uiCheckboxText" 514 | c_uiCheckboxText :: CUICheckbox -> IO CString 515 | 516 | foreign import capi "ui.h uiCheckboxSetText" 517 | c_uiCheckboxSetText :: CUICheckbox -> CString -> IO () 518 | 519 | foreign import capi "ui.h uiCheckboxOnToggled" 520 | c_uiCheckboxOnToggled :: CUICheckbox -> FunPtr (CUICheckbox -> DataPtr -> IO ()) -> DataPtr -> IO () 521 | 522 | foreign import capi "ui.h uiCheckboxChecked" 523 | c_uiCheckboxChecked :: CUICheckbox -> IO CInt 524 | 525 | foreign import capi "ui.h uiCheckboxSetChecked" 526 | c_uiCheckboxSetChecked :: CUICheckbox -> CInt -> IO () 527 | 528 | foreign import capi "ui.h uiNewCheckbox" 529 | c_uiNewCheckbox :: CString -> IO CUICheckbox 530 | 531 | -- *** CUIEntry <- uiEntry 532 | -- | A text input 533 | newtype CUIEntry = CUIEntry (Ptr RawEntry) 534 | deriving(Show, ToCUIControl) 535 | data RawEntry 536 | 537 | foreign import capi "ui.h uiEntryText" 538 | c_uiEntryText :: CUIEntry -> IO CString 539 | 540 | foreign import capi "ui.h uiEntrySetText" 541 | c_uiEntrySetText :: CUIEntry -> CString -> IO () 542 | 543 | foreign import capi "ui.h uiEntryOnChanged" 544 | c_uiEntryOnChanged :: CUIEntry -> FunPtr (CUIEntry -> DataPtr -> IO ()) -> DataPtr -> IO () 545 | 546 | foreign import capi "ui.h uiEntryReadOnly" 547 | c_uiEntryReadOnly :: CUIEntry -> IO CInt 548 | 549 | foreign import capi "ui.h uiEntrySetReadOnly" 550 | c_uiEntrySetReadOnly :: CUIEntry -> CInt -> IO () 551 | 552 | foreign import capi "ui.h uiNewEntry" 553 | c_uiNewEntry :: IO CUIEntry 554 | 555 | foreign import capi "ui.h uiNewPasswordEntry" 556 | c_uiNewPasswordEntry :: IO CUIEntry 557 | 558 | foreign import capi "ui.h uiNewSearchEntry" 559 | c_uiNewSearchEntry :: IO CUIEntry 560 | 561 | -- *** CUISlider <- uiSlider 562 | -- | A range slider 563 | newtype CUISlider = CUISlider (Ptr RawSlider) 564 | deriving(Show, ToCUIControl) 565 | data RawSlider 566 | 567 | foreign import capi "ui.h uiSliderValue" 568 | c_uiSliderValue :: CUISlider -> IO CInt 569 | 570 | foreign import capi "ui.h uiSliderSetValue" 571 | c_uiSliderSetValue :: CUISlider -> CInt -> IO () 572 | 573 | foreign import capi "ui.h uiSliderOnChanged" 574 | c_uiSliderOnChanged :: CUISlider -> FunPtr (CUISlider -> DataPtr -> IO ()) -> DataPtr -> IO () 575 | 576 | foreign import capi "ui.h uiNewSlider" 577 | c_uiNewSlider :: CInt -> CInt -> IO CUISlider 578 | 579 | -- *** CUICombobox <- uiCombobox 580 | -- | A select input 581 | newtype CUICombobox = CUICombobox (Ptr RawCombobox) 582 | deriving(Show, ToCUIControl) 583 | data RawCombobox 584 | 585 | foreign import capi "ui.h uiComboboxAppend" 586 | c_uiComboboxAppend :: CUICombobox -> CString -> IO () 587 | 588 | foreign import capi "ui.h uiComboboxSelected" 589 | c_uiComboboxSelected :: CUICombobox -> IO CInt 590 | 591 | foreign import capi "ui.h uiComboboxSetSelected" 592 | c_uiComboboxSetSelected :: CUICombobox -> CInt -> IO () 593 | 594 | foreign import capi "ui.h uiComboboxOnSelected" 595 | c_uiComboboxOnSelected :: CUICombobox -> FunPtr (CUICombobox -> DataPtr -> IO ()) -> DataPtr -> IO () 596 | 597 | foreign import capi "ui.h uiNewCombobox" 598 | c_uiNewCombobox :: IO CUICombobox 599 | 600 | -- *** CUIEditableCombobox <- uiEditableCombobox 601 | -- | An editable select input 602 | newtype CUIEditableCombobox = CUIEditableCombobox (Ptr RawEditableCombobox) 603 | deriving(Show, ToCUIControl) 604 | data RawEditableCombobox 605 | 606 | foreign import capi "ui.h uiEditableComboboxAppend" 607 | c_uiEditableComboboxAppend :: CUIEditableCombobox -> CString -> IO () 608 | 609 | foreign import capi "ui.h uiEditableComboboxText" 610 | c_uiEditableComboboxText :: CUIEditableCombobox -> IO CString 611 | 612 | foreign import capi "ui.h uiEditableComboboxSetText" 613 | c_uiEditableComboboxSetText :: CUIEditableCombobox -> CString -> IO () 614 | 615 | foreign import capi "ui.h uiEditableComboboxOnChanged" 616 | c_uiEditableComboboxOnChanged :: CUIEditableCombobox -> FunPtr (CUIEditableCombobox -> DataPtr -> IO ()) -> DataPtr -> IO () 617 | 618 | foreign import capi "ui.h uiNewEditableCombobox" 619 | c_uiNewEditableCombobox :: IO CUIEditableCombobox 620 | 621 | -- *** CUIRadioButtons <- uiRadioButtons 622 | -- | Radio buttons 623 | newtype CUIRadioButtons = CUIRadioButtons (Ptr RawRadioButtons) 624 | deriving(Show, ToCUIControl) 625 | data RawRadioButtons 626 | 627 | foreign import capi "ui.h uiRadioButtonsAppend" 628 | c_uiRadioButtonsAppend :: CUIRadioButtons -> CString -> IO () 629 | 630 | foreign import capi "ui.h uiRadioButtonsSelected" 631 | c_uiRadioButtonsSelected :: CUIRadioButtons -> IO CInt 632 | 633 | foreign import capi "ui.h uiRadioButtonsSetSelected" 634 | c_uiRadioButtonsSetSelected :: CUIRadioButtons -> CInt -> IO () 635 | 636 | foreign import capi "ui.h uiRadioButtonsOnSelected" 637 | c_uiRadioButtonsOnSelected :: CUIRadioButtons -> FunPtr (CUIRadioButtons -> DataPtr -> IO ()) -> DataPtr -> IO () 638 | 639 | foreign import capi "ui.h uiNewRadioButtons" 640 | c_uiNewRadioButtons :: IO CUIRadioButtons 641 | 642 | -- *** CUIForm <- uiForm 643 | -- | Forms (groups of labeled inputs) 644 | -- 645 | -- @ 646 | -- -- ... 647 | -- form <- uiNewForm 648 | -- form `appendInput` ("Name", inp1) -- <- this function is polymorphic 649 | -- form `setPadded` True 650 | -- -- ... 651 | -- @ 652 | newtype CUIForm = CUIForm (Ptr RawForm) 653 | deriving(Show, ToCUIControl) 654 | data RawForm 655 | 656 | foreign import capi "ui.h uiFormAppend" 657 | c_uiFormAppend 658 | :: CUIForm 659 | -- ^ The form pointer 660 | -> CString 661 | -- ^ The input label 662 | -> CUIControl 663 | -- ^ The input control 664 | -> CInt 665 | -- ^ Whether the child is stretchy 666 | -> IO () 667 | 668 | foreign import capi "ui.h uiFormDelete" 669 | c_uiFormDelete 670 | :: CUIForm 671 | -- ^ The form pointer 672 | -> CInt 673 | -- ^ The index to remove 674 | -> IO () 675 | 676 | foreign import capi "ui.h uiFormPadded" 677 | c_uiFormPadded :: CUIForm -> IO CInt 678 | 679 | foreign import capi "ui.h uiFormSetPadded" 680 | c_uiFormSetPadded :: CUIForm -> CInt -> IO () 681 | 682 | foreign import capi "ui.h uiNewForm" 683 | c_uiNewForm :: IO CUIForm 684 | 685 | -- *** CUIDatePicker <- uiDatePicker 686 | newtype CUIDateTimePicker = CUIDateTimePicker (Ptr RawDateTimePicker) 687 | deriving(Show, ToCUIControl) 688 | data RawDateTimePicker 689 | 690 | foreign import capi "ui.h uiNewDatePicker" 691 | c_uiNewDatePicker :: IO CUIDateTimePicker 692 | 693 | foreign import capi "ui.h uiNewTimePicker" 694 | c_uiNewTimePicker :: IO CUIDateTimePicker 695 | 696 | foreign import capi "ui.h uiNewDateTimePicker" 697 | c_uiNewDateTimePicker :: IO CUIDateTimePicker 698 | 699 | -- *** CUIFontButton <- uiFontButton 700 | newtype CUIFontButton = CUIFontButton (Ptr RawFontButton) 701 | deriving(Show, ToCUIControl) 702 | data RawFontButton 703 | 704 | foreign import capi "ui.h uiNewFontButton" 705 | c_uiNewFontButton :: IO CUIFontButton 706 | 707 | -- *** CUIColorButton <- uiColorButton 708 | newtype CUIColorButton = CUIColorButton (Ptr RawColorButton) 709 | deriving(Show, ToCUIControl) 710 | data RawColorButton 711 | 712 | foreign import capi "ui.h uiNewColorButton" 713 | c_uiNewColorButton :: IO CUIColorButton 714 | 715 | -- *** CUIMultilineEntry <- uiMultilineEntry 716 | newtype CUIMultilineEntry = CUIMultilineEntry (Ptr RawMultilineEntry) 717 | deriving(Show, ToCUIControl) 718 | data RawMultilineEntry 719 | 720 | foreign import capi "ui.h uiMultilineEntryText" 721 | c_uiMultilineEntryText :: CUIMultilineEntry -> IO CString 722 | 723 | foreign import capi "ui.h uiMultilineEntrySetText" 724 | c_uiMultilineEntrySetText :: CUIMultilineEntry -> CString -> IO () 725 | 726 | foreign import capi "ui.h uiMultilineEntryAppend" 727 | c_uiMultilineEntryAppend :: CUIMultilineEntry -> CString -> IO () 728 | 729 | foreign import capi "ui.h uiMultilineEntryOnChanged" 730 | c_uiMultilineEntryOnChanged :: CUIMultilineEntry -> FunPtr (CUIMultilineEntry -> DataPtr -> IO ()) -> DataPtr -> IO () 731 | 732 | foreign import capi "ui.h uiMultilineEntryReadOnly" 733 | c_uiMultilineEntryReadOnly :: CUIMultilineEntry -> IO CInt 734 | 735 | foreign import capi "ui.h uiMultilineEntrySetReadOnly" 736 | c_uiMultilineEntrySetReadOnly :: CUIMultilineEntry -> CInt -> IO () 737 | 738 | foreign import capi "ui.h uiNewMultilineEntry" 739 | c_uiNewMultilineEntry :: IO CUIMultilineEntry 740 | 741 | foreign import capi "ui.h uiNewNonWrappingMultilineEntry" 742 | c_uiNewNonWrappingMultilineEntry :: IO CUIMultilineEntry 743 | 744 | -- ** Progress Indicators 745 | -- *** CUIProgressBar <- uiProgressBar 746 | newtype CUIProgressBar = CUIProgressBar (Ptr RawProgressBar) 747 | deriving(Show, ToCUIControl) 748 | data RawProgressBar 749 | 750 | foreign import capi "ui.h uiProgressBarValue" 751 | c_uiProgressBarValue :: CUIProgressBar -> IO CInt 752 | 753 | foreign import ccall safe "uiProgressBarSetValue" 754 | c_uiProgressBarSetValue :: CUIProgressBar -> CInt -> IO () 755 | 756 | foreign import capi "ui.h uiNewProgressBar" 757 | c_uiNewProgressBar :: IO CUIProgressBar 758 | 759 | -- *** CUISpinbox <- uiSpinbox 760 | newtype CUISpinbox = CUISpinbox (Ptr RawSpinbox) 761 | deriving(Show, ToCUIControl) 762 | data RawSpinbox 763 | 764 | foreign import capi "ui.h uiSpinboxValue" 765 | c_uiSpinboxValue :: CUISpinbox -> IO CInt 766 | 767 | foreign import capi "ui.h uiSpinboxSetValue" 768 | c_uiSpinboxSetValue :: CUISpinbox -> CInt -> IO () 769 | 770 | foreign import capi "ui.h uiSpinboxOnChanged" 771 | c_uiSpinboxOnChanged :: CUISpinbox -> FunPtr (CUISpinbox -> DataPtr -> IO ()) -> DataPtr -> IO () 772 | 773 | foreign import capi "ui.h uiNewSpinbox" 774 | c_uiNewSpinbox :: CInt -> CInt -> IO CUISpinbox 775 | 776 | -- * The Menubar 777 | -- ** CUIMenu <- uiMenu 778 | 779 | newtype CUIMenu = CUIMenu (Ptr RawMenu) 780 | deriving(ToCUIControl, Show) 781 | data RawMenu 782 | 783 | foreign import capi "ui.h uiMenuAppendItem" 784 | c_uiMenuAppendItem :: CUIMenu -> CString -> IO CUIMenuItem 785 | 786 | foreign import capi "ui.h uiMenuAppendCheckItem" 787 | c_uiMenuAppendCheckItem :: CUIMenu -> CString -> IO CUIMenuItem 788 | 789 | foreign import capi "ui.h uiMenuAppendQuitItem" 790 | c_uiMenuAppendQuitItem :: CUIMenu -> IO CUIMenuItem 791 | 792 | foreign import capi "ui.h uiMenuAppendPreferencesItem" 793 | c_uiMenuAppendPreferencesItem :: CUIMenu -> IO CUIMenuItem 794 | 795 | foreign import capi "ui.h uiMenuAppendAboutItem" 796 | c_uiMenuAppendAboutItem :: CUIMenu -> IO CUIMenuItem 797 | 798 | foreign import capi "ui.h uiMenuAppendSeparator" 799 | c_uiMenuAppendSeparator :: CUIMenu -> IO () 800 | 801 | foreign import capi "ui.h uiNewMenu" 802 | c_uiNewMenu :: CString -> IO CUIMenu 803 | 804 | -- ** CUIMenuItem <- uiMenuItem 805 | newtype CUIMenuItem = CUIMenuItem (Ptr RawMenuItem) 806 | deriving(Show) 807 | data RawMenuItem 808 | 809 | foreign import capi "ui.h uiMenuItemEnable" 810 | c_uiMenuItemEnable :: CUIMenuItem -> IO () 811 | 812 | foreign import capi "ui.h uiMenuItemDisable" 813 | c_uiMenuItemDisable :: CUIMenuItem -> IO () 814 | 815 | foreign import capi "ui.h uiMenuItemOnClicked" 816 | c_uiMenuItemOnClicked :: CUIMenuItem -> FunPtr (CUIMenuItem -> DataPtr -> IO ()) -> DataPtr -> IO () 817 | 818 | foreign import capi "ui.h uiMenuItemChecked" 819 | c_uiMenuItemChecked :: CUIMenuItem -> IO CInt 820 | 821 | foreign import capi "ui.h uiMenuItemSetChecked" 822 | c_uiMenuItemSetChecked :: CUIMenuItem -> CInt -> IO () 823 | 824 | -- ** Custom Controls 825 | -- *** CUIArea <- uiArea 826 | newtype CUIArea = CUIArea (Ptr RawArea) 827 | deriving(Show, ToCUIControl) 828 | data RawArea 829 | 830 | newtype CUIDrawContext = CUIDrawContext (Ptr RawDrawContext) 831 | deriving(Show, Generic, CStorable, Storable) 832 | data RawDrawContext 833 | 834 | data CUIAreaDrawParams = 835 | CUIAreaDrawParams { cuiAreaDrawDrawContext :: CUIDrawContext 836 | , cuiAreaDrawAreaWidth :: CDouble 837 | , cuiAreaDrawAreaHeight :: CDouble 838 | , cuiAreaDrawClipX :: CDouble 839 | , cuiAreaDrawClipY :: CDouble 840 | , cuiAreaDrawClipWidth :: CDouble 841 | , cuiAreaDrawClipHeight :: CDouble 842 | } 843 | deriving(Show, Generic) 844 | 845 | newtype CUIAreaMouseEvent = CUIAreaMouseEvent (Ptr RawAreaMouseEvent) 846 | deriving(Show) 847 | 848 | data RawAreaMouseEvent 849 | 850 | data CUIAreaHandler = 851 | CUIAreaHandler { cuiAreaHandlerDraw :: FunPtr (Ptr CUIAreaHandler -> CUIArea -> Ptr CUIAreaDrawParams -> IO ()) 852 | , cuiAreaHandlerMouseEvent :: FunPtr (Ptr CUIAreaHandler -> CUIArea -> CUIAreaMouseEvent -> IO ()) 853 | } 854 | deriving(Show, Generic) 855 | 856 | foreign import capi "ui.h uiAreaSetSize" 857 | c_uiAreaSetSize :: CUIArea -> CInt -> CInt -> IO () 858 | 859 | foreign import capi "ui.h uiAreaQueueRedrawAll" 860 | c_uiAreaQueueRedrawAll :: CUIArea -> IO () 861 | 862 | foreign import capi "ui.h uiAreaScrollTo" 863 | c_uiAreaScrollTo 864 | :: CUIArea 865 | -> CDouble 866 | -- ^ x 867 | -> CDouble 868 | -- ^ y 869 | -> CDouble 870 | -- ^ width 871 | -> CDouble 872 | -- ^ height 873 | -> IO () 874 | 875 | foreign import capi "ui.h uiNewArea" 876 | c_uiNewArea :: Ptr CUIAreaHandler -> IO CUIArea 877 | 878 | foreign import capi "ui.h uiNewScrollingArea" 879 | c_uiNewScrollingArea :: Ptr CUIAreaHandler -> CInt -> CInt -> IO CUIArea 880 | 881 | -- Internal to haskell-libui 882 | -- foreign import capi "haskell/extra.h ui" 883 | -- c_uiAreaSetSize :: CUIArea -> CInt -> CInt -> IO () 884 | 885 | -- * UI Alerts and Dialogs 886 | foreign import capi "ui.h uiOpenFile" 887 | c_uiOpenFile :: CUIWindow -> IO CString 888 | 889 | foreign import capi "ui.h uiSaveFile" 890 | c_uiSaveFile :: CUIWindow -> IO CString 891 | 892 | foreign import capi "ui.h uiMsgBox" 893 | c_uiMsgBox :: CUIWindow -> CString -> CString -> IO () 894 | 895 | foreign import capi "ui.h uiMsgBoxError" 896 | c_uiMsgBoxError :: CUIWindow -> CString -> CString -> IO () 897 | 898 | -- * Support API 899 | -- ** Creating callbacks to pass to C and call back to Haskell 900 | 901 | -- | 902 | -- The callback API passes around a void pointer, which is state that can be 903 | -- threaded to callbacks. This is not necessary in Haskell land and ignored. 904 | type DataPtr = Ptr () 905 | 906 | -- | 907 | -- Wrap a success callback on a foreign pointer 908 | foreign import ccall "wrapper" 909 | c_wrap1I :: (DataPtr -> IO CInt) -> IO (FunPtr (DataPtr -> IO CInt)) 910 | 911 | -- | 912 | -- Wrap a 1 argument event listener on a foreign pointer 913 | foreign import ccall "wrapper" 914 | c_wrap1 :: (DataPtr -> IO ()) -> IO (FunPtr (DataPtr -> IO ())) 915 | 916 | -- | 917 | -- Wrap a 2 argument event listener on a foreign pointer 918 | foreign import ccall "wrapper" 919 | c_wrap2 :: (DataPtr -> DataPtr -> IO ()) -> IO (FunPtr (DataPtr -> DataPtr -> IO ())) 920 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/FFI/Raw/OSX.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE CApiFFI #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE ForeignFunctionInterface #-} 7 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 8 | {-# LANGUAGE InterruptibleFFI #-} 9 | {-# LANGUAGE MultiParamTypeClasses #-} 10 | {-# LANGUAGE RankNTypes #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TypeFamilies #-} 13 | {-# LANGUAGE UndecidableInstances #-} 14 | {-| 15 | Module: Graphics.LibUI.FFI.Raw.OSX 16 | Description: OSX extras to the libui library 17 | Copyright: (c) Copyright Pedro Tacla Yamada 2016 18 | License: GPLv3 19 | Maintainer: tacla.yamada@gmail.com 20 | Stability: experimental 21 | |-} 22 | module Graphics.LibUI.FFI.Raw.OSX where 23 | 24 | import Foreign 25 | import Foreign.C 26 | import Foreign.CStorable 27 | import GHC.Generics 28 | import Graphics.LibUI.FFI.Raw 29 | 30 | -- ** Webviews 31 | -- *** CUIWebview <- uiWebview 32 | -- | A webview 33 | -- 34 | -- @ 35 | -- -- ... 36 | -- wv <- uiNewWebview 37 | -- wv `loadUrl` "https://google.com" 38 | -- wv `evalJs` "document.write('Buya');" 39 | -- -- ... 40 | -- @ 41 | newtype CUIWebview = CUIWebview (Ptr RawWebview) 42 | deriving(Show, ToCUIControl) 43 | data RawWebview 44 | 45 | foreign import capi "ui.h uiWebviewLoadUrl" 46 | c_uiWebviewLoadUrl :: CUIWebview -> CString -> IO () 47 | 48 | foreign import capi "ui.h uiWebviewLoadHTML" 49 | c_uiWebviewLoadHtml :: CUIWebview -> CString -> CString -> IO () 50 | 51 | foreign import capi "ui.h uiWebviewOnLoad" 52 | c_uiWebviewOnLoad :: CUIWebview -> FunPtr (CUIWebview -> DataPtr -> IO ()) -> DataPtr -> IO () 53 | 54 | foreign import capi "ui.h uiWebviewEval" 55 | c_uiWebviewEval :: CUIWebview -> CString -> IO CString 56 | 57 | foreign import capi "ui.h uiNewWebview" 58 | c_uiNewWebview :: IO CUIWebview 59 | 60 | -- ** Maps 61 | -- *** CUIMapview <- uiMapview 62 | -- | A Map view 63 | -- 64 | -- @ 65 | -- -- ... 66 | -- mv <- uiNewMapview 67 | -- -- ... 68 | -- @ 69 | newtype CUIMapview = CUIMapview (Ptr RawMapview) 70 | deriving(Show, ToCUIControl) 71 | data RawMapview 72 | 73 | foreign import capi "ui.h uiNewMapview" 74 | c_uiNewMapview :: IO CUIMapview 75 | 76 | foreign import capi "ui.h uiMapviewSetRegion" 77 | c_uiMapviewSetRegion :: CUIMapview -> IO () 78 | 79 | -- ** Menu Items 80 | -- | In OSX, there're APIs for defining keyboard shortcut handlers bound to menu 81 | -- items, without which the UX is really bad. Namely the 'Edit' menu items 82 | -- aren't possible without this (see the `markd` example). 83 | foreign import capi "ui.h uiMenuAppendItemWith" 84 | c_uiMenuAppendItemWith 85 | :: CUIMenu 86 | -> CString 87 | -- ^ Menu title 88 | -> CString 89 | -- ^ Menu key 90 | -> CString 91 | -- ^ Menu target selector 92 | -> IO CUIMenuItem 93 | 94 | -- | Like c_uiMenuAppendItemWith, but uses the application "menuManager" as the 95 | -- target 96 | foreign import capi "ui.h uiMenuAppendItemWithDefaultTarget" 97 | c_uiMenuAppendItemWithDefaultTarget 98 | :: CUIMenu 99 | -> CString 100 | -- ^ Menu title 101 | -> CString 102 | -- ^ Menu key 103 | -> CString 104 | -- ^ Menu target selector 105 | -> IO CUIMenuItem 106 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/FFI/Wrapped.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE InterruptibleFFI #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE UndecidableInstances #-} 10 | -- | 11 | -- Provides wrappers to make the imperative C API nicer to use in Haskell 12 | -- 13 | -- This module should be enough to match how most imperative languages will 14 | -- work with the foreign library, if you're ok with building your GUI 15 | -- imperatively on the IO Monad, this should be fine 16 | module Graphics.LibUI.FFI.Wrapped 17 | ( 18 | -- * Basic API 19 | uiInit 20 | , uiMain 21 | , uiQuit 22 | , uiQueueMain 23 | , uiOnShouldQuit 24 | 25 | -- * UI Controls 26 | , CUIControl (..) 27 | , ToCUIControl (..) 28 | , ToCUIControlIO (..) 29 | , uiShow 30 | , uiHide 31 | , uiDestroy 32 | , uiGetParent 33 | , uiSetParent 34 | , uiGetTopLevel 35 | , uiGetVisible 36 | , uiGetEnabled 37 | , uiSetEnabled 38 | 39 | -- ** Windows 40 | , CUIWindow (..) 41 | , uiNewWindow 42 | , getBorderless 43 | , setBorderless 44 | , getContentSize 45 | , setContentSize 46 | , onContentSizeChange 47 | , getFullscreen 48 | , setFullscreen 49 | 50 | -- ** Labels 51 | , CUILabel (..) 52 | , uiNewLabel 53 | 54 | -- ** Layout Controls 55 | -- *** Boxes 56 | , CUIBox (..) 57 | , uiNewHorizontalBox 58 | , uiNewVerticalBox 59 | 60 | -- *** Tabs 61 | , CUITabs (..) 62 | , uiNewTabs 63 | , appendTab 64 | , appendTabMargined 65 | , removeTab 66 | 67 | -- *** Named Groups 68 | , CUIGroup (..) 69 | , uiNewGroup 70 | 71 | -- *** Grids 72 | , CUIGrid (..) 73 | , uiNewGrid 74 | , uiGridAppend 75 | , uiGridInsertAt 76 | , UIAlign (..) 77 | , UIAt (..) 78 | 79 | -- *** Separators 80 | , CUISeparator (..) 81 | , uiNewHorizontalSeparator 82 | , uiNewVerticalSeparator 83 | 84 | -- ** Input Types 85 | -- *** Buttons 86 | , CUIButton (..) 87 | , uiNewButton 88 | 89 | -- *** Checkboxes 90 | , CUICheckbox (..) 91 | , uiNewCheckbox 92 | 93 | -- *** Text Inputs 94 | , CUIEntry (..) 95 | , uiNewEntry 96 | , uiNewPasswordEntry 97 | , uiNewSearchEntry 98 | , CUISpinbox (..) 99 | , uiNewSpinbox 100 | 101 | -- *** Sliders 102 | , CUISlider (..) 103 | , uiNewSlider 104 | 105 | -- *** Selects 106 | , CUICombobox (..) 107 | , uiNewCombobox 108 | 109 | , CUIEditableCombobox (..) 110 | , uiNewEditableCombobox 111 | 112 | -- *** Radio Buttons 113 | , CUIRadioButtons (..) 114 | , uiNewRadioButtons 115 | 116 | -- *** Labeled Forms 117 | , CUIForm (..) 118 | , uiNewForm 119 | , uiFormAppend 120 | 121 | -- *** Date & Time Pickers 122 | , CUIDateTimePicker (..) 123 | , uiNewDatePicker 124 | , uiNewTimePicker 125 | , uiNewDateTimePicker 126 | 127 | -- *** Font Picker 128 | , CUIFontButton (..) 129 | , uiNewFontButton 130 | 131 | -- *** Color Picker 132 | , CUIColorButton (..) 133 | , uiNewColorButton 134 | 135 | -- *** Multiline Inputs 136 | , CUIMultilineEntry (..) 137 | , appendText 138 | , uiNewMultilineEntry 139 | , uiNewNonWrappingMultilineEntry 140 | 141 | -- ** Progress Indicators 142 | , CUIProgressBar (..) 143 | , uiNewProgressBar 144 | 145 | -- ** The Menubar 146 | , CUIMenu (..) 147 | , uiNewMenu 148 | , uiMenuAppendItem 149 | , uiMenuAppendCheckItem 150 | , uiMenuAppendQuitItem 151 | , uiMenuAppendPreferencesItem 152 | , uiMenuAppendAboutItem 153 | , uiMenuAppendSeparator 154 | 155 | , CUIMenuItem (..) 156 | , uiMenuItemEnable 157 | , uiMenuItemDisable 158 | 159 | -- ** UI Alerts and Dialogs 160 | , uiOpenFile 161 | , uiSaveFile 162 | , uiMsgBox 163 | , uiMsgBoxError 164 | 165 | -- * Type-Classes 166 | , HasSetTitle (..) 167 | , HasGetTitle (..) 168 | 169 | , HasSetPosition (..) 170 | , HasGetPosition (..) 171 | 172 | , HasGetText (..) 173 | , HasSetText (..) 174 | 175 | , HasSetValue (..) 176 | , HasGetValue (..) 177 | 178 | , HasGetChecked (..) 179 | , HasSetChecked (..) 180 | 181 | , HasSetChild (..) 182 | , HasAppendChild (..) 183 | , HasRemoveChild (..) 184 | 185 | , HasOnPositionChanged (..) 186 | , HasOnClicked (..) 187 | , HasOnChanged (..) 188 | , HasOnClosing (..) 189 | , HasOnShouldQuit (..) 190 | 191 | , HasSetPadded (..) 192 | , HasGetPadded (..) 193 | 194 | , HasSetMargined (..) 195 | , HasGetMargined (..) 196 | 197 | , HasSetReadOnly (..) 198 | , HasGetReadOnly (..) 199 | 200 | , HasAppendOption (..) 201 | , ToAppendInput (..) 202 | 203 | , appendIOChild 204 | , appendIOChildStretchy 205 | 206 | -- * Internal functions 207 | -- ** Ticking the loop manually 208 | , uiMainSteps, uiMainStep, hasMainM, getHasMain, setHasMain 209 | 210 | -- ** Other 211 | , boolToNum, numToBool, toCUIAlign, toCUIAt, peekCStringSafe 212 | 213 | -- * Raw FFI 214 | , module Graphics.LibUI.FFI.Raw 215 | ) 216 | where 217 | 218 | import Control.Concurrent 219 | import Control.Monad (when, (>=>)) 220 | import Control.Monad.Loops 221 | import Foreign hiding (void) 222 | import Foreign.C 223 | import System.IO.Unsafe 224 | 225 | import Graphics.LibUI.FFI.Raw 226 | 227 | -- * Basic API 228 | 229 | -- | Initialize the UI options. Needs to be called before any UI building 230 | -- 231 | -- @ 232 | -- main = do 233 | -- uiInit 234 | -- -- ... 235 | -- uiMain 236 | -- @ 237 | uiInit :: IO () 238 | uiInit = 239 | alloca $ \ptr -> do 240 | poke ptr (CSize (fromIntegral (sizeOf (CSize 0)))) 241 | c_uiInit ptr 242 | 243 | -- | Start the main loop 244 | uiMain :: IO () 245 | uiMain = do 246 | uiMainSteps 247 | -- TODO Replace with uiMainStepExpire or something 248 | whileM_ getHasMain (uiMainStep 1) 249 | 250 | -- | Quit the main loop 251 | uiQuit :: IO () 252 | uiQuit = do 253 | setHasMain False 254 | c_uiQuit 255 | 256 | -- | 257 | -- Actions not run on the main thread (that aren't just callbacks), need to be 258 | -- queued with @uiQueueMain@ 259 | -- 260 | -- It calls 'c_uiQueueMain' under the hood 261 | -- 262 | -- @ 263 | -- main = do 264 | -- -- .. 'uiInit' & create a window 265 | -- pg <- 'uiNewProgressBar' 266 | -- ^ Create a progressbar 267 | -- 'forkIO' $ do 268 | -- 'forM_' [0..100] $ \i -> do 269 | -- 'threadDelay' (1000 * 100) 270 | -- 'uiQueueMain' ('setValue' pg i) 271 | -- ^ Fork a thread 272 | -- -- .. 'setChild' & 'uiMain' 273 | -- @ 274 | uiQueueMain :: IO () -> IO () 275 | uiQueueMain a = do 276 | m <- getHasMain 277 | when m $ do 278 | a' <- c_wrap1 $ \_ -> do 279 | r <- a 280 | return () 281 | c_uiQueueMain a' nullPtr 282 | 283 | -- | Add a hook to before quit 284 | uiOnShouldQuit :: IO Int -> IO () 285 | uiOnShouldQuit a = do 286 | f <- castFunPtr <$> c_wrap1I (\_ -> fromIntegral <$> a) 287 | c_uiOnShouldQuit f nullPtr 288 | 289 | -- * Shared API 290 | -- | Controls with `ui...SetTitle` functions 291 | class HasSetTitle s where 292 | setTitle :: s -> String -> IO () 293 | 294 | -- | Controls with `ui...Title` functions 295 | class HasGetTitle s where 296 | getTitle :: s -> IO String 297 | 298 | -- | Controls with `ui...SetPosition` functions 299 | class HasSetPosition s where 300 | setPosition :: s -> (Int, Int) -> IO () 301 | 302 | -- | Controls with `ui...Position` functions 303 | class HasGetPosition s where 304 | getPosition :: s -> IO (Int, Int) 305 | 306 | -- | Controls with `ui...Text` functions 307 | class HasGetText s where 308 | getText :: s -> IO String 309 | 310 | -- | Controls with `ui...SetText` functions 311 | class HasSetText s where 312 | setText :: s -> String -> IO () 313 | 314 | -- | Controls with `ui...SetReadOnly` functions 315 | class HasSetReadOnly s where 316 | setReadOnly :: s -> Bool -> IO () 317 | 318 | -- | Controls with `ui...ReadOnly` functions 319 | class HasGetReadOnly s where 320 | getReadOnly :: s -> IO Bool 321 | 322 | -- | Controls with `ui...SetValue` functions 323 | class HasSetValue s where 324 | setValue :: s -> Int -> IO () 325 | 326 | -- | Controls with `ui...GetValue` functions 327 | class HasGetValue s where 328 | getValue :: s -> IO Int 329 | 330 | -- | Controls with `ui...OnClicked` functions 331 | class HasOnClicked s where 332 | onClick :: s -> IO () -> IO () 333 | 334 | class HasOnPositionChanged s where 335 | onPositionChanged :: s -> IO () -> IO () 336 | 337 | -- | Controls with `ui...OnChanged` functions 338 | class HasOnChanged s where 339 | onChange :: s -> IO () -> IO () 340 | 341 | -- | Controls with `ui...SetChecked` functions 342 | class HasSetChecked s where 343 | setChecked :: s -> Bool -> IO () 344 | 345 | -- | Controls with `ui...Checked` functions 346 | class HasGetChecked s where 347 | getChecked :: s -> IO Bool 348 | 349 | -- | Controls with `ui...SetChild` functions 350 | class HasSetChild s where 351 | setChild :: ToCUIControlIO a => s -> a -> IO () 352 | 353 | -- | Controls with `ui...Append` functions 354 | class HasAppendChild s where 355 | -- | Append a child to this control 356 | appendChild :: ToCUIControlIO a => s -> a -> IO () 357 | appendChildStretchy :: ToCUIControlIO a => s -> a -> IO () 358 | appendChildStretchy = appendChild 359 | 360 | -- | Controls with `ui...Delete` functions 361 | class HasRemoveChild s where 362 | -- | Remove the child at index from this control 363 | removeChild :: s -> Int -> IO () 364 | 365 | -- | Append an action returning a child to this control 366 | appendIOChild :: (HasAppendChild s, ToCUIControlIO c) => s -> IO c -> IO () 367 | appendIOChild container childAction = do 368 | c <- childAction 369 | container `appendChild` c 370 | 371 | appendIOChildStretchy :: (HasAppendChild s, ToCUIControlIO c) => s -> IO c -> IO () 372 | appendIOChildStretchy container childAction = do 373 | c <- childAction 374 | container `appendChildStretchy` c 375 | 376 | class HasOnClosing w where 377 | onClosing :: w -> IO () -> IO () 378 | 379 | class HasOnShouldQuit w where 380 | onShouldQuit :: w -> IO () -> IO () 381 | 382 | class HasSetPadded w where 383 | setPadded :: w -> Bool -> IO () 384 | 385 | class HasGetPadded w where 386 | getPadded :: w -> IO Bool 387 | 388 | class HasSetMargined w where 389 | setMargined :: w -> Bool -> IO () 390 | 391 | class HasGetMargined w where 392 | getMargined :: w -> IO Bool 393 | 394 | -- * CUIControl API 395 | -- | Displays a control ('c_uiControlShow') 396 | uiShow :: ToCUIControl a => a -> IO () 397 | uiShow c = c_uiControlShow (toCUIControl c) 398 | 399 | -- | Hides a control ('c_uiControlHide') 400 | uiHide :: ToCUIControl a => a -> IO () 401 | uiHide = c_uiControlHide . toCUIControl 402 | 403 | -- | Destroys a control ('c_uiControlDestroy') 404 | uiDestroy :: ToCUIControl a => a -> IO () 405 | uiDestroy = c_uiControlDestroy . toCUIControl 406 | 407 | -- | Get a control's parent ('c_uiControlParent') 408 | uiGetParent :: ToCUIControl a => a -> IO CUIControl 409 | uiGetParent = c_uiControlParent . toCUIControl 410 | 411 | -- | Set a control's parent ('c_uiControlSetParent') 412 | uiSetParent :: (ToCUIControl a, ToCUIControl b) => a -> b -> IO () 413 | uiSetParent control parent = 414 | c_uiControlSetParent (toCUIControl control) (toCUIControl parent) 415 | 416 | -- | Get if a control is on the top level ('c_uiControlTopLevel') 417 | uiGetTopLevel :: ToCUIControl a => a -> IO Bool 418 | uiGetTopLevel c = numToBool <$> c_uiControlToplevel (toCUIControl c) 419 | 420 | -- | Get if a control is visible ('c_uiControlVisible') 421 | uiGetVisible :: ToCUIControl a => a -> IO Bool 422 | uiGetVisible c = numToBool <$> c_uiControlVisible (toCUIControl c) 423 | 424 | -- | Get if a control is enabled ('c_uiControlEnabled') 425 | uiGetEnabled :: ToCUIControl a => a -> IO Bool 426 | uiGetEnabled c = numToBool <$> c_uiControlEnabled (toCUIControl c) 427 | 428 | -- | Set if a control is enabled ('c_uiControlEnable' & 'c_uiControlDisable') 429 | uiSetEnabled :: ToCUIControl a => a -> Bool -> IO () 430 | uiSetEnabled c True = c_uiControlEnable (toCUIControl c) 431 | uiSetEnabled c False = c_uiControlDisable (toCUIControl c) 432 | 433 | -- * UI Controls 434 | -- ** Windows 435 | -- *** CUIWindow <- uiWindow 436 | 437 | -- | 438 | -- Wrapped version of `c_uiNewWindow` 439 | uiNewWindow 440 | :: String 441 | -- ^ Title 442 | -> Int 443 | -- ^ Width 444 | -> Int 445 | -- ^ Height 446 | -> Bool 447 | -- ^ Has menubar 448 | -> IO CUIWindow 449 | uiNewWindow t w h hasMenubar = 450 | withCString t $ \t' -> c_uiNewWindow t' (fromIntegral w) (fromIntegral h) (boolToNum hasMenubar) 451 | 452 | setBorderless :: CUIWindow -> Bool -> IO () 453 | setBorderless w b = c_uiWindowSetBorderless w (boolToNum b) 454 | 455 | getBorderless :: CUIWindow -> IO Bool 456 | getBorderless w = numToBool <$> c_uiWindowBorderless w 457 | 458 | getContentSize :: CUIWindow -> IO (Int, Int) 459 | getContentSize w = alloca $ \x -> alloca $ \y -> do 460 | c_uiWindowContentSize w x y 461 | x' <- peek x 462 | y' <- peek y 463 | return (fromIntegral x', fromIntegral y') 464 | 465 | setContentSize :: CUIWindow -> (Int, Int) -> IO () 466 | setContentSize w (x, y) = 467 | c_uiWindowSetContentSize w (fromIntegral x) (fromIntegral y) 468 | 469 | onContentSizeChange w action = do 470 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 471 | c_uiWindowOnContentSizeChanged w f nullPtr 472 | 473 | getFullscreen w = numToBool <$> c_uiWindowFullscreen w 474 | setFullscreen w b = c_uiWindowSetFullscreen w (boolToNum b) 475 | 476 | uiWindowGetTitle :: CUIWindow -> IO String 477 | uiWindowGetTitle = c_uiWindowTitle >=> peekCString 478 | 479 | instance HasSetTitle CUIWindow where 480 | setTitle w t = withCString t (c_uiWindowSetTitle w) 481 | 482 | instance HasGetTitle CUIWindow where 483 | getTitle w = c_uiWindowTitle w >>= peekCString 484 | 485 | instance HasOnClosing CUIWindow where 486 | onClosing w a = do 487 | f <- castFunPtr <$> c_wrap2 (\_ _ -> a) 488 | c_uiWindowOnClosing w f nullPtr 489 | 490 | instance HasSetChild CUIWindow where 491 | setChild w c = do 492 | c' <- toCUIControlIO c 493 | c_uiWindowSetChild w c' 494 | 495 | instance HasGetMargined CUIWindow where 496 | getMargined w = do 497 | m <- c_uiWindowMargined w 498 | return $ numToBool m 499 | 500 | instance HasSetMargined CUIWindow where 501 | setMargined w m = c_uiWindowSetMargined w (boolToNum m) 502 | 503 | -- ** Labels 504 | -- *** CUILabel <- uiLabel 505 | instance HasGetText CUILabel where 506 | getText c = c_uiLabelText c >>= peekCString 507 | 508 | instance HasSetText CUILabel where 509 | setText c s = withCString s (c_uiLabelSetText c) 510 | 511 | uiNewLabel s = withCString s c_uiNewLabel 512 | 513 | -- ** Layout 514 | -- *** CUIBox <- uiBox 515 | instance HasAppendChild CUIBox where 516 | appendChild b c = do 517 | c' <- toCUIControlIO c 518 | c_uiBoxAppend b c' 0 519 | appendChildStretchy b c = do 520 | c' <- toCUIControlIO c 521 | c_uiBoxAppend b c' 1 522 | 523 | instance HasRemoveChild CUIBox where 524 | removeChild b i = c_uiBoxDelete b (fromIntegral i) 525 | 526 | instance HasGetPadded CUIBox where 527 | getPadded b = do 528 | p <- c_uiBoxPadded b 529 | return (numToBool p) 530 | 531 | instance HasSetPadded CUIBox where 532 | setPadded b p = c_uiBoxSetPadded b (boolToNum p) 533 | 534 | uiNewHorizontalBox = c_uiNewHorizontalBox 535 | 536 | uiNewVerticalBox = c_uiNewVerticalBox 537 | 538 | -- *** CUITabs <- uiTab 539 | appendTab :: ToCUIControlIO c => CUITabs -> (String, c) -> IO () 540 | appendTab tabs (name, child) = withCString name $ \cname -> do 541 | c <- toCUIControlIO child 542 | c_uiTabAppend tabs cname c 543 | 544 | removeTab = c_uiTabDelete 545 | 546 | appendTabMargined :: ToCUIControlIO c => CUITabs -> (String, c) -> IO () 547 | appendTabMargined tabs (name, child) = withCString name $ \cname -> do 548 | c <- toCUIControlIO child 549 | c_uiTabAppend tabs cname c 550 | n <- c_uiTabNumPages tabs 551 | c_uiTabSetMargined tabs (n - 1) 1 552 | 553 | instance HasGetMargined (CUITabs, Int) where 554 | getMargined (tabs, nt) = do 555 | c <- c_uiTabMargined tabs (fromIntegral nt) 556 | return $ numToBool c 557 | 558 | instance HasSetMargined (CUITabs, Int) where 559 | setMargined (tabs, nt) i = 560 | c_uiTabSetMargined tabs (fromIntegral nt) (boolToNum i) 561 | 562 | uiNewTabs :: IO CUITabs 563 | uiNewTabs = c_uiNewTab 564 | 565 | -- *** CUIGroup <- uiGroup 566 | instance HasSetChild CUIGroup where 567 | setChild g c = do 568 | c' <- toCUIControlIO c 569 | c_uiGroupSetChild g c' 570 | 571 | instance HasSetTitle CUIGroup where 572 | setTitle c t = withCString t (c_uiGroupSetTitle c) 573 | 574 | instance HasGetTitle CUIGroup where 575 | getTitle c = c_uiGroupTitle c >>= peekCString 576 | 577 | instance HasGetMargined CUIGroup where 578 | getMargined g = do 579 | c <- c_uiGroupMargined g 580 | return $ numToBool c 581 | 582 | instance HasSetMargined CUIGroup where 583 | setMargined w m = c_uiGroupSetMargined w (boolToNum m) 584 | 585 | uiNewGroup s = withCString s c_uiNewGroup 586 | 587 | -- *** CUIGrid <- uiGrid 588 | data UIAlign = UIAlignFill 589 | | UIAlignStart 590 | | UIAlignCenter 591 | | UIAlignEnd 592 | 593 | toCUIAlign UIAlignFill = CUIAlign 0 594 | toCUIAlign UIAlignStart = CUIAlign 1 595 | toCUIAlign UIAlignCenter = CUIAlign 2 596 | toCUIAlign UIAlignEnd = CUIAlign 3 597 | 598 | data UIAt = UIAtLeading 599 | | UIAtTop 600 | | UIAtTrailing 601 | | UIAtBottom 602 | 603 | toCUIAt UIAtLeading = CUIAt 0 604 | toCUIAt UIAtTop = CUIAt 1 605 | toCUIAt UIAtTrailing = CUIAt 2 606 | toCUIAt UIAtBottom = CUIAt 3 607 | 608 | uiGridAppend 609 | :: ToCUIControlIO c 610 | => CUIGrid 611 | -> c 612 | -> Int -> Int 613 | -> Int -> Int 614 | -> Int -> UIAlign 615 | -> Int -> UIAlign 616 | -> IO () 617 | uiGridAppend grid control left top xspan yspan hexpand halign vexpand valign = do 618 | control' <- toCUIControlIO control 619 | c_uiGridAppend 620 | grid 621 | control' 622 | (fromIntegral left) 623 | (fromIntegral top) 624 | (fromIntegral xspan) 625 | (fromIntegral yspan) 626 | (fromIntegral hexpand) 627 | (toCUIAlign halign) 628 | (fromIntegral vexpand) 629 | (toCUIAlign valign) 630 | 631 | uiGridInsertAt 632 | :: (ToCUIControlIO oldControl, ToCUIControlIO newControl) 633 | => CUIGrid 634 | -> oldControl 635 | -> newControl 636 | -> UIAt 637 | -> Int -> Int 638 | -> Int -> UIAlign 639 | -> Int -> UIAlign 640 | -> IO () 641 | uiGridInsertAt grid ocontrol ncontrol at xspan yspan hexpand halign vexpand valign = do 642 | ocontrol' <- toCUIControlIO ocontrol 643 | ncontrol' <- toCUIControlIO ncontrol 644 | c_uiGridInsertAt 645 | grid 646 | ocontrol' 647 | ncontrol' 648 | (toCUIAt at) 649 | (fromIntegral xspan) 650 | (fromIntegral yspan) 651 | (fromIntegral hexpand) 652 | (toCUIAlign halign) 653 | (fromIntegral vexpand) 654 | (toCUIAlign valign) 655 | 656 | instance HasGetPadded CUIGrid where 657 | getPadded g = do 658 | p <- c_uiGridPadded g 659 | return (numToBool p) 660 | 661 | instance HasSetPadded CUIGrid where 662 | setPadded g p = c_uiGridSetPadded g (boolToNum p) 663 | 664 | uiNewGrid = c_uiNewGrid 665 | 666 | -- *** CUISeparator <- uiSeparator 667 | uiNewHorizontalSeparator = c_uiNewHorizontalSeparator 668 | uiNewVerticalSeparator = c_uiNewVerticalSeparator 669 | 670 | -- ** Input Types 671 | -- *** Buttons 672 | -- **** CUIButton <- uiButton 673 | 674 | instance HasOnClicked CUIButton where 675 | onClick btn action = do 676 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 677 | c_uiButtonOnClicked btn f nullPtr 678 | 679 | instance HasGetText CUIButton where 680 | getText btn = c_uiButtonText btn >>= peekCString 681 | 682 | instance HasSetText CUIButton where 683 | setText btn s = withCString s (c_uiButtonSetText btn) 684 | 685 | uiNewButton str = withCString str c_uiNewButton 686 | 687 | -- *** CUICheckbox <- uiCheckbox 688 | instance HasSetText CUICheckbox where 689 | setText btn s = withCString s (c_uiCheckboxSetText btn) 690 | 691 | instance HasGetText CUICheckbox where 692 | getText btn = c_uiCheckboxText btn >>= peekCString 693 | 694 | instance HasSetChecked CUICheckbox where 695 | setChecked c False = c_uiCheckboxSetChecked c 0 696 | setChecked c True = c_uiCheckboxSetChecked c 1 697 | 698 | instance HasGetChecked CUICheckbox where 699 | getChecked c = numToBool <$> c_uiCheckboxChecked c 700 | 701 | onToggled m action = do 702 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 703 | c_uiCheckboxOnToggled m f nullPtr 704 | 705 | instance HasOnChanged CUICheckbox where 706 | onChange = onToggled 707 | 708 | instance HasOnClicked CUICheckbox where 709 | onClick = onToggled 710 | 711 | uiNewCheckbox s = withCString s c_uiNewCheckbox 712 | 713 | -- *** CUIEntry <- uiEntry 714 | instance HasSetText CUIEntry where 715 | setText c s = withCString s (c_uiEntrySetText c) 716 | 717 | instance HasGetText CUIEntry where 718 | getText c = c_uiEntryText c >>= peekCString 719 | 720 | instance HasGetReadOnly CUIEntry where 721 | getReadOnly c = numToBool <$> c_uiEntryReadOnly c 722 | 723 | instance HasSetReadOnly CUIEntry where 724 | setReadOnly c b = c_uiEntrySetReadOnly c (boolToNum b) 725 | 726 | instance HasOnChanged CUIEntry where 727 | onChange btn action = do 728 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 729 | c_uiEntryOnChanged btn f nullPtr 730 | 731 | uiNewEntry = c_uiNewEntry 732 | uiNewPasswordEntry = c_uiNewPasswordEntry 733 | uiNewSearchEntry = c_uiNewSearchEntry 734 | 735 | -- *** CUISlider <- uiSlider 736 | instance HasGetValue CUISlider where 737 | getValue c = fromIntegral <$> c_uiSliderValue c 738 | 739 | instance HasSetValue CUISlider where 740 | setValue c i = c_uiSliderSetValue c (fromIntegral i) 741 | 742 | instance HasOnChanged CUISlider where 743 | onChange btn action = do 744 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 745 | c_uiSliderOnChanged btn f nullPtr 746 | 747 | uiNewSlider low high = c_uiNewSlider (fromIntegral low) (fromIntegral high) 748 | 749 | -- *** CUICombobox <- uiCombobox 750 | class HasAppendOption a where 751 | appendOption :: a -> String -> IO () 752 | appendOptions :: a -> [String] -> IO () 753 | appendOptions x = mapM_ (appendOption x) 754 | 755 | instance HasGetValue CUICombobox where 756 | getValue c = fromIntegral <$> c_uiComboboxSelected c 757 | 758 | instance HasSetValue CUICombobox where 759 | setValue c s = c_uiComboboxSetSelected c (fromIntegral s) 760 | 761 | instance HasOnChanged CUICombobox where 762 | onChange c action = do 763 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 764 | c_uiComboboxOnSelected c f nullPtr 765 | 766 | instance HasAppendOption CUICombobox where 767 | appendOption c s = withCString s (c_uiComboboxAppend c) 768 | 769 | uiNewCombobox = c_uiNewCombobox 770 | 771 | -- *** CUIEditableCombobox <- uiEditableCombobox 772 | instance HasAppendOption CUIEditableCombobox where 773 | appendOption c s = withCString s (c_uiEditableComboboxAppend c) 774 | 775 | instance HasGetText CUIEditableCombobox where 776 | getText c = c_uiEditableComboboxText c >>= peekCString 777 | 778 | instance HasSetText CUIEditableCombobox where 779 | setText c s = withCString s (c_uiEditableComboboxSetText c) 780 | 781 | instance HasOnChanged CUIEditableCombobox where 782 | onChange btn action = do 783 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 784 | c_uiEditableComboboxOnChanged btn f nullPtr 785 | 786 | uiNewEditableCombobox = c_uiNewEditableCombobox 787 | 788 | -- *** CUIRadioButtons <- uiRadioButtons 789 | instance HasAppendOption CUIRadioButtons where 790 | appendOption c s = withCString s (c_uiRadioButtonsAppend c) 791 | 792 | instance HasGetValue CUIRadioButtons where 793 | getValue c = fromIntegral <$> c_uiRadioButtonsSelected c 794 | 795 | instance HasSetValue CUIRadioButtons where 796 | setValue c s = c_uiRadioButtonsSetSelected c (fromIntegral s) 797 | 798 | instance HasOnChanged CUIRadioButtons where 799 | onChange c action = do 800 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 801 | c_uiRadioButtonsOnSelected c f nullPtr 802 | 803 | -- TODO setSelected type-class 804 | 805 | uiNewRadioButtons = c_uiNewRadioButtons 806 | 807 | -- *** CUIForm <- uiForm 808 | uiFormAppend form name input stretchy = withCString name $ \cname -> 809 | c_uiFormAppend form cname input (boolToNum stretchy) 810 | 811 | class ToAppendInput e where 812 | appendInput :: CUIForm -> e -> IO () 813 | 814 | instance ToCUIControlIO c => ToAppendInput (String, c, Bool) where 815 | form `appendInput` (name, input, stretchy) = do 816 | input' <- toCUIControlIO input 817 | uiFormAppend form name input' stretchy 818 | 819 | instance ToCUIControlIO c => ToAppendInput (String, c) where 820 | form `appendInput` (name, input) = form `appendInput` (name, input, True) 821 | 822 | instance HasRemoveChild CUIForm where 823 | removeChild b i = c_uiFormDelete b (fromIntegral i) 824 | 825 | instance HasGetPadded CUIForm where 826 | getPadded b = do 827 | p <- c_uiFormPadded b 828 | return $ numToBool p 829 | 830 | instance HasSetPadded CUIForm where 831 | setPadded b p = c_uiFormSetPadded b (boolToNum p) 832 | 833 | uiNewForm = c_uiNewForm 834 | 835 | -- *** CUIDatePicker <- uiDatePicker 836 | 837 | uiNewDatePicker = c_uiNewDatePicker 838 | uiNewTimePicker = c_uiNewTimePicker 839 | uiNewDateTimePicker = c_uiNewDateTimePicker 840 | 841 | -- *** CUIFontButton <- uiFontButton 842 | uiNewFontButton = c_uiNewFontButton 843 | 844 | -- *** CUIColorButton <- uiColorButton 845 | uiNewColorButton = c_uiNewColorButton 846 | 847 | -- *** CUIMultilineEntry <- uiMultilineEntry 848 | instance HasGetText CUIMultilineEntry where 849 | getText c = c_uiMultilineEntryText c >>= peekCString 850 | 851 | instance HasSetText CUIMultilineEntry where 852 | setText c s = withCString s (c_uiMultilineEntrySetText c) 853 | 854 | instance HasOnChanged CUIMultilineEntry where 855 | onChange m action = do 856 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 857 | c_uiMultilineEntryOnChanged m f nullPtr 858 | 859 | instance HasGetReadOnly CUIMultilineEntry where 860 | getReadOnly e = numToBool <$> c_uiMultilineEntryReadOnly e 861 | 862 | instance HasSetReadOnly CUIMultilineEntry where 863 | setReadOnly e b = c_uiMultilineEntrySetReadOnly e (boolToNum b) 864 | 865 | appendText :: CUIMultilineEntry -> String -> IO () 866 | appendText m s = withCString s (c_uiMultilineEntryAppend m) 867 | 868 | uiNewMultilineEntry = c_uiNewMultilineEntry 869 | 870 | uiNewNonWrappingMultilineEntry = c_uiNewNonWrappingMultilineEntry 871 | 872 | -- ** Progress Indicators 873 | -- *** CUIProgressBar <- uiProgressBar 874 | instance HasGetValue CUIProgressBar where 875 | getValue c = fromIntegral <$> c_uiProgressBarValue c 876 | 877 | instance HasSetValue CUIProgressBar where 878 | setValue c i = c_uiProgressBarSetValue c (fromIntegral i) 879 | 880 | uiNewProgressBar = c_uiNewProgressBar 881 | 882 | -- *** CUISpinbox <- uiSpinbox 883 | instance HasGetValue CUISpinbox where 884 | getValue c = fromIntegral <$> c_uiSpinboxValue c 885 | 886 | instance HasSetValue CUISpinbox where 887 | setValue c i = c_uiSpinboxSetValue c (fromIntegral i) 888 | 889 | instance HasOnChanged CUISpinbox where 890 | onChange m action = do 891 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 892 | c_uiSpinboxOnChanged m f nullPtr 893 | 894 | uiNewSpinbox low high = c_uiNewSpinbox (fromIntegral low) (fromIntegral high) 895 | 896 | -- * The Menubar 897 | -- ** CUIMenu <- uiMenu 898 | 899 | uiNewMenu s = newCString s >>= c_uiNewMenu 900 | uiMenuAppendItem m s = withCString s (c_uiMenuAppendItem m) 901 | uiMenuAppendCheckItem m s = withCString s (c_uiMenuAppendCheckItem m) 902 | uiMenuAppendQuitItem = c_uiMenuAppendQuitItem 903 | uiMenuAppendAboutItem = c_uiMenuAppendAboutItem 904 | uiMenuAppendPreferencesItem = c_uiMenuAppendPreferencesItem 905 | uiMenuAppendSeparator = c_uiMenuAppendSeparator 906 | 907 | -- ** CUIMenuItem <- uiMenuItem 908 | uiMenuItemEnable = c_uiMenuItemEnable 909 | uiMenuItemDisable = c_uiMenuItemDisable 910 | 911 | instance HasOnClicked CUIMenuItem where 912 | onClick itm action = do 913 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 914 | c_uiMenuItemOnClicked itm f nullPtr 915 | 916 | instance HasGetChecked CUIMenuItem where 917 | getChecked c = numToBool <$> c_uiMenuItemChecked c 918 | 919 | instance HasSetChecked CUIMenuItem where 920 | setChecked c False = c_uiMenuItemSetChecked c 0 921 | setChecked c True = c_uiMenuItemSetChecked c 1 922 | 923 | -- * UI Alerts and Dialogs 924 | 925 | uiOpenFile :: CUIWindow -> IO (Maybe FilePath) 926 | uiOpenFile wn = do 927 | cstr <- c_uiOpenFile wn 928 | peekCStringSafe cstr 929 | 930 | uiSaveFile :: CUIWindow -> IO (Maybe FilePath) 931 | uiSaveFile wn = do 932 | cstr <- c_uiSaveFile wn 933 | peekCStringSafe cstr 934 | 935 | uiMsgBox 936 | :: CUIWindow 937 | -> String 938 | -> String 939 | -> IO () 940 | uiMsgBox w t d = withCString t $ \t' -> withCString d $ \d' -> 941 | c_uiMsgBox w t' d' 942 | 943 | uiMsgBoxError 944 | :: CUIWindow 945 | -> String 946 | -> String 947 | -> IO () 948 | uiMsgBoxError w t d = withCString t $ \t' -> withCString d $ \d' -> 949 | c_uiMsgBoxError w t' d' 950 | 951 | -- * Internal functions 952 | -- ** Ticking the loop 953 | -- | Setup the main loop to be ticked manually 954 | uiMainSteps :: IO () 955 | uiMainSteps = setHasMain True >> c_uiMainSteps 956 | 957 | -- | Tick the main loop 958 | uiMainStep :: Int -> IO Int 959 | uiMainStep i = do 960 | ne <- c_uiMainStep (fromIntegral i) 961 | return (fromIntegral ne) 962 | 963 | -- | Is the main loop running? 964 | hasMainM :: MVar Bool 965 | hasMainM = unsafePerformIO (newMVar False) 966 | {-# NOINLINE hasMainM #-} 967 | 968 | getHasMain :: IO Bool 969 | getHasMain = readMVar hasMainM 970 | 971 | setHasMain :: Bool -> IO () 972 | setHasMain m = modifyMVar_ hasMainM (const (return m)) 973 | 974 | boolToNum :: Num a => Bool -> a 975 | boolToNum False = 0 976 | boolToNum True = 1 977 | 978 | numToBool :: (Num a, Eq a) => a -> Bool 979 | numToBool 0 = False 980 | numToBool _ = True 981 | 982 | peekCStringSafe :: CString -> IO (Maybe String) 983 | peekCStringSafe cstr | cstr == nullPtr = return Nothing 984 | peekCStringSafe cstr = do 985 | str <- peekCString cstr 986 | return $ case str of 987 | "" -> Nothing 988 | _ -> Just str 989 | 990 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/FFI/Wrapped/OSX.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE InterruptibleFFI #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE UndecidableInstances #-} 10 | module Graphics.LibUI.FFI.Wrapped.OSX 11 | ( 12 | -- ** Webviews 13 | CUIWebview (..) 14 | , onLoad 15 | , uiNewWebview 16 | , uiWebviewLoadUrl 17 | , uiWebviewLoadHtml 18 | , uiWebviewEval 19 | 20 | -- ** Extra menubar operations 21 | , uiMenuAppendItemWith 22 | , uiMenuAppendItemWithDefaultTarget 23 | 24 | , HasLoadUrl (..) 25 | , HasLoadHtml (..) 26 | , HasEvalJs (..) 27 | 28 | -- * Raw FFI 29 | , module Graphics.LibUI.FFI.Raw.OSX 30 | ) 31 | where 32 | 33 | import Control.Concurrent 34 | import Control.Monad (when, (>=>)) 35 | import Control.Monad.Loops 36 | import Foreign hiding (void) 37 | import Foreign.C 38 | import System.IO.Unsafe 39 | 40 | import Graphics.LibUI.FFI.Raw 41 | import Graphics.LibUI.FFI.Raw.OSX 42 | 43 | class HasLoadUrl w where 44 | loadUrl :: w -> String -> IO () 45 | 46 | class HasLoadHtml w where 47 | loadHtml :: w -> (String, FilePath) -> IO () 48 | 49 | class HasEvalJs w where 50 | evalJs :: w -> String -> IO String 51 | 52 | -- * Webviews 53 | uiNewWebview = c_uiNewWebview 54 | uiWebviewLoadUrl w s = withCString s (c_uiWebviewLoadUrl w) 55 | uiWebviewLoadHtml w s baseUrl = withCString s $ \s' -> withCString baseUrl $ \baseUrl' -> 56 | c_uiWebviewLoadHtml w s' baseUrl' 57 | uiWebviewEval w s = withCString s (c_uiWebviewEval w) >>= peekCString 58 | 59 | onLoad webview action = do 60 | f <- castFunPtr <$> c_wrap2 (\_ _ -> action) 61 | c_uiWebviewOnLoad webview f nullPtr 62 | 63 | instance HasLoadUrl CUIWebview where 64 | loadUrl = uiWebviewLoadUrl 65 | 66 | instance HasEvalJs CUIWebview where 67 | evalJs = uiWebviewEval 68 | 69 | instance HasLoadHtml CUIWebview where 70 | loadHtml w = uncurry (uiWebviewLoadHtml w) 71 | 72 | -- * Extra menu operations 73 | -- | In OSX, there're APIs for defining keyboard shortcut handlers bound to menu 74 | -- items, without which the UX is really bad. Namely the 'Edit' menu items 75 | -- aren't possible without this (see the `markd` example). 76 | -- 77 | -- This is essentially just calling a Cocoa API 78 | uiMenuAppendItemWith m s k sl = 79 | withCString s $ \s' -> withCString k $ \k' -> withCString sl $ \sl' -> 80 | c_uiMenuAppendItemWith m s' k' sl' 81 | 82 | -- | Like c_uiMenuAppendItemWith, but uses the application "menuManager" as the 83 | -- target 84 | -- 85 | -- This is essentially just calling a Cocoa API 86 | uiMenuAppendItemWithDefaultTarget m s k sl = 87 | withCString s $ \s' -> withCString k $ \k' -> withCString sl $ \sl' -> 88 | c_uiMenuAppendItemWithDefaultTarget m s' k' sl' 89 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/MonadUI.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | module Graphics.LibUI.MonadUI where 4 | 5 | import Control.Applicative 6 | import Control.Concurrent 7 | import Control.Concurrent.Async 8 | import Control.Exception 9 | import Control.Monad 10 | import Control.Monad.Fix 11 | import Control.Monad.IO.Class 12 | import Control.Monad.Trans 13 | import Data.String 14 | import Foreign hiding (void) 15 | import qualified Foreign 16 | import Foreign.C 17 | import System.IO (fixIO) 18 | 19 | import Graphics.LibUI.FFI 20 | 21 | data UI a = UI { runUI :: IO (a, [CUIControl]) 22 | } 23 | 24 | instance Functor UI where 25 | f `fmap` ui = UI $ runUI ui >>= \(a, c) -> return (f a, c) 26 | 27 | instance Monoid a => Monoid (UI a) where 28 | mempty = UI (return (mempty, [])) 29 | ui1 `mappend` ui2 = UI $ do 30 | (a, cui1) <- runUI ui1 31 | (b, cui2) <- runUI ui2 32 | return (a `mappend` b, cui1 ++ cui2) 33 | 34 | instance MonadFix UI where 35 | mfix f = UI $ do 36 | x <- fixIO (fmap fst . runUI . f) 37 | return (x, []) 38 | 39 | instance Applicative UI where 40 | pure = return 41 | (<*>) = ap 42 | 43 | instance Monad UI where 44 | return x = UI (return (x, [])) 45 | ui >>= a = UI $ do 46 | (r, cui1) <- runUI ui 47 | (r', cui2) <- runUI $ a r 48 | return (r', cui1 ++ cui2) 49 | 50 | instance MonadIO UI where 51 | liftIO action = UI $ do 52 | a <- action 53 | return (a, []) 54 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/OSX.hs: -------------------------------------------------------------------------------- 1 | module Graphics.LibUI.OSX 2 | ( module Graphics.LibUI.FFI.Raw.OSX 3 | , module Graphics.LibUI.FFI.Wrapped.OSX 4 | ) 5 | where 6 | 7 | import Graphics.LibUI.FFI.Raw.OSX 8 | import Graphics.LibUI.FFI.Wrapped.OSX 9 | -------------------------------------------------------------------------------- /src/Graphics/LibUI/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | -- {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE ExistentialQuantification #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE DeriveFunctor #-} 7 | {-# LANGUAGE InstanceSigs #-} 8 | {-# LANGUAGE MultiParamTypeClasses #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TupleSections #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE UndecidableInstances #-} 15 | module Graphics.LibUI.Types 16 | where 17 | 18 | import Control.Applicative 19 | import Control.Concurrent 20 | import Control.Concurrent.Async 21 | import Control.Exception 22 | import Control.Monad 23 | import Control.Monad.Free.TH 24 | import Control.Monad.IO.Class 25 | import Control.Monad.Trans 26 | import Control.Monad.Writer 27 | import Data.Default 28 | import Data.Maybe 29 | import Data.String 30 | import Foreign hiding (void) 31 | import qualified Foreign 32 | import Foreign.C 33 | -- import Data.Data 34 | 35 | import Graphics.LibUI.FFI 36 | import Graphics.LibUI.MonadUI 37 | 38 | headMaybe [] = Nothing 39 | headMaybe (c:_) = Just c 40 | 41 | data UIControl c next = UIControlWindow (UIWindow c) next 42 | | UIControlButton UIButton next 43 | | UIControlBox (UIBox c) next 44 | | UIControlCheckbox UICheckbox next 45 | | UIControlEntry UIEntry next 46 | | UIControlLabel UILabel next 47 | | UIControlTab (UITab c) next 48 | | UIControlGroup (UIGroup c) next 49 | | UIControlSpinbox UISpinbox next 50 | | UIControlSlider UISlider next 51 | | UIControlProgressBar UIProgressBar next 52 | | UIControlSeparator UISeparator next 53 | | UIControlCombobox UICombobox next 54 | | UIControlEditableCombobox UIEditableCombobox next 55 | | UIControlRadioButtons UIRadioButtons next 56 | | UIControlMultlineEntry UIMultilineEntry next 57 | | UIControlMenuItem UIMenuItem next 58 | | UIControlMenu UIMenu next 59 | deriving(Functor) 60 | 61 | -- class ToCUIControlIO c where 62 | -- toCUIControlIO :: c -> IO CUIControl 63 | 64 | --instance {-# OVERLAPS #-} ToCUIControlIO' (UIControl CUIControl) CUIControl where 65 | -- toCUIIO ctrl = do 66 | -- ctrl' <- toCUIControl <$> case ctrl of 67 | -- UIControlWindow c -> toCUIIO c :: IO CUIWindow 68 | -- UIControlButton c -> toCUIIO c :: IO CUIButton 69 | -- UIControlBox c -> toCUIIO c :: IO CUIBox 70 | -- UIControlCheckbox c -> toCUIIO c :: IO CUICheckbox 71 | -- UIControlEntry c -> toCUIIO c :: IO CUIEntry 72 | -- UIControlLabel c -> toCUIIO c :: IO CUILabel 73 | -- UIControlTab c -> toCUIIO c :: IO CUITabs 74 | -- UIControlGroup c -> toCUIIO c :: IO CUIGroup 75 | -- UIControlSpinbox c -> toCUIIO c :: IO CUISpinbox 76 | -- UIControlSlider c -> toCUIIO c :: IO CUISlider 77 | -- UIControlProgressBar c -> toCUIIO c :: IO CUIProgressBar 78 | -- UIControlSeparator c -> toCUIIO c :: IO CUISeparator 79 | -- UIControlCombobox c -> toCUIIO c :: IO CUICombobox 80 | -- UIControlEditableCombobox c -> toCUIIO c :: IO CUIEditableCombobox 81 | -- UIControlRadioButtons c -> toCUIIO c :: IO CUIRadioButtons 82 | -- UIControlMultlineEntry c -> toCUIIO c :: IO CUIMultilineEntry 83 | -- UIControlMenuItem c -> toCUIIO c :: IO CUIMenuItem 84 | -- UIControlMenu c -> toCUIIO c :: IO CUIMenu 85 | -- toCUIIO ctrl' 86 | 87 | --data UI' c = UI' [UIControl c] 88 | --class Monad m => MonadUI m r c where 89 | -- runMonadUI :: UI' c -> m r 90 | 91 | --instance MonadUI IO CUIControl CUIControl where 92 | -- runMonadUI :: UI' CUIControl -> IO CUIControl 93 | -- runMonadUI (UI' cs) = do 94 | -- cs' <- mapM toCUIIO cs 95 | -- return (head cs') 96 | 97 | runUILoop ui = run 98 | where 99 | run = do 100 | uiInit 101 | (_, cs) <- runUI ui 102 | mapM_ uiShow cs 103 | uiOnShouldQuit (uiQuit >> return 0) 104 | uiMain 105 | 106 | window :: String -> Int -> Int -> Bool -> UI () -> UI CUIWindow 107 | window title width height hasMenubar child = UI $ do 108 | c <- toCUIIO $ def { uiWindowTitle = title 109 | , uiWindowWidth = width 110 | , uiWindowHeight = height 111 | , uiWindowHasMenubar = hasMenubar 112 | , uiWindowChild = child 113 | } 114 | return (c, [toCUIControl c]) 115 | 116 | window' :: UIWindow (UI a) -> UI (CUIWindow, a) 117 | window' w = UI $ do 118 | (x, [c]) <- runUI (uiWindowChild w) 119 | cw <- toCUIIO (w { uiWindowChild = c 120 | }) 121 | return ((cw, x), [toCUIControl cw]) 122 | 123 | -- window' :: UIWindow -> UI CUIWindow 124 | -- window' win = UI $ do 125 | -- cuiWin@(CUIControl cwin) <- toCUIControlIO win 126 | -- return (CUIWindow (castPtr cwin), [cuiWin]) 127 | 128 | -- button :: String -> UI () 129 | -- button title = wrap (UIButton title Nothing) 130 | 131 | -- wrap :: ToCUIControlIO c => c -> UI b 132 | wrap toCUI = UI $ do 133 | cui@(CUIControl ptr) <- toCUIControlIO toCUI 134 | -- let cuip = toCUIPointerType ptr 135 | return ((), [cui]) 136 | 137 | wrapEmpty :: ToCUIControlIO c => c -> UI () 138 | wrapEmpty toCUI = UI $ do 139 | cui <- toCUIControlIO toCUI 140 | return ((), []) 141 | 142 | vbox :: UI a -> UI a 143 | vbox = box UIVerticalBox 144 | 145 | hbox :: UI a -> UI a 146 | hbox = box UIHorizontalBox 147 | 148 | box :: (Bool -> [UIBoxChild CUIControl] -> UIBox CUIControl) -> UI a -> UI a 149 | box boxtype ui = UI $ do 150 | (x, cs) <- runUI ui -- :: IO (a, [CUIControl]) 151 | c <- toCUIIO $ boxtype True (map (UIBoxChild False) cs) :: IO CUIBox 152 | return (x, [toCUIControl c]) 153 | 154 | 155 | menu :: String -> [UIMenuItem] -> UI CUIMenu 156 | menu name items = UI $ do 157 | c <- toCUIIO $ UIMenu name items 158 | return (c, []) 159 | 160 | group :: String -> UI a -> UI (CUIGroup, a) 161 | group title items = UI $ do 162 | (x, child) <- runUI items 163 | child' <- toCUIIO child :: IO CUIBox 164 | c <- toCUIIO $ UIGroup title 1 child' :: IO CUIGroup 165 | return ((c, x), [toCUIControl c]) 166 | 167 | progressbar :: Int -> UI CUIProgressBar 168 | progressbar value = UI $ do 169 | pg <- toCUIIO (UIProgressBar value) 170 | return (pg, [toCUIControl pg]) 171 | 172 | slider :: Int -> Int -> Int -> UI CUISlider 173 | slider value min max = UI $ do 174 | sld <- toCUIIO (UISlider value min max) 175 | return (sld, [toCUIControl sld]) 176 | 177 | spinbox :: Int -> Int -> Int -> UI CUISpinbox 178 | spinbox value min max = UI $ do 179 | spb <- toCUIIO (UISpinbox value min max) 180 | return (spb, [toCUIControl spb]) 181 | 182 | -- render = wrap 183 | 184 | -- tabs ts = UI $ do 185 | -- ts' <- forM ts $ \t -> do 186 | -- (r, (c:cs)) <- runUI t 187 | -- return (r, c) 188 | -- c <- toCUIControlIO (UITab 1 ts') 189 | -- return ((), [c]) 190 | tabs :: Writer [UI String] () -> UI CUITabs 191 | tabs wts = UI $ do 192 | let ts :: [UI String] 193 | ts = snd $ runWriter wts 194 | ts' <- forM ts $ \t -> do 195 | (r, c:_) <- runUI t 196 | return (r, c) 197 | t <- toCUIIO (UITab 1 ts') :: IO CUITabs 198 | return (t, [toCUIControl t]) 199 | 200 | tab :: String -> UI () -> Writer [UI String] () 201 | tab title ui = do 202 | let ui' = UI $ do 203 | (_, c) <- runUI $ vbox ui 204 | return (title, c) 205 | tell [ui'] 206 | 207 | checkbox :: String -> UI CUICheckbox 208 | checkbox t = UI $ do 209 | c <- toCUIIO (UICheckbox False t) 210 | return (c, [toCUIControl c]) 211 | 212 | button :: UIButton -> UI CUIButton 213 | button UIButton{..} = UI $ do 214 | cbtn <- c_uiNewButton =<< newCString uiButtonText 215 | maybe (return ()) 216 | (\onClick -> do 217 | cb <- c_wrap2 (\_ _ -> onClick) 218 | c_uiButtonOnClicked cbtn (castFunPtr cb) nullPtr) 219 | uiButtonOnClicked 220 | return (cbtn, [toCUIControl cbtn]) 221 | 222 | label :: String -> UI CUILabel 223 | label t = UI $ do 224 | lbl <- toCUIIO (UILabel t) 225 | return (lbl, [toCUIControl lbl]) 226 | 227 | entry :: String -> UI CUIEntry 228 | entry t = UI $ do 229 | c <- toCUIIO (UIEntry False t) 230 | return (c, [toCUIControl c]) 231 | 232 | searchEntry :: String -> UI CUIEntry 233 | searchEntry t = UI $ do 234 | c <- toCUIIO (UISearchEntry False t) 235 | return (c, [toCUIControl c]) 236 | 237 | passwordEntry :: String -> UI CUIEntry 238 | passwordEntry t = UI $ do 239 | c <- toCUIIO (UIPasswordEntry False t) 240 | return (c, [toCUIControl c]) 241 | 242 | form :: [(String, UI a)] -> UI CUIForm 243 | form cs = UI $ do 244 | c <- toCUIIO (UIForm cs) 245 | return (c, [toCUIControl c]) 246 | formItem x e = (x, e) 247 | 248 | -- ** Windows 249 | instance {-# OVERLAPS #-} ToCUIControlIO' [CUIControl] CUIBox where 250 | toCUIIO cs = do 251 | vb <- c_uiNewVerticalBox 252 | forM_ cs $ \c -> do 253 | c_uiBoxAppend vb c 1 254 | return vb 255 | 256 | instance {-# OVERLAPS #-} ToCUIControlIO' (UI a) CUIBox where 257 | toCUIIO :: UI a -> IO CUIBox 258 | toCUIIO ui = do 259 | (_, cs) <- runUI ui :: IO (a, [CUIControl]) 260 | cs' <- toCUIIO cs :: IO CUIBox 261 | return cs' 262 | 263 | data UIWindow c = 264 | UIWindow { uiWindowTitle :: String 265 | , uiWindowWidth :: Int 266 | , uiWindowHeight :: Int 267 | , uiWindowHasMenubar :: Bool 268 | , uiWindowMargined :: Bool 269 | , uiWindowChild :: c 270 | , uiWindowOnContentSizeChanged :: Maybe ((Int, Int) -> IO ()) 271 | , uiWindowDidMount :: Maybe (IO ()) 272 | , uiWindowOnClosing :: Maybe (IO ()) 273 | } 274 | 275 | instance Default (UIWindow c) where 276 | def = UIWindow { uiWindowTitle = "haskell-libui" 277 | , uiWindowWidth = 680 278 | , uiWindowHeight = 300 279 | , uiWindowHasMenubar = True 280 | , uiWindowMargined = True 281 | , uiWindowOnClosing = Just uiQuit 282 | , uiWindowOnContentSizeChanged = Nothing 283 | , uiWindowDidMount = Nothing 284 | , uiWindowChild = error "uiWindowChild needs to be overwritten" 285 | } 286 | 287 | instance {-# OVERLAPPING #-} ToCUIControlIO' (UIWindow (UI ())) CUIWindow where 288 | toCUIIO :: UIWindow (UI ()) -> IO CUIWindow 289 | toCUIIO wnd@UIWindow{..} = do 290 | box <- toCUIIO uiWindowChild :: IO CUIBox 291 | toCUIIO wnd { uiWindowChild = toCUIControl box 292 | } 293 | 294 | instance {-# OVERLAPPING #-} ToCUIControlIO' (UIWindow CUIControl) CUIWindow where 295 | toCUIIO :: UIWindow CUIControl -> IO CUIWindow 296 | toCUIIO wnd@UIWindow{..} = do 297 | w <- uiNewWindow uiWindowTitle uiWindowWidth uiWindowHeight uiWindowHasMenubar 298 | maybe (return ()) (onClosing w) uiWindowOnClosing 299 | w `setMargined` uiWindowMargined 300 | w `setChild` uiWindowChild 301 | return w 302 | 303 | -- ** Buttons 304 | data UIButton = UIButton { uiButtonText :: String 305 | , uiButtonOnClicked :: Maybe (IO ()) 306 | } 307 | 308 | instance {-# OVERLAPPING #-} Default UIButton where 309 | def = UIButton { uiButtonText = "Button" 310 | , uiButtonOnClicked = Nothing 311 | } 312 | 313 | instance {-# OVERLAPPING #-} ToCUIControlIO' UIButton CUIButton where 314 | toCUIIO UIButton{..} = do 315 | cbtn <- c_uiNewButton =<< newCString uiButtonText 316 | maybe 317 | (return ()) 318 | (\onClick -> do 319 | cb <- c_wrap2 (\_ _ -> onClick) 320 | c_uiButtonOnClicked cbtn (castFunPtr cb) nullPtr) 321 | uiButtonOnClicked 322 | return cbtn 323 | 324 | -- ** Boxes 325 | data UIBox c = UIHorizontalBox { uiBoxPadded :: Bool 326 | , uiBoxChildren :: [UIBoxChild c] 327 | } 328 | | UIVerticalBox { uiBoxPadded :: Bool 329 | , uiBoxChildren :: [UIBoxChild c] 330 | } 331 | 332 | instance Default (UIBox c) where 333 | def = UIVerticalBox { uiBoxPadded = True 334 | , uiBoxChildren = [] 335 | } 336 | 337 | data UIBoxChild c = UIBoxChild { uiBoxChildStretchy :: Bool 338 | , uiBoxChildControl :: c 339 | } 340 | 341 | instance {-# OVERLAPS #-} ToCUIControlIO' c CUIControl => ToCUIControlIO' (UIBox c) CUIBox where 342 | toCUIIO ui = do 343 | b <- case ui of 344 | UIVerticalBox{} -> c_uiNewVerticalBox 345 | UIHorizontalBox{} -> c_uiNewHorizontalBox 346 | b `setPadded` uiBoxPadded ui 347 | forM_ (uiBoxChildren ui) $ \UIBoxChild{..} -> do 348 | uiBoxChildControl' <- toCUIIO uiBoxChildControl :: IO CUIControl 349 | let uiBoxChildStretchy' = if uiBoxChildStretchy then 1 else 0 350 | c_uiBoxAppend b uiBoxChildControl' uiBoxChildStretchy' 351 | return b 352 | 353 | -- ** Checkboxes 354 | data UICheckbox = UICheckbox { uiCheckboxChecked :: Bool 355 | , uiCheckboxText :: String 356 | } 357 | 358 | instance {-# OVERLAPS #-} ToCUIControlIO' UICheckbox CUICheckbox where 359 | toCUIIO UICheckbox{..} = do 360 | c <- c_uiNewCheckbox =<< newCString uiCheckboxText 361 | c_uiCheckboxSetChecked c (if uiCheckboxChecked then 1 else 0) 362 | return c 363 | 364 | -- ** Text inputs 365 | data UIEntry = UIEntry { uiEntryReadOnly :: Bool 366 | , uiEntryText :: String 367 | } 368 | | UIPasswordEntry { uiEntryReadOnly :: Bool 369 | , uiEntryText :: String 370 | } 371 | | UISearchEntry { uiEntryReadOnly :: Bool 372 | , uiEntryText :: String 373 | } 374 | 375 | mkEntry mk entry = do 376 | e <- mk 377 | c_uiEntrySetText e =<< newCString (uiEntryText entry) 378 | c_uiEntrySetReadOnly e (if uiEntryReadOnly entry then 1 else 0) 379 | return e 380 | 381 | instance {-# OVERLAPS #-} ToCUIControlIO' UIEntry CUIEntry where 382 | toCUIIO e@UIEntry{} = mkEntry c_uiNewEntry e 383 | toCUIIO e@UIPasswordEntry{} = mkEntry c_uiNewPasswordEntry e 384 | toCUIIO e@UISearchEntry{} = mkEntry c_uiNewSearchEntry e 385 | 386 | -- ** Labels 387 | data UILabel = UILabel { uiLabelText :: String 388 | } 389 | 390 | instance Default UILabel where 391 | def = UILabel { uiLabelText = "" 392 | } 393 | 394 | instance {-# OVERLAPS #-} ToCUIControlIO' UILabel CUILabel where 395 | toCUIIO UILabel{..} = 396 | c_uiNewLabel =<< newCString uiLabelText 397 | 398 | -- ** Text Forms 399 | data UIForm = forall c. UIForm [(String, UI c)] 400 | 401 | instance {-# OVERLAPS #-} ToCUIControlIO' UIForm CUIForm where 402 | toCUIIO (UIForm cs) = do 403 | f <- c_uiNewForm 404 | c_uiFormSetPadded f 10 405 | forM_ cs $ \(n, c) -> do 406 | n' <- newCString n 407 | (_, [c']) <- runUI c 408 | c_uiFormAppend f n' c' 1 409 | return f 410 | 411 | -- ** Tabs 412 | data UITab c = 413 | UITab { uiTabMargin :: Int 414 | , uiTabChildren :: [(String, c)] 415 | } 416 | 417 | instance {-# OVERLAPS #-} ToCUIControlIO' c CUIControl => ToCUIControlIO' (UITab c) CUITabs where 418 | toCUIIO UITab{..} = do 419 | t <- c_uiNewTab 420 | forM_ uiTabChildren $ \(n, c) -> do 421 | print n 422 | n' <- newCString n 423 | c' <- toCUIIO c :: IO CUIControl 424 | c_uiTabAppend t n' c' 425 | -- c_uiTabSetMargined t (fromIntegral uiTabMargin) 0 426 | return t 427 | 428 | -- ** Groups 429 | data UIGroup c = 430 | UIGroup { uiGroupTitle :: String 431 | , uiGroupMargin :: Int 432 | , uiGroupChild :: c 433 | } 434 | 435 | instance {-# OVERLAPS #-} ToCUIControlIO' (UI ()) CUIBox where 436 | toCUIIO :: UI () -> IO CUIBox 437 | toCUIIO ui = do 438 | (_, c) <- runUI ui 439 | toCUIIO c 440 | 441 | instance {-# OVERLAPS #-} ToCUIControlIO' (UI ()) CUIControl where 442 | toCUIIO :: UI () -> IO CUIControl 443 | toCUIIO ui = do 444 | cbox <- toCUIIO ui :: IO CUIBox 445 | return (toCUIControl cbox) 446 | 447 | instance {-# OVERLAPS #-} ToCUIControlIO' c CUIControl => ToCUIControlIO' (UIGroup c) CUIGroup where 448 | toCUIIO UIGroup{..} = do 449 | g <- c_uiNewGroup =<< newCString uiGroupTitle 450 | c_uiGroupSetMargined g (fromIntegral uiGroupMargin) 451 | child <- toCUIIO uiGroupChild :: IO CUIControl 452 | c_uiGroupSetChild g child 453 | return g 454 | 455 | -- ** Sliders 456 | data UISpinbox = UISpinbox { uiSpinboxValue :: Int 457 | , uiSpinboxMin :: Int 458 | , uiSpinboxMax :: Int 459 | } 460 | 461 | instance {-# OVERLAPS #-} ToCUIControlIO' UISpinbox CUISpinbox where 462 | toCUIIO UISpinbox{..} = do 463 | sb <- c_uiNewSpinbox (fromIntegral uiSpinboxMin) (fromIntegral uiSpinboxMax) 464 | c_uiSpinboxSetValue sb (fromIntegral uiSpinboxValue) 465 | -- c_uiProgressBarSetValue pb (fromIntegral uiProgressBarValue) 466 | return sb 467 | 468 | data UISlider = UISlider { uiSliderValue :: Int 469 | , uiSliderMin :: Int 470 | , uiSliderMax :: Int 471 | } 472 | 473 | instance {-# OVERLAPS #-} ToCUIControlIO' UISlider CUISlider where 474 | toCUIIO UISlider{..} = do 475 | s <- c_uiNewSlider (fromIntegral uiSliderMin) (fromIntegral uiSliderMax) 476 | c_uiSliderSetValue s (fromIntegral uiSliderValue) 477 | return s 478 | 479 | data UIProgressBar = UIProgressBar { uiProgressBarValue :: Int 480 | } 481 | 482 | instance ToCUIControlIO' UIProgressBar CUIProgressBar where 483 | toCUIIO UIProgressBar{..} = do 484 | pb <- c_uiNewProgressBar 485 | c_uiProgressBarSetValue pb (fromIntegral uiProgressBarValue) 486 | return pb 487 | 488 | -- ** Separators 489 | data UISeparator = UIHorizontalSeparator 490 | | UIVerticalSeparator 491 | 492 | instance {-# OVERLAPS #-} ToCUIControlIO' UISeparator CUISeparator where 493 | toCUIIO UIHorizontalSeparator = c_uiNewHorizontalSeparator 494 | toCUIIO UIVerticalSeparator = c_uiNewVerticalSeparator 495 | 496 | -- ** Selects 497 | data UICombobox = UICombobox { uiComboboxSelected :: Bool 498 | } 499 | 500 | instance {-# OVERLAPS #-} ToCUIControlIO' UICombobox CUICombobox where 501 | toCUIIO UICombobox{..} = do 502 | cb <- c_uiNewCombobox 503 | c_uiComboboxSetSelected cb (if uiComboboxSelected then 1 else 0) 504 | return cb 505 | 506 | data UIEditableCombobox = UIEditableCombobox { uiEditableComboboxText :: String 507 | } 508 | 509 | instance {-# OVERLAPS #-} ToCUIControlIO' UIEditableCombobox CUIEditableCombobox where 510 | toCUIIO UIEditableCombobox{..} = do 511 | cb <- c_uiNewEditableCombobox 512 | c_uiEditableComboboxSetText cb =<< newCString uiEditableComboboxText 513 | return cb 514 | 515 | data UIRadioButtons = UIRadioButtons { uiRadioButtonsSelected :: Int 516 | } 517 | 518 | instance {-# OVERLAPS #-} ToCUIControlIO' UIRadioButtons CUIRadioButtons where 519 | toCUIIO UIRadioButtons{..} = 520 | c_uiNewRadioButtons 521 | 522 | -- ** Textarea 523 | data UIMultilineEntry = UIMultilineEntry { uiMultilineEntryText :: String 524 | , uiMultilineEntryReadOnly :: Bool 525 | } 526 | 527 | instance {-# OVERLAPS #-} ToCUIControlIO' UIMultilineEntry CUIMultilineEntry where 528 | toCUIIO UIMultilineEntry{..} = 529 | c_uiNewMultilineEntry 530 | 531 | -- ** Menus 532 | 533 | -- | 534 | -- The application menu. Either a window menu, as in Windows/Linux or the top 535 | -- bar menu in OSX. 536 | -- 537 | -- Renders with `uiMenu` 'c_uiNewMenu', using 'CUIMenu' 538 | data UIMenu = UIMenu { uiMenuName :: String 539 | , uiMenuItems :: [UIMenuItem] 540 | } 541 | 542 | instance {-# OVERLAPS #-} ToCUIControlIO' UIMenu CUIMenu where 543 | toCUIIO UIMenu{..} = do 544 | m <- c_uiNewMenu =<< newCString uiMenuName 545 | forM_ uiMenuItems $ \item -> 546 | appendMenuItem m item 547 | return m 548 | 549 | -- | 550 | -- Appends a menu item to a CUIMenu 551 | appendMenuItem :: CUIMenu -> UIMenuItem -> IO CUIMenuItem 552 | appendMenuItem m UIMenuItem{..} = do 553 | ctext <- newCString uiMenuItemText 554 | c_uiMenuAppendItem m ctext 555 | appendMenuItem m UIMenuItemQuit = 556 | c_uiMenuAppendQuitItem m 557 | 558 | -- | 559 | -- Menu items 560 | data UIMenuItem = UIMenuItem { uiMenuItemEnabled :: Bool 561 | , uiMenuItemChecked :: Bool 562 | , uiMenuItemText :: String 563 | } 564 | | UIMenuItemQuit 565 | 566 | instance IsString UIMenuItem where 567 | fromString s = UIMenuItem { uiMenuItemEnabled = True 568 | , uiMenuItemChecked = True 569 | , uiMenuItemText = s 570 | } 571 | 572 | -------------------------------------------------------------------------------- /src/System/Info/Class.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | module System.Info.Class 5 | where 6 | 7 | import Language.Haskell.TH 8 | import System.Info.Class.TH 9 | 10 | $(makeOS) 11 | 12 | fn :: TargetOS MacOS => IO () 13 | fn = undefined 14 | -------------------------------------------------------------------------------- /src/System/Info/Class/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module System.Info.Class.TH where 4 | 5 | import Language.Haskell.TH 6 | import System.Info 7 | 8 | -- | An empty class that defines which OS we're targetting 9 | -- 10 | -- @ 11 | -- fn :: TargetOS MacOS => IO () 12 | -- fn = osxSpecificFunctionality 13 | -- @ 14 | class TargetOS a where 15 | 16 | data MacOS 17 | data Linux 18 | data Windows 19 | 20 | makeOS :: Q [Dec] 21 | makeOS = case os of 22 | "darwin" -> [d| instance TargetOS MacOS where |] 23 | "linux" -> [d| instance TargetOS Linux where |] 24 | "mingw32" -> [d| instance TargetOS Windows where |] 25 | _ -> return [] 26 | -------------------------------------------------------------------------------- /src/System/Vagrant.hs: -------------------------------------------------------------------------------- 1 | module System.Vagrant where 2 | 3 | import System.Environment 4 | import System.Process 5 | 6 | vagrantUp :: FilePath -> IO String 7 | vagrantUp fp = do 8 | l <- getEnvironment 9 | let l' = filter ((/= "VAGRANT_VAGRANTFILE") . fst) l 10 | readCreateProcess 11 | ((shell "vagrant up") { env = Just (("VAGRANT_VAGRANTFILE", fp):l') 12 | }) 13 | "" 14 | -------------------------------------------------------------------------------- /src/common: -------------------------------------------------------------------------------- 1 | ../vendor/libui/common/ -------------------------------------------------------------------------------- /src/darwin: -------------------------------------------------------------------------------- 1 | ../vendor/libui/darwin/ -------------------------------------------------------------------------------- /src/ui.h: -------------------------------------------------------------------------------- 1 | ../vendor/libui/ui.h -------------------------------------------------------------------------------- /src/ui_darwin.h: -------------------------------------------------------------------------------- 1 | ../vendor/libui/ui_darwin.h -------------------------------------------------------------------------------- /src/ui_unix.h: -------------------------------------------------------------------------------- 1 | ../vendor/libui/ui_unix.h -------------------------------------------------------------------------------- /src/ui_windows.h: -------------------------------------------------------------------------------- 1 | ../vendor/libui/ui_windows.h -------------------------------------------------------------------------------- /src/uitable.h: -------------------------------------------------------------------------------- 1 | ../vendor/libui/uitable.h -------------------------------------------------------------------------------- /src/unix: -------------------------------------------------------------------------------- 1 | ../vendor/libui/unix/ -------------------------------------------------------------------------------- /src/windows: -------------------------------------------------------------------------------- 1 | ../vendor/libui/windows/ -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | extra-package-dbs: [] 3 | packages: 4 | - '.' 5 | - location: ./vendor/haskell-ascii-progress 6 | extra-dep: true 7 | extra-deps: 8 | - c-storable-deriving-0.1.3 9 | - pqueue-1.3.1.1 10 | - reactive-banana-1.1.0.1 11 | resolver: lts-6.7 12 | -------------------------------------------------------------------------------- /stuff.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | import Control.Monad.Reader 4 | import Control.Monad.Writer 5 | import Control.Monad.State 6 | 7 | type Stack = [Int] 8 | type Output = [Int] 9 | type Program = [Instr] 10 | 11 | type VM a = ReaderT Program (WriterT Output (State Stack)) a 12 | 13 | newtype Comp a = Comp { unComp :: VM a } 14 | deriving (Functor, Applicative, Monad, MonadReader Program, MonadWriter Output, MonadState Stack) 15 | 16 | data Instr = Push Int | Pop | Puts 17 | 18 | evalInstr :: Instr -> Comp () 19 | evalInstr instr = case instr of 20 | Pop -> modify tail 21 | Push n -> modify (n:) 22 | Puts -> do 23 | tos <- gets head 24 | tell [tos] 25 | 26 | eval :: Comp () 27 | eval = do 28 | instr <- ask 29 | case instr of 30 | [] -> return () 31 | (i:is) -> evalInstr i >> local (const is) eval 32 | 33 | execVM :: Program -> Output 34 | execVM = flip evalState [] . execWriterT . runReaderT (unComp eval) 35 | 36 | program :: Program 37 | program = [ 38 | Push 42, 39 | Push 27, 40 | Puts, 41 | Pop, 42 | Puts, 43 | Pop 44 | ] 45 | 46 | main :: IO () 47 | main = mapM_ print $ execVM program 48 | -------------------------------------------------------------------------------- /test/SanitySpec.hs: -------------------------------------------------------------------------------- 1 | module SanitySpec where 2 | 3 | import Test.Hspec 4 | 5 | spec = describe "when I have tests" $ 6 | it "I have sanity" $ True `shouldBe` True 7 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} --------------------------------------------------------------------------------