├── .github └── workflows │ └── unit-tests.yml ├── .gitignore ├── .tidyrc.json ├── CHANGELOG.md ├── LICENSE ├── README.md ├── atdiff.diff ├── babel.config.js ├── codegen ├── spago.yaml └── src │ ├── Comment.purs │ ├── DOM │ ├── Common.purs │ ├── IDL.purs │ ├── Indexed.purs │ ├── Indexed │ │ ├── Attribute.purs │ │ ├── Element.purs │ │ ├── Listener.purs │ │ └── Self.purs │ ├── Parse.purs │ ├── Spec.purs │ └── TypeStub.purs │ ├── FS.purs │ └── Main.purs ├── deku-core ├── spago.yaml └── src │ └── Deku │ ├── Attribute.purs │ ├── Control.purs │ ├── Core.purs │ ├── Do.purs │ ├── Effect.purs │ ├── Hooks.purs │ ├── Internal │ ├── Ancestry.purs │ ├── Entities.purs │ └── Region.purs │ ├── Pursx.js │ ├── Pursx.purs │ ├── PursxParser.purs │ ├── PxTypes.purs │ ├── UnsafeDOM.js │ └── UnsafeDOM.purs ├── deku-css ├── spago.yaml └── src │ └── Deku │ └── CSS.purs ├── deku-dom ├── spago.yaml └── src │ └── Deku │ ├── DOM.purs │ ├── DOM │ ├── Attributes.purs │ ├── Combinators.purs │ ├── Listeners.purs │ ├── MathML.purs │ ├── MathML │ │ └── Attributes.purs │ ├── SVG.purs │ ├── SVG │ │ ├── Attributes.purs │ │ └── Listeners.purs │ └── Self.purs │ ├── DOMInterpret.js │ └── DOMInterpret.purs ├── deku-spa ├── spago.yaml └── src │ └── Deku │ ├── SPA.purs │ └── SPAInterpret.purs ├── deku-ssr ├── spago.yaml └── src │ └── Deku │ ├── HydratingInterpret.purs │ ├── SSR.js │ ├── SSR.purs │ ├── SSR │ └── Optimize.purs │ └── SSRInterpret.purs ├── deku-test ├── spago.yaml └── test │ └── Test │ ├── Main.js │ ├── Main.purs │ └── TestFriend.purs ├── deku.gif ├── index.test.js ├── jest.config.js ├── package-lock.json ├── package.json ├── spago.lock └── spago.yaml /.github/workflows/unit-tests.yml: -------------------------------------------------------------------------------- 1 | name: Unit test 2 | on: push 3 | jobs: 4 | container-job: 5 | runs-on: ubuntu-latest 6 | strategy: 7 | matrix: 8 | node-version: [18.x] 9 | steps: 10 | - name: Check out repository code 11 | uses: actions/checkout@v4 12 | - name: Cache dependencies 13 | uses: actions/cache@v4 14 | with: 15 | path: | 16 | ~/.npm 17 | .spago 18 | ${{ env.spago_global_cache }} 19 | output 20 | key: >- 21 | ${{ hashFiles('package-lock.json') }}- 22 | ${{ hashFiles('spago.yaml') }} 23 | - name: Install purescript 24 | run: npm i -g purescript@0.15.15 25 | - name: Install 26 | run: npm i 27 | - name: Test 28 | run: npm t 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /output-es/ 6 | /generated-docs/ 7 | /.psc-package/ 8 | /.psc* 9 | /.purs* 10 | /.psa* 11 | /.spago 12 | /output-es/ 13 | packages.json 14 | .venv 15 | /test-results/ 16 | /test/test.js 17 | /test/.spago 18 | /test/output/ 19 | __pycache__ 20 | .vscode 21 | codegen/cache 22 | .spec-results -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importSort": "source", 3 | "importWrap": "source", 4 | "indent": 2, 5 | "operatorsFile": null, 6 | "ribbon": 1, 7 | "typeArrowPlacement": "first", 8 | "unicode": "source", 9 | "width": 80 10 | } 11 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | All notable changes to this project will be documented in this file. 4 | 5 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 6 | and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 7 | 8 | ## [0.9.13] - 2023-02-208 9 | 10 | - Uses `merge` instead of `oneOf`. 11 | - Adds `toDeku`. 12 | - Adds `useRef`. 13 | 14 | ## [0.9.9 - 0.9.12] - 2023-02-15 15 | 16 | - Version bumps to get documentation generated. 17 | 18 | ## [0.9.8] - 2022-12-07 19 | 20 | - Cleaner SSR primitives. 21 | 22 | 23 | ## [0.9.7] - 2022-12-07 24 | 25 | - Makes `runST` polymorphic over `r`. 26 | 27 | 28 | ## [0.9.6] - 2022-12-01 29 | 30 | - Adds `NutWith`. 31 | - Changes signature of `useMemoized`. 32 | - Splits `onMount` into `onWillMount` and `onDidMount`. 33 | 34 | ## [0.9.5] - 2022-11-28 35 | 36 | - Adds `guard`. 37 | - Adds `useHot'`. 38 | 39 | ## [0.9.4] - 2022-11-28 40 | 41 | - Adds inflix aliases for `switcher` and `switcherFlipped`. 42 | - Exports new DOM constructors for easier access. 43 | 44 | ## [0.9.3] - 2022-11-27 45 | 46 | - Adds one-off version of most listeners. 47 | 48 | ## [0.9.2] - 2022-11-27 49 | 50 | - Adds `CSS.render` for interop with `purescript-css`. 51 | 52 | ## [0.9.1] - 2022-11-27 53 | 54 | - Adds double-underscore methods. 55 | 56 | ## [0.9.0] - 2022-11-27 57 | 58 | - Adds lifecycle methods `onMount`, `onDismount`, and `bracket`. 59 | 60 | ## [0.8.7] - 2022-11-20 61 | 62 | - Adds `useHot`. 63 | 64 | ## [0.8.6] - 2022-11-06 65 | 66 | - Adds svg. 67 | 68 | ## [0.8.5] - 2022-11-04 69 | 70 | - Removes spurious applicative constraints. 71 | 72 | ## [0.8.4] - 2022-11-03 73 | 74 | - Adds `unsafeCustomElement` for unsafe custom elements. 75 | 76 | ## [0.8.3] - 2022-11-02 77 | 78 | - Removes `nut` from PursX. 79 | 80 | ## [0.8.2] - 2022-10-31 81 | 82 | - Adds `useDyn` hooks. 83 | 84 | ## [0.8.1] - 2022-10-30 85 | 86 | - Uses optimized lemming functions from `hyrule` when appropriate. 87 | 88 | ## [0.8.0] - 2022-09-22 89 | 90 | - `Nut` is a monoid! 91 | 92 | ## [0.7.0] - 2022-09-10 93 | 94 | - Simplifies signatures 95 | 96 | ## [0.6.0] - 2022-08-22 97 | 98 | - Uses the Zora monad. 99 | 100 | ## [0.5.0] - 2022-08-15 101 | 102 | - Makes the API more composition-friendly. 103 | 104 | 105 | ## [0.4.13] - 2022-06-20 106 | 107 | - Removes spurious warning. 108 | 109 | ## [0.4.12] - 2022-06-16 110 | 111 | - Fixes SSR bug. 112 | 113 | ## [0.4.10] - 2022-06-15 114 | 115 | - Uses comments for better SSR. 116 | 117 | ## [0.4.9] - 2022-06-11 118 | 119 | - Uses better string replacement in SSR 120 | 121 | ## [0.4.8] - 2022-06-06 122 | 123 | - Updates to new bolson 124 | 125 | ## [0.4.7] - 2022-06-05 126 | 127 | - Adds newtype for Nut. 128 | 129 | ## [0.4.6] - 2022-06-01 130 | 131 | - Updates to new Bolson. 132 | 133 | ## [0.4.5] - 2022-05-26 134 | 135 | - Better SSR support and attribute rendering. 136 | 137 | ## [0.4.4] - 2022-05-20 138 | 139 | - Less spurious warnings. 140 | 141 | ## [0.4.3] - 2022-05-19 142 | 143 | - Cleaner type synonyms. 144 | 145 | 146 | ## [0.4.2] - 2022-05-16 147 | 148 | - Updates Bolson. 149 | 150 | ## [0.4.1] - 2022-05-12 151 | 152 | - Uses Bolson for core logic. 153 | 154 | ## [0.4.0] - 2022-05-10 155 | 156 | - Adds server-side rendering, or SSaRrrrr, as the pirates would say. 157 | 158 | ## [0.3.8] - 2022-05-04 159 | 160 | - Adds helper functions for `click` and `slider`. 161 | 162 | ## [0.3.7] - 2022-05-03 163 | 164 | - Allows accessing of elements via `self`. 165 | 166 | ## [0.3.6] - 2022-04-30 167 | 168 | - Updates to `0.15.0`. 169 | 170 | ## [0.3.5] - 2022-04-23 171 | 172 | - More instances for attribute creation. 173 | 174 | ## [0.3.4] - 2022-04-23 175 | 176 | - More efficient cache pruning. 177 | 178 | ## [0.3.3] - 2022-04-23 179 | 180 | - Improves portal implementation. 181 | 182 | ## [0.3.2] - 2022-04-23 183 | 184 | - Fixes portal bug. 185 | 186 | ## [0.3.1] - 2022-04-23 187 | 188 | - Internal optimizations for faster event rendering. 189 | 190 | ## [0.3.0] - 2022-04-23 191 | 192 | - Gets rid of subgraphs and greatly simplifies code base. 193 | 194 | ## [0.2.6] - 2022-04-18 195 | 196 | - Adds hack for working with a 2D canvas. 197 | 198 | ## [0.2.5] - 2022-04-17 199 | 200 | - Splits files for faster compilation. 201 | 202 | ## [0.2.4] - 2022-04-14 203 | 204 | - Fixes recursive pursx bug. 205 | 206 | ## [0.2.3] - 2022-04-14 207 | 208 | - Gets rid of subgraph env, opting to use index for initialization. 209 | 210 | ## [0.2.2] - 2022-04-11 211 | 212 | - Updates event and poll libraries. 213 | 214 | ## [0.2.1] - 2022-04-08 215 | 216 | - Reverts experiment 217 | 218 | ## [0.2.0] - 2022-04-07 219 | 220 | - A failed experiment in creating phantom types around events. Conceptually, this makes no sense. An event should only be gated with a phantom type if it is somehow tightly coupled to the context in which it is executing. Otherwise, each subscription is separate, so there can be as many as you like. If subscriptions cause some sort of saturation, then you'll want to limit the number of events (for example by creating a hot `requestAnimationFrame` at the toplevel rather than several cold ones). 221 | 222 | ## [0.1.3] - 2022-04-07 223 | 224 | ### Removed 225 | 226 | - Spurious parammeter in the `SubgraphF` type. 227 | 228 | ## [0.1.2] - 2022-04-06 229 | 230 | ### Added 231 | 232 | - Uses existential types for subgraph construction, which makes it easier to have subgraphs with different pushers. 233 | 234 | ## [0.1.1] - 2022-04-05 235 | 236 | ### Chore 237 | 238 | - Fix `Left` bug in interpret 239 | 240 | ## [0.1.0] - 2022-03-30 241 | 242 | ### Breaking change alert! 243 | 244 | Changes to a different model that uses less typelevel programming and a more SDOM-y approach, while using similar fine-grained state management to Wags. Read the docs to find out more! 245 | 246 | ## [0.0.8] - 2022-03-25 247 | 248 | ### Bugfix 249 | 250 | Interprets `checked` correctly. 251 | 252 | 253 | ## [0.0.7] - 2022-03-25 254 | 255 | ### Bugfix 256 | 257 | Adds a closure term to subgraph calculations. 258 | 259 | ## [0.0.6] - 2022-03-25 260 | 261 | ### Bugfix 262 | 263 | Fixes the sorting algorithm on insert of subgraphs. 264 | 265 | ## [0.0.5] - 2022-03-25 266 | 267 | - This exists due to a botched git-push before :-/ 268 | 269 | ## [0.0.4] - 2022-03-25 270 | 271 | ### Added 272 | 273 | - New `@@>` and `%%>` functions for scenes that do not respond to their environment. 274 | - Fixed bug when `psx` is at top-level. 275 | 276 | ## [0.0.3] - 2022-03-25 277 | 278 | ### Added 279 | 280 | - Adds whitespace to allowable attribute values. 281 | 282 | ## [0.0.2] - 2022-03-25 283 | 284 | ### Added 285 | 286 | - Comment parsing to the pursx parser. 287 | 288 | ## [0.0.1] - 2022-03-24 289 | 290 | ### Added 291 | 292 | - A PursX parser. 293 | 294 | ## [0.0.0] - 2022-03-23 295 | 296 | ### Added 297 | 298 | - Exposes the DOM API via a FRP Poll by using induction on existentially-quantified and linearly-typed indexed cofree comonads that act as kan-extended natural transformations over embedded universal morphisms. 299 | - A README. 300 | - A CHANGELOG. 301 | - Several tests. 302 | - Several examples. 303 | - Documentation. 304 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-deku 2 | 3 | ![deku](./deku.gif) 4 | 5 | A PureScript web framework for apps that need to be fast. 6 | 7 | ## In anger 8 | 9 | - [Verity Scheel's snowflow](https://snowflow.surge.sh/) is snowflake-themed work of web-art. 10 | - [Verity Scheel's post on parsing](https://cofree.coffee/~verity/parser.html) implements a full-featured tweening engine to animate rule-based parsing steps. 11 | - [Horizontal and Vertical Events](https://dev.to/mikesol/horizontal-and-vertical-events-1pm1) is an article that explores some concepts central to Deku with many tryable & editable examples. 12 | 13 | ## Documentation 14 | 15 | [Here is a guide](https://deku-documentation.vercel.app/) to building apps with Deku. The guide is written in Deku and its source code can be found [here](https://github.com/mikesol/deku-documentation). **You should probably start your Deku journey with this guide.** It contains everything you need to build a Deku app, from bootstrapping a project to `Hello World` to a Discord clone! 16 | 17 | Indexed documentation for Deku is published on [Pursuit](https://pursuit.purescript.org/packages/purescript-deku). Deku's structure is currently highly decentralized, so it can be tough to know where to look. Here's a small Deku app that acts as a legend for the Pursuit docs. 18 | 19 | ```purescript 20 | 21 | main :: Effect Unit 22 | main = 23 | -- `Deku.Toplevel` contains runInBody 24 | -- and other functions for hydration and SSR 25 | runInBody myNut 26 | where 27 | -- `Deku.Core` contains the `Nut` type, which is the type 28 | -- of all Deku applications. 29 | myNut :: Nut 30 | myNut = 31 | -- `Deku.Do`` is the rebindable do context that allows you 32 | -- to use hooks in Deku 33 | Deku.do 34 | -- `Deku.Hooks` contains hooks like `useState`, 35 | -- `useDyn`, and `useMemoized` 36 | setCounter /\ counter <- useState 0 37 | -- `Deku.DOM`, often imported as `D`, contains all DOM elements, 38 | -- attributes, and event handlers 39 | D.div 40 | [ 41 | -- `Deku.Listeners` contains helper functions for various common 42 | -- listeners like `click` and `keyUp` 43 | click $ counter <#> add 1 >>> setCounter 44 | -- `Deku.Attributes` contains helper functions for various common 45 | -- attributes like `style` and `klass` (an alias for `class`) 46 | , klass_ "color: crimson;" 47 | -- `Deku.CSS` contains `render`, which allows you to take `CSS` from 48 | -- `purescript-css` and use it in a Deku application 49 | , style_ $ render do 50 | color (rgb 42 142 242) 51 | fontWeight bold 52 | -- `Deku.Attribute` contains constructors for 53 | -- uncommon and ad hoc `x-` attributes 54 | , pure (xdata "my-attr" "my-val") 55 | ] 56 | [ 57 | -- `Deku.Control` contains all non-element buiding blocks 58 | -- for applications, including `text` and `<#~>`, which 59 | -- allows you to switch between elements. 60 | text (show <$> counter) 61 | -- `Deku.Pursx` contains the `~~` operator, which allows you to 62 | -- construct typesafe Deku using plain old html. 63 | , (Proxy :: _ "

Now you're a Deku ~adj~

") ~~ 64 | { adj: text 65 | (counter <#> mod 2 >>> eq 0 >>> if _ then "newb" else "master") 66 | } 67 | ] 68 | ``` 69 | 70 | So, in summary, ignore the voluminous number of modules in Deku (which makes browsing Pursuit difficult) and focus on the modules used in the example above, namely: 71 | 72 | - [`Deku.Toplevel`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Toplevel) 73 | - [`Deku.Core`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Core) 74 | - [`Deku.Do`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Do) 75 | - [`Deku.Hooks`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Hooks) 76 | - [`Deku.DOM`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.DOM) 77 | - [`Deku.Listeners`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Listeners) 78 | - [`Deku.Attributes`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Attributes) 79 | - [`Deku.CSS`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.CSS) 80 | - [`Deku.Attribute`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Attribute) 81 | - [`Deku.Control`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Control) 82 | - [`Deku.Pursx`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Pursx) 83 | 84 | 85 | There are a few more modules to be aware of for advanced usage: 86 | 87 | - [`Deku.Lifecycle`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Lifecycle) contains methods for arbitrary side effects to run when the Deku Nuts mount and dismount from the DOM. 88 | - [`Deku.Pursx.Anonymous`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Pursx.Anonymous) contains an experimental `pursx` syntax that could theoretically be made better by Visible Type Applications. As that feature develops, if the syntax becomes ergonomic, it may supersede the current `pursx` syntax. 89 | - [`Deku.Interpret`](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Interpret) is for folks that wish to build a custom Deku backend. Deku currently supports Single-page applications (the default), static site rendering, and hydrated static site rendering. 90 | 91 | Deku is a small codebase. All of the heavy lifting is done via primitives from [`purescript-hyrule`](https://github.com/mikesol/purescript-hyrule), the documentation of which is also on [Pursuit](https://pursuit.purescript.org/packages/purescript-hyrule). 92 | 93 | ## Why another web framework? 94 | 95 | Deku aims to be: 96 | 97 | - **fast**: it's up to 2x faster than Halogen for a simple Todo MVC app. 98 | - **small**: the average Deku program tends to be fewer lines of code than its React or Halogen counterparts. 99 | - **ssr-friendly**: Deku has out-of-the-box server-side rendering capabilities. 100 | 101 | ## What does Deku mean? 102 | 103 | Deku is short for "DOMs Emitted as Kan-extended Universals." It is also the tree of Zelda lore and is a Japanese diminutive for a dullard or simpleton. 104 | -------------------------------------------------------------------------------- /atdiff.diff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikesol/purescript-deku/4d18f6ccebb4a59cdd2a6d2d9e2466349bf8df20/atdiff.diff -------------------------------------------------------------------------------- /babel.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | presets: [['@babel/preset-env', { targets: { node: 'current' } }]], 3 | }; -------------------------------------------------------------------------------- /codegen/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: codegen 3 | dependencies: 4 | - effect 5 | - aff 6 | - bifunctors 7 | - newtype 8 | - safe-coerce 9 | - tuples 10 | - foreign-object 11 | - tuples 12 | - fetch 13 | - argonaut-core 14 | - argonaut-codecs 15 | - console 16 | - tidy-codegen 17 | - node-buffer 18 | - node-fs 19 | - node-path 20 | - language-cst-parser 21 | - argonaut-core 22 | - argonaut-generic 23 | - either 24 | - variant 25 | - foldable-traversable 26 | - maybe 27 | - partial 28 | - prelude 29 | - transformers 30 | - ordered-collections 31 | - arrays 32 | - strings -------------------------------------------------------------------------------- /codegen/src/Comment.purs: -------------------------------------------------------------------------------- 1 | -- | Enables commenting blocks of code. 2 | module Comment where 3 | 4 | import Prelude 5 | 6 | import PureScript.CST.Types (Comment(..), Declaration(..), Expr(..), Labeled(..), LineFeed(..), Module(..), ModuleHeader(..), Name(..), SourceToken) 7 | 8 | documentModule :: forall e. Array String -> Module e -> Module e 9 | documentModule txt (Module mod@{ header: ModuleHeader header }) = 10 | Module mod 11 | { header = ModuleHeader header 12 | { keyword = commentToken comment header.keyword } 13 | } 14 | 15 | where 16 | 17 | comment = mkBlockDoc txt 18 | 19 | commentModule :: forall e. Array String -> Module e -> Module e 20 | commentModule txt (Module mod@{ header: ModuleHeader header }) = 21 | Module mod 22 | { header = ModuleHeader header 23 | { keyword = commentToken comment header.keyword } 24 | } 25 | 26 | where 27 | 28 | comment = mkBlockComment txt 29 | 30 | inlineComment :: forall e. String -> Expr e -> Expr e 31 | inlineComment txt = case _ of 32 | ExprString tok v -> 33 | ExprString (commentToken comment tok) v 34 | 35 | id -> 36 | id 37 | 38 | where 39 | 40 | comment = mkInlineComment txt 41 | 42 | documentDecl :: forall e. Array String -> Declaration e -> Declaration e 43 | documentDecl txt = case _ of 44 | DeclData head vs -> 45 | DeclData head { keyword = commentToken comment head.keyword } vs 46 | 47 | DeclSignature (Labeled labeled) -> 48 | DeclSignature $ Labeled labeled 49 | { label = commentName comment labeled.label } 50 | 51 | id -> 52 | id 53 | 54 | where 55 | 56 | comment = mkBlockDoc txt 57 | 58 | commentName :: forall a. Array (Comment LineFeed) -> Name a -> Name a 59 | commentName cs (Name name) = Name name { token = commentToken cs name.token } 60 | 61 | commentToken :: Array (Comment LineFeed) -> SourceToken -> SourceToken 62 | commentToken comments tok@{ leadingComments } = 63 | tok { leadingComments = leadingComments <> comments } 64 | 65 | mkBlockDoc :: Array String -> Array (Comment LineFeed) 66 | mkBlockDoc ls = 67 | bind ls \l -> [ Comment $ "-- | " <> l, Line LF 1 ] 68 | 69 | mkBlockComment :: Array String -> Array (Comment LineFeed) 70 | mkBlockComment ls = 71 | bind ls \l -> [ Comment $ "-- " <> l, Line LF 1 ] 72 | 73 | mkInlineComment :: forall l. String -> Array (Comment l) 74 | mkInlineComment = 75 | pure <<< Comment <<< flip append " -}" <<< append "{- " -------------------------------------------------------------------------------- /codegen/src/DOM/Common.purs: -------------------------------------------------------------------------------- 1 | module DOM.Common where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import DOM.TypeStub (TypeStub(..)) 7 | 8 | import Data.Foldable (foldl) 9 | import Data.Maybe (Maybe(..)) 10 | import Data.Newtype (class Newtype, un) 11 | import Data.Set (Set) 12 | import Data.Set as Set 13 | import Data.String (codePointFromChar) 14 | import Data.String as String 15 | import Data.String.CodeUnits as CU 16 | import Data.Tuple.Nested (type (/\), (/\)) 17 | import Partial.Unsafe (unsafePartial) 18 | import PureScript.CST.Types (Declaration, Expr, Ident(..), Label, Proper(..), Type) 19 | import Safe.Coerce (coerce) 20 | import Tidy.Codegen (declValue, exprApp, exprIdent, exprOp, typeApp, typeCtor, typeRow, typeVar) 21 | import Tidy.Codegen.Class (class ToName, class ToQualifiedName, defaultToName, toName, toQualifiedName) 22 | import Tidy.Codegen.Types (BinaryOp, Qualified(..)) 23 | 24 | newtype Ctor = Ctor String 25 | 26 | derive newtype instance Eq Ctor 27 | derive newtype instance Ord Ctor 28 | derive instance Newtype Ctor _ 29 | instance ToQualifiedName Ctor Proper where 30 | toQualifiedName = toQualifiedName <<< Qualified Nothing <<< Proper <<< un Ctor 31 | 32 | instance ToName Ctor Label where 33 | toName = defaultToName <<< un Ctor 34 | 35 | instance ToName Ctor Proper where 36 | toName = toName <<< Proper <<< un Ctor 37 | 38 | instance ToName Ctor Ident where 39 | toName = toName <<< Ident <<< un Ctor 40 | 41 | type Interface = 42 | { ctor :: Ctor 43 | , name :: String 44 | , bases :: Array Ctor 45 | , members :: Array (Ctor /\ TypeStub) 46 | } 47 | 48 | type Element = 49 | { ctor :: Ctor -- name in source 50 | , ns :: TagNS 51 | , tag :: String 52 | , interface :: Ctor 53 | } 54 | 55 | type Event = 56 | { name :: String 57 | , index :: Ctor 58 | , type :: TypeStub 59 | } 60 | 61 | type Attribute = 62 | { name :: String -- name in document 63 | , index :: Ctor -- name in source and row index 64 | , type :: TypeStub -- type of this attribute 65 | , keywords :: Array Keyword -- valid values for this attribute 66 | } 67 | 68 | type Keyword = 69 | { original :: String 70 | , name :: String 71 | } 72 | 73 | data TagNS = HTML | SVG | MathML 74 | 75 | derive instance Eq TagNS 76 | derive instance Ord TagNS 77 | 78 | xhtmlNamespace :: TagNS -> Maybe String 79 | xhtmlNamespace = case _ of 80 | HTML -> 81 | Nothing 82 | 83 | SVG -> 84 | Just "http://www.w3.org/2000/svg" 85 | 86 | MathML -> 87 | Just "http://www.w3.org/1998/Math/MathML" 88 | 89 | -- | Creates a valid attribute definition. Invalid definitions get converted to `Nothing`. 90 | mkAttribute :: Array String -> String -> Maybe Attribute 91 | mkAttribute keywords name = 92 | Just 93 | { name 94 | , index: Ctor $ unSnake $ escape name 95 | , type: TypeString 96 | , keywords: flip map keywords case _ of 97 | "I" -> 98 | { original: "I", name: "UpperI" } 99 | 100 | "i" -> 101 | { original: "i", name: "LowerI" } 102 | 103 | "A" -> 104 | { original: "A", name: "UpperA" } 105 | 106 | "a" -> 107 | { original: "a", name: "LowerA" } 108 | 109 | original -> 110 | { original, name: capitalize $ unSnake original } 111 | 112 | } 113 | 114 | -- | Creates a valid event definition. Invalid definitions get converted to `Nothing`. 115 | mkHandler :: String -> String -> Maybe Event 116 | -- blur and focus have been defined multiple times, once in html.json and once in uievents.json, the one we care about 117 | -- has type "FocusEvent" 118 | mkHandler "Event" "blur" = Nothing 119 | mkHandler "Event" "focus" = Nothing 120 | mkHandler type_ name = case String.stripPrefix (String.Pattern "DOM") name of 121 | Just mutEvent -> 122 | Just 123 | { name 124 | , index: Ctor $ "dom" <> mutEvent 125 | , type: webEvents type_ 126 | } 127 | 128 | _ -> 129 | Just 130 | { name: name 131 | , index: Ctor $ unSnake name 132 | , type: webEvents type_ 133 | } 134 | 135 | -- | Creates a valid element Invalid definitions get converted to `Nothing`. 136 | mkElement :: TagNS -> String -> String -> Maybe Element 137 | mkElement ns interface name = 138 | Just 139 | { ctor: Ctor $ unSnake $ escape name 140 | , ns: ns 141 | , tag: name 142 | , interface: Ctor interface 143 | } 144 | 145 | -- | Creates a valid interface definition. Invalid definitions get converted to `Nothing`. 146 | mkInterface 147 | :: Array String -> Array (Ctor /\ TypeStub) -> String -> Maybe Interface 148 | mkInterface _ _ "LinkStyle" = Nothing -- does not seem to exist 149 | mkInterface bases members name = 150 | Just { name, ctor: Ctor name, members, bases: coerce bases } 151 | 152 | escape :: String -> String 153 | escape n = 154 | if not $ Set.member n reserved then n 155 | else case String.uncons n of 156 | -- c -> k 157 | Just { head, tail } | head == c -> 158 | String.singleton k <> tail 159 | 160 | -- else prefix with x 161 | _ -> 162 | "x" <> n 163 | 164 | where 165 | 166 | c = codePointFromChar 'c' 167 | k = codePointFromChar 'k' 168 | 169 | reserved :: Set String 170 | reserved = 171 | Set.fromFoldable 172 | [ "data" 173 | , "if" 174 | , "in" 175 | , "class" 176 | , "type" 177 | , "module" 178 | ] 179 | 180 | unSnake :: String -> String 181 | unSnake = 182 | _.acc 183 | <<< foldl 184 | ( \{ dropped, acc } c -> case dropped, c of 185 | _, '-' -> { dropped: true, acc } 186 | _, ' ' -> { dropped: true, acc } 187 | _, '/' -> { dropped: true, acc } 188 | _, ':' -> { dropped: true, acc } 189 | true, _ -> 190 | { dropped: false, acc: acc <> (String.toUpper $ CU.singleton c) } 191 | _, _ -> { dropped: false, acc: acc <> CU.singleton c } 192 | ) 193 | { dropped: false, acc: "" } 194 | <<< CU.toCharArray 195 | 196 | capitalize :: String -> String 197 | capitalize = 198 | String.splitAt 1 >>> \{ before, after } -> String.toUpper before <> after 199 | 200 | declHandler :: String -> Array (BinaryOp (Expr Void)) -> Declaration Void 201 | declHandler name ops = 202 | unsafePartial 203 | $ declValue name [] 204 | $ exprApp (exprIdent "Functor.map") [ exprHandler ops ] 205 | 206 | exprHandler :: Partial => Array (BinaryOp (Expr Void)) -> Expr Void 207 | exprHandler ops = 208 | exprOp (exprIdent "Deku.Attribute.unsafeAttribute") 209 | $ ops 210 | 211 | typeArrayed :: Type Void -> Type Void 212 | typeArrayed t = 213 | unsafePartial $ typeApp (typeCtor "Array") $ pure t 214 | 215 | typePolled :: Type Void -> Type Void 216 | typePolled t = 217 | unsafePartial $ typeApp (typeCtor "FRP.Poll.Poll") $ pure t 218 | 219 | typeFunked :: String -> Type Void -> Type Void 220 | typeFunked f t = 221 | unsafePartial $ typeApp (typeVar f) $ pure t 222 | 223 | typeAttributed :: Type Void -> Type Void 224 | typeAttributed t = 225 | unsafePartial $ typeApp (typeCtor "Deku.Attribute.Attribute") $ pure t 226 | 227 | typeNut :: Type Void 228 | typeNut = 229 | unsafePartial $ typeCtor "Nut" 230 | 231 | typeIndexedAt :: Ctor -> Type Void -> Type Void 232 | typeIndexedAt n t = 233 | unsafePartial $ typeRow [ n /\ t ] $ Just $ typeVar "r" 234 | 235 | nominal :: Ctor 236 | nominal = 237 | Ctor "__tag" 238 | 239 | selfKey :: String 240 | selfKey = 241 | "@self@" 242 | 243 | -- | Elements that have an implementation in the current web-html package. 244 | webElements :: Array TypeStub 245 | webElements = map (\intf -> TypeEvent intf ("Web.HTML." <> intf)) 246 | [ "HTMLAnchorElement" 247 | , "HTMLAreaElement" 248 | , "HTMLAudioElement" 249 | , "HTMLBRElement" 250 | , "HTMLBaseElement" 251 | , "HTMLBodyElement" 252 | , "HTMLButtonElement" 253 | , "HTMLCanvasElement" 254 | , "HTMLDivElement" 255 | , "HTMLEmbedElement" 256 | , "HTMLFormElement" 257 | , "HTMLHRElement" 258 | , "HTMLHeadElement" 259 | , "HTMLHtmlElement" 260 | , "HTMLInputElement" 261 | , "HTMLLabelElement" 262 | , "HTMLLegendElement" 263 | , "HTMLLinkElement" 264 | , "HTMLMapElement" 265 | , "HTMLMetaElement" 266 | , "HTMLMeterElement" 267 | , "HTMLObjectElement" 268 | , "HTMLOptionElement" 269 | , "HTMLOutputElement" 270 | , "HTMLParagraphElement" 271 | , "HTMLParamElement" 272 | , "HTMLPreElement" 273 | , "HTMLProgressElement" 274 | , "HTMLScriptElement" 275 | , "HTMLSelectElement" 276 | , "HTMLSourceElement" 277 | , "HTMLSpanElement" 278 | , "HTMLStyleElement" 279 | , "HTMLTableDataCellElement" 280 | , "HTMLTableElement" 281 | , "HTMLTemplateElement" 282 | , "HTMLTextAreaElement" 283 | , "HTMLTimeElement" 284 | , "HTMLTitleElement" 285 | , "HTMLTrackElement" 286 | , "HTMLVideoElement" 287 | ] 288 | 289 | -- | Looks up the name of an event interface name and returns the best fitting `TypeStub`. 290 | webEvents :: String -> TypeStub 291 | webEvents ev = case ev of 292 | "CompositionEvent" -> TypeEvent "CompositionEvent" 293 | "Web.UIEvent.CompositionEvent" 294 | "FocusEvent" -> TypeEvent "FocusEvent" "Web.UIEvent.FocusEvent" 295 | "MouseEvent" -> TypeEvent "MouseEvent" "Web.UIEvent.MouseEvent" 296 | "KeyboardEvent" -> TypeEvent "KeyboardEvent" "Web.UIEvent.KeyboardEvent" 297 | "UIEvent" -> TypeEvent "UIEvent" "Web.UIEvent.UIEvent" 298 | "DragEvent" -> TypeEvent "DragEvent" "Web.HTML.Event.DragEvent" 299 | "DragEvent" -> TypeEvent "DragEvent" "Web.HTML.Event.DragEvent" 300 | "TrackEvent" -> TypeEvent "TrackEvent" "Web.HTML.Event.TrackEvent" 301 | "PointerEvent" -> TypeEvent "PointerEvent" "Web.PointerEvent.PointerEvent" 302 | "TouchEvent" -> TypeEvent "TouchEvent" "Web.TouchEvent.TouchEvent" 303 | 304 | _ -> TypeEvent "Event" "Web.Event.Internal.Types" 305 | -------------------------------------------------------------------------------- /codegen/src/DOM/IDL.purs: -------------------------------------------------------------------------------- 1 | -- | Utilities to work with the IDL types. This can be used to implement properties instead of attributes. 2 | module DOM.IDL where 3 | 4 | import Prelude 5 | import Prim hiding (Type) 6 | 7 | import DOM.Spec (IDLType(..), Member(..), Mixin(..), Tag) 8 | import DOM.TypeStub (TypeStub(..)) 9 | import Data.Array as Array 10 | import Data.Maybe (Maybe(..), fromMaybe, maybe) 11 | import Data.Tuple.Nested (type (/\), (/\)) 12 | import Foreign.Object as Foreign 13 | 14 | validTag :: Tag -> Maybe (String /\ String) 15 | validTag { obsolete: Just true } = Nothing 16 | validTag { interface: Nothing } = Nothing 17 | validTag { interface: Just interface, name } = Just $ name /\ interface 18 | 19 | attributeMember :: Member -> Array (String /\ IDLType) 20 | attributeMember = case _ of 21 | -- only emit writeable(not readonly attributes) 22 | Attribute { idlType, name: attrName, readonly } | maybe true not readonly -> 23 | [ attrName /\ idlType ] 24 | 25 | _ -> 26 | [] 27 | 28 | -- | Looks up an interface and returns all inherited and mixed in interfaces. 29 | resolveInterface 30 | :: Foreign.Object (Array String) 31 | -> Foreign.Object (Array Mixin) 32 | -> String 33 | -> Array String 34 | resolveInterface inheritance extended name = do 35 | let 36 | extensions :: Array Mixin 37 | extensions = 38 | fromMaybe [] 39 | $ Foreign.lookup name extended 40 | 41 | bases :: Array String 42 | bases = 43 | maybe mempty identity (Foreign.lookup name inheritance) 44 | 45 | bases <> Array.mapMaybe included extensions 46 | 47 | where 48 | 49 | included = case _ of 50 | Includes { includes } -> 51 | Just includes 52 | 53 | _ -> 54 | Nothing 55 | 56 | mapType :: IDLType -> Array TypeStub 57 | mapType = case _ of 58 | Descriptor t -> mapType t.idlType 59 | 60 | Primitive "boolean" -> 61 | pure TypeBoolean 62 | 63 | Primitive "long" -> 64 | pure TypeInt 65 | 66 | Primitive "unsigned long" -> 67 | pure TypeInt 68 | 69 | Primitive "long long" -> 70 | pure TypeInt 71 | 72 | Primitive "unsigned long long" -> 73 | pure TypeInt 74 | 75 | Primitive "unsigned short" -> 76 | pure TypeInt 77 | 78 | Primitive "double" -> 79 | pure TypeNumber 80 | 81 | Primitive "unrestricted double" -> 82 | pure TypeNumber 83 | 84 | Primitive "Number" -> 85 | pure TypeNumber 86 | 87 | Primitive "SVGAnimatedNumber" -> 88 | pure TypeNumber 89 | 90 | Primitive "EventHandler" -> 91 | pure $ TypeEvent "Event" "Web.Event.Internal.Types" 92 | 93 | Primitive "any" -> 94 | pure TypeString 95 | 96 | Primitive "DOMString" -> 97 | pure TypeString 98 | 99 | Primitive "DOMTokenList" -> 100 | pure TypeString 101 | 102 | Primitive "USVString" -> 103 | pure TypeString 104 | 105 | Primitive "SVGAnimatedEnumeration" -> 106 | pure TypeString 107 | 108 | Union s -> 109 | bind s mapType 110 | 111 | Primitive _ -> 112 | [] 113 | -------------------------------------------------------------------------------- /codegen/src/DOM/Indexed.purs: -------------------------------------------------------------------------------- 1 | module DOM.Indexed where 2 | 3 | import Prelude 4 | 5 | import Comment (commentModule, documentModule) 6 | import Control.Monad.Except (ExceptT(..)) 7 | import DOM.Common (Interface, webElements) 8 | import DOM.Indexed.Attribute as Attribute 9 | import DOM.Indexed.Element as Element 10 | import DOM.Indexed.Listener as Listener 11 | import DOM.Indexed.Self as Self 12 | import DOM.Parse (Specification) 13 | import Data.Array as Array 14 | import Data.Maybe (maybe) 15 | import Data.String as String 16 | import Effect.Aff (Aff, Error, attempt) 17 | import FS as FS 18 | import Foreign.Object as Foreign 19 | import Node.Encoding (Encoding(..)) 20 | import Node.FS.Aff (writeTextFile) 21 | import Node.Path as Path 22 | import Partial.Unsafe (unsafePartial) 23 | import PureScript.CST.Types (Export, ImportDecl, Module) 24 | import Tidy.Codegen (declImportAs, exportModule, importValue, module_, printModule) 25 | 26 | generateSpec 27 | :: String 28 | -> String 29 | -> Array (ImportDecl Void) 30 | -> Array (Export Void) 31 | -> Specification 32 | -> ExceptT Error Aff Unit 33 | generateSpec 34 | path 35 | baseMod 36 | imports 37 | exports 38 | { elements, interfaces: all, attributes, events } = do 39 | let 40 | listenerMod :: String 41 | listenerMod = 42 | baseMod <> ".Listeners" 43 | 44 | attributeMod :: String 45 | attributeMod = 46 | baseMod <> ".Attributes" 47 | 48 | modPath :: String -> String 49 | modPath modName = do 50 | let segments = String.split (String.Pattern ".") modName 51 | Path.concat $ Array.concat 52 | [ pure path 53 | , maybe mempty identity $ Array.init segments 54 | , Array.fromFoldable $ map (_ <> ".purs") $ Array.last segments 55 | ] 56 | 57 | interfaces :: Foreign.Object Interface 58 | interfaces = 59 | Element.crawlInterfaces elements all 60 | 61 | FS.createDir $ Path.concat 62 | [ path 63 | , String.replaceAll (String.Pattern ".") (String.Replacement "/") baseMod 64 | ] 65 | 66 | ExceptT $ attempt 67 | $ writeTextFile UTF8 (modPath baseMod) 68 | $ printModule 69 | $ unsafePartial 70 | $ warnCodegen 71 | $ documentModule 72 | [ "This module contains reexports of all the DOM elements." ] 73 | $ module_ baseMod 74 | (exports <> Element.exports interfaces elements) 75 | (imports <> Element.imports "Deku.DOM" interfaces) 76 | (Element.generate interfaces elements) 77 | 78 | when (Array.length attributes /= 0) do 79 | ExceptT $ attempt 80 | $ writeTextFile UTF8 (modPath attributeMod) 81 | $ printModule 82 | $ unsafePartial 83 | $ warnCodegen 84 | $ documentModule 85 | [ "This module contains reexports of all the attributes." ] 86 | $ module_ attributeMod 87 | (Attribute.exports attributes) 88 | (Attribute.imports attributes) 89 | (Attribute.generate attributes) 90 | 91 | when (Array.length events /= 0) do 92 | ExceptT $ attempt 93 | $ writeTextFile UTF8 (modPath listenerMod) 94 | $ printModule 95 | $ unsafePartial 96 | $ warnCodegen 97 | $ documentModule 98 | [ "This module contains reexports of all the event listeners." ] 99 | $ module_ listenerMod 100 | (Listener.exports events) 101 | (Listener.imports events) 102 | (Listener.generate events) 103 | 104 | warnCodegen :: forall a. Module a -> Module a 105 | warnCodegen = 106 | commentModule 107 | [ "This module has been automatically generated by running `spago run -p codegen`." 108 | , "Any changes may be overwritten." 109 | ] 110 | 111 | generate 112 | :: Specification -> Specification -> Specification -> ExceptT Error Aff Unit 113 | generate html svg mathml = do 114 | FS.createDir "deku-dom/src/Deku/DOM" 115 | 116 | ExceptT $ attempt 117 | $ writeTextFile UTF8 "./deku-dom/src/Deku/DOM/Self.purs" 118 | $ printModule 119 | $ unsafePartial 120 | $ warnCodegen 121 | $ module_ "Deku.DOM.Self" [] 122 | (Self.imports webElements) 123 | (Self.generate webElements) 124 | 125 | generateSpec "deku-dom/src" "Deku.DOM" 126 | [ unsafePartial $ declImportAs "Deku.Control" 127 | [ importValue "text", importValue "text_" ] 128 | "Deku.Control" 129 | ] 130 | [ unsafePartial $ exportModule "Deku.Control" 131 | , unsafePartial $ exportModule "Deku.Attribute" 132 | ] 133 | html 134 | 135 | generateSpec "deku-dom/src" "Deku.DOM.SVG" 136 | [] 137 | [] 138 | svg 139 | 140 | generateSpec "deku-dom/src" "Deku.DOM.MathML" 141 | [] 142 | [] 143 | mathml -------------------------------------------------------------------------------- /codegen/src/DOM/Indexed/Attribute.purs: -------------------------------------------------------------------------------- 1 | module DOM.Indexed.Attribute where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import DOM.Common (Attribute, Ctor(..), Keyword, declHandler, typeAttributed, typeFunked, typeIndexedAt) 7 | import DOM.TypeStub (constructArg, constructIndex, handler, handlerImports) 8 | import Data.Array as Array 9 | import PureScript.CST.Types (Declaration, Export, ImportDecl, Type) 10 | import Tidy.Codegen (binaryOp, declImport, declImportAs, declSignature, declValue, exportModule, exportValue, exprApp, exprIdent, exprOp, exprString, importOp, importClass, importValue, typeApp, typeArrow, typeConstrained, typeCtor, typeForall, typeVar) 11 | 12 | imports :: Partial => Array Attribute -> Array (ImportDecl Void) 13 | imports attributes = 14 | Array.concat 15 | [ identity 16 | [ declImportAs "Control.Applicative" 17 | [ importValue "pure", importClass "Applicative" ] 18 | "Applicative" 19 | , declImport "Control.Category" [ importOp "<<<" ] 20 | , declImportAs "Data.Functor" 21 | [ importValue "map", importClass "Functor" ] 22 | "Functor" 23 | , declImportAs "Deku.DOM.Combinators" [ importValue "unset" ] 24 | "Combinators" 25 | ] 26 | , handlerImports (map _.type attributes) 27 | ] 28 | 29 | exports :: Partial => Array Attribute -> Array (Export Void) 30 | exports attributes = 31 | Array.concat 32 | [ pure $ exportModule "Combinators" 33 | , bind attributes \{ index: (Ctor ctor), keywords } -> do 34 | let shortHand = ctor <> "_" 35 | -- export for primary 36 | [ exportValue ctor, exportValue shortHand ] 37 | -- and its keywords 38 | <> map (exportValue <<< append ctor <<< _.name) keywords 39 | ] 40 | 41 | generate :: Partial => Array Attribute -> Array (Declaration Void) 42 | generate attributes = 43 | bind attributes \{ index: index@(Ctor ctor), type: t, keywords, name } -> 44 | let 45 | shortHand = ctor <> "_" 46 | indexType = constructIndex t 47 | in 48 | -- generate simple function definition 49 | [ declSignature ctor 50 | $ typeForall [ typeVar "r", typeVar "f" ] 51 | $ typeConstrained 52 | [ typeApp (typeCtor "Functor.Functor") [ typeVar "f" ] ] 53 | $ typeArrow [ typeFunked "f" $ constructArg t ] 54 | $ typeFunked "f" 55 | $ typeAttributed 56 | $ typeIndexedAt index indexType 57 | , declHandler ctor $ handler name t 58 | 59 | , declSignature shortHand 60 | $ typeForall [ typeVar "r", typeVar "f" ] 61 | $ typeConstrained 62 | [ typeApp (typeCtor "Applicative.Applicative") [ typeVar "f" ] ] 63 | $ typeArrow [ constructArg t ] 64 | $ typeFunked "f" 65 | $ typeAttributed 66 | $ typeIndexedAt index indexType 67 | , declValue shortHand [] $ exprOp (exprIdent ctor) 68 | [ binaryOp "<<<" $ exprIdent "Applicative.pure" ] 69 | ] 70 | -- create additional shorthands for known keywords 71 | <> bind keywords 72 | (generateKeywordShorthand ctor shortHand index indexType) 73 | 74 | where 75 | 76 | generateKeywordShorthand 77 | :: String 78 | -> String 79 | -> Ctor 80 | -> Type Void 81 | -> Keyword 82 | -> Array (Declaration Void) 83 | generateKeywordShorthand ctor shortHand index indexType { original, name } = 84 | do 85 | let valueName = ctor <> name 86 | [ declSignature valueName 87 | $ typeForall [ typeVar "r", typeVar "f" ] 88 | $ typeConstrained 89 | [ typeApp (typeCtor "Applicative.Applicative") [ typeVar "f" ] ] 90 | $ typeFunked "f" 91 | $ typeAttributed 92 | $ typeIndexedAt index 93 | $ indexType 94 | , declValue valueName [] $ exprApp (exprIdent shortHand) 95 | [ exprString original ] 96 | ] -------------------------------------------------------------------------------- /codegen/src/DOM/Indexed/Element.purs: -------------------------------------------------------------------------------- 1 | module DOM.Indexed.Element where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import DOM.Common (Ctor(..), Element, Interface, TagNS, typeArrayed, typeAttributed, typePolled, typeNut, xhtmlNamespace, nominal) 7 | import DOM.TypeStub (constructIndex, indexImports) 8 | import Data.Array as Array 9 | import Data.Array.NonEmpty as NEA 10 | import Data.Maybe (Maybe(..), fromMaybe, maybe) 11 | import Data.Set as Set 12 | import Data.Tuple (snd) 13 | import Data.Tuple.Nested (type (/\), (/\)) 14 | import Foreign.Object as Foreign 15 | import PureScript.CST.Types (ClassFundep(..), Declaration, Export, Expr, ImportDecl, Type) 16 | import Safe.Coerce (coerce) 17 | import Tidy.Codegen (binderVar, declClass, declImport, declImportAs, declInstance, declSignature, declType, declValue, exportClass, exportType, exportValue, exprApp, exprArray, exprCtor, exprIdent, exprString, importType, importTypeAll, importValue, typeApp, typeArrow, typeCtor, typeRow, typeRowEmpty, typeString, typeVar, typeVarKinded) 18 | import Tidy.Codegen.Class (toName) 19 | import Tidy.Codegen.Common (tokRightArrow) 20 | 21 | imports 22 | :: Partial => String -> Foreign.Object Interface -> Array (ImportDecl Void) 23 | imports baseMod interfaces = 24 | Array.concat 25 | [ identity 26 | [ declImportAs "FRP.Poll" [] "FRP.Poll" 27 | , declImport "Data.Maybe" [ importTypeAll "Maybe" ] 28 | , declImportAs "Deku.Attribute" [ importType "Attribute" ] 29 | "Deku.Attribute" 30 | 31 | , declImport "Deku.Control" [ importValue "elementify" ] 32 | , declImportAs "Deku.Control" [] "DC" 33 | , declImport "Deku.Core" [ importType "Nut" ] 34 | , declImport "Type.Proxy" [ importType "Proxy" ] 35 | ] 36 | , indexImports 37 | (bind (Foreign.values interfaces) \{ members } -> map snd members) 38 | , if Set.isEmpty missing then [] 39 | else pure 40 | $ declImport baseMod 41 | $ map importType 42 | $ Array.fromFoldable missing 43 | ] 44 | 45 | where 46 | 47 | missing = 48 | Set.difference required defined 49 | 50 | required = 51 | Set.fromFoldable $ bind (Foreign.values interfaces) (coerce <<< _.bases) 52 | 53 | defined = 54 | Set.fromFoldable $ Foreign.keys interfaces 55 | 56 | exports 57 | :: Partial => Foreign.Object Interface -> Array Element -> Array (Export Void) 58 | exports interfaces tags = do 59 | Array.concat 60 | [ pure $ exportClass "TagToDeku" 61 | , bind tags \{ ctor: Ctor tag } -> do 62 | let shortHand = tag <> "_" 63 | let shorShortHand = tag <> "__" 64 | [ exportValue tag, exportValue shortHand, exportValue shorShortHand ] 65 | , map exportType $ Foreign.keys interfaces 66 | ] 67 | 68 | generate 69 | :: Partial 70 | => Foreign.Object Interface 71 | -> Array Element 72 | -> Array (Declaration Void) 73 | generate interfaces tags = do 74 | Array.concat 75 | [ pure $ declClass [] "TagToDeku" 76 | [ typeVarKinded "tag" $ typeCtor "Symbol" 77 | , typeVarKinded "interface" $ typeApp (typeCtor "Row") 78 | [ typeCtor "Type" ] 79 | ] 80 | [ FundepDetermines (NEA.singleton (toName "tag")) tokRightArrow 81 | (NEA.singleton (toName "interface")) 82 | ] 83 | [] 84 | 85 | -- interfaces 86 | , bind (Foreign.values interfaces) \{ ctor, name, bases, members } -> 87 | [ declType ctor 88 | [ typeVarKinded "r" $ typeApp (typeCtor "Row") [ typeCtor "Type" ] ] 89 | $ typeIndex (coerce bases) 90 | -- add an additional property to identify the interface 91 | $ Array.cons 92 | (nominal /\ (typeApp (typeCtor "Proxy") [ typeString name ])) 93 | $ map (\(index /\ t) -> index /\ constructIndex t) 94 | $ Array.nub members 95 | ] 96 | 97 | -- elements 98 | , bind tags \{ ctor: Ctor ctor, tag, ns, interface } -> do 99 | let shortHand = ctor <> "_" 100 | let shortShortHand = ctor <> "__" 101 | [ declInstance Nothing [] "TagToDeku" 102 | [ typeString tag, typeApp (typeCtor interface) [ typeRowEmpty ] ] 103 | [] 104 | , declSignature ctor 105 | $ typeArrow 106 | [ typeArrayed $ typePolled $ typeAttributed $ typeApp 107 | (typeCtor interface) 108 | [ typeRowEmpty ] 109 | , typeApp (typeCtor "Array") [ typeNut ] 110 | ] 111 | typeNut 112 | , declValue ctor [] $ exprApp (exprIdent "elementify") 113 | [ exprNamespace ns 114 | , exprString tag 115 | ] 116 | 117 | , declSignature shortHand 118 | $ typeArrow 119 | [ typeApp (typeCtor "Array") [ typeNut ] 120 | ] 121 | typeNut 122 | , declValue shortHand [] $ exprApp (exprIdent ctor) 123 | [ exprArray [] 124 | ] 125 | 126 | , declSignature shortShortHand 127 | $ typeArrow 128 | [ typeCtor "String" ] 129 | typeNut 130 | , declValue shortShortHand [ binderVar "t" ] $ exprApp (exprIdent ctor) 131 | [ exprArray [] 132 | , exprArray 133 | [ exprApp (exprIdent "DC.text_") 134 | [ exprIdent "t" 135 | ] 136 | ] 137 | ] 138 | ] 139 | ] 140 | 141 | where 142 | 143 | exprNamespace :: Partial => TagNS -> Expr Void 144 | exprNamespace ns = 145 | maybe 146 | (exprCtor "Nothing") 147 | (exprApp (exprCtor "Just") <<< pure <<< exprString) 148 | (xhtmlNamespace ns) 149 | 150 | typeIndex :: Partial => Array String -> Array (Ctor /\ Type Void) -> Type Void 151 | typeIndex bases members = 152 | typeRow members $ Just $ Array.foldl (\r n -> typeApp (typeCtor n) [ r ]) 153 | (typeVar "r") 154 | bases 155 | 156 | -- | Constructs the set of reachable interfaces for the root defined by all elements. 157 | crawlInterfaces :: Array Element -> Array Interface -> Foreign.Object Interface 158 | crawlInterfaces elements all = 159 | Foreign.fromFoldable $ flip Array.mapMaybe all \intf -> 160 | if intf.name `Set.member` reachable then 161 | Just $ intf.name /\ intf 162 | 163 | else 164 | Nothing 165 | 166 | where 167 | 168 | reachable :: Set.Set String 169 | reachable = 170 | go 171 | ( Foreign.fromFoldable $ map (\{ name, bases } -> name /\ coerce bases) 172 | all 173 | ) 174 | initial 175 | initial 176 | 177 | initial :: Set.Set String 178 | initial = 179 | Set.fromFoldable $ coerce <<< _.interface <$> elements 180 | 181 | go 182 | :: Foreign.Object (Array String) 183 | -> Set.Set String 184 | -> Set.Set String 185 | -> Set.Set String 186 | go _ seen next | Set.isEmpty next = seen 187 | go spec seen next = do 188 | let 189 | found :: Set.Set String 190 | found = 191 | Set.fromFoldable 192 | $ Array.foldMap 193 | (fromMaybe mempty <<< flip Foreign.lookup spec <<< coerce) 194 | $ Set.toUnfoldable next 195 | 196 | go spec (Set.union seen found) (Set.difference found seen) -------------------------------------------------------------------------------- /codegen/src/DOM/Indexed/Listener.purs: -------------------------------------------------------------------------------- 1 | module DOM.Indexed.Listener where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import DOM.Common (Ctor(..), Event, declHandler, typeAttributed, typeFunked, typeIndexedAt) 7 | import DOM.TypeStub (constructArg, constructIndex, handler, handlerImports) 8 | import Data.Array as Array 9 | import PureScript.CST.Types (Declaration, Export, ImportDecl) 10 | import Tidy.Codegen (binaryOp, declImport, declImportAs, declSignature, declValue, exportModule, exportValue, exprIdent, exprOp, importClass, importOp, importValue, typeApp, typeArrow, typeConstrained, typeCtor, typeForall, typeVar) 11 | 12 | imports :: Partial => Array Event -> Array (ImportDecl Void) 13 | imports events = 14 | Array.concat 15 | [ identity 16 | [ declImportAs "Control.Applicative" 17 | [ importValue "pure", importClass "Applicative" ] 18 | "Applicative" 19 | , declImport "Control.Category" [ importOp "<<<" ] 20 | , declImportAs "Data.Functor" 21 | [ importValue "map", importClass "Functor" ] 22 | "Functor" 23 | , declImportAs "Deku.DOM.Combinators" 24 | ( map importValue 25 | [ "unset" 26 | , "injectElement" 27 | , "injectElementT" 28 | , "runOn" 29 | , "runOn_" 30 | , "numberOn" 31 | , "numberOn_" 32 | , "checkedOn" 33 | , "checkedOn_" 34 | , "valueOn" 35 | , "valueOn_" 36 | , "selectOn" 37 | , "selectOn_" 38 | ] 39 | ) 40 | "Combinators" 41 | ] 42 | , handlerImports (map _.type events) 43 | ] 44 | 45 | exports :: Partial => Array Event -> Array (Export Void) 46 | exports events = 47 | Array.concat 48 | [ pure $ exportModule "Combinators" 49 | , bind events \{ index: Ctor ctor } -> 50 | let 51 | shortHand = ctor <> "_" 52 | in 53 | [ exportValue ctor, exportValue shortHand ] 54 | ] 55 | 56 | generate :: Partial => Array Event -> Array (Declaration Void) 57 | generate events = 58 | bind events \{ index: index@(Ctor ctor), type: t, name } -> 59 | let 60 | shortHand = ctor <> "_" 61 | indexType = constructIndex t 62 | in 63 | -- generate simple function definition 64 | [ declSignature ctor 65 | $ typeForall [ typeVar "r", typeVar "f" ] 66 | $ typeConstrained 67 | [ typeApp (typeCtor "Functor.Functor") [ typeVar "f" ] ] 68 | $ typeArrow [ typeFunked "f" $ constructArg t ] 69 | $ typeFunked "f" 70 | $ typeAttributed 71 | $ typeIndexedAt index indexType 72 | , declHandler ctor $ handler name t 73 | 74 | , declSignature shortHand 75 | $ typeForall [ typeVar "r", typeVar "f" ] 76 | $ typeConstrained 77 | [ typeApp (typeCtor "Applicative.Applicative") [ typeVar "f" ] ] 78 | $ typeArrow [ constructArg t ] 79 | $ typeFunked "f" 80 | $ typeAttributed 81 | $ typeIndexedAt index indexType 82 | , declValue shortHand [] $ exprOp (exprIdent ctor) 83 | [ binaryOp "<<<" $ exprIdent "Applicative.pure" ] 84 | ] 85 | -------------------------------------------------------------------------------- /codegen/src/DOM/Indexed/Self.purs: -------------------------------------------------------------------------------- 1 | module DOM.Indexed.Self where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import Comment (documentDecl) 7 | import DOM.Common (declHandler, nominal, selfKey, typeAttributed, typeFunked, typeIndexedAt) 8 | import DOM.TypeStub (TypeStub(..), constructArg, constructIndex, handler, handlerImports) 9 | import Data.Array as Array 10 | import Data.Array.NonEmpty as NEA 11 | import Data.Maybe (Maybe(..)) 12 | import PureScript.CST.Types (Type, ClassFundep(..), Declaration, ImportDecl) 13 | import Tidy.Codegen (binaryOp, declClass, declImport, declImportAs, declInstance, declSignature, declValue, exprIdent, exprOp, importClass, importOp, importType, importValue, typeApp, typeArrow, typeConstrained, typeCtor, typeForall, typeString, typeVar, typeVarKinded) 14 | import Tidy.Codegen.Class (toName) 15 | import Tidy.Codegen.Common (tokRightArrow) 16 | 17 | imports :: Partial => Array TypeStub -> Array (ImportDecl Void) 18 | imports es = 19 | Array.concat 20 | [ identity 21 | [ declImportAs "Control.Applicative" 22 | [ importValue "pure", importClass "Applicative" ] 23 | "Applicative" 24 | , declImport "Control.Category" [ importOp "<<<" ] 25 | , declImportAs "Data.Functor" 26 | [ importValue "map", importClass "Functor" ] 27 | "Functor" 28 | , declImport "Type.Proxy" [ importType "Proxy" ] 29 | ] 30 | , handlerImports $ Array.cons rawSelf es 31 | ] 32 | 33 | generate :: Partial => Array TypeStub -> Array (Declaration Void) 34 | generate es = 35 | append 36 | [ declClass [] "IsSelf" 37 | [ typeVarKinded "element" $ typeCtor "Type" 38 | , typeVarKinded "name" $ typeCtor "Symbol" 39 | ] 40 | [ FundepDetermines (NEA.singleton (toName "element")) tokRightArrow 41 | (NEA.singleton (toName "name")) 42 | ] 43 | [] 44 | 45 | , documentDecl 46 | [ "Creates a special event where an Deku element can have its raw DOM element" 47 | , "injected into a closure. All bets are off type-safety wise. This is useful" 48 | , "when you need to manipulate the element itself, like for example attaching" 49 | , "properties to it, etc." 50 | ] 51 | $ declSignature "self" 52 | $ typeForall [ typeVar "r", typeVar "f" ] 53 | $ typeConstrained 54 | [ typeApp (typeCtor "Functor.Functor") [ typeVar "f" ] ] 55 | $ typeArrow [ typeFunked "f" $ constructArg rawSelf ] 56 | $ typeFunked "f" 57 | $ typeAttributed 58 | $ typeVar "r" 59 | , declHandler "self" $ handler selfKey $ rawSelf 60 | 61 | , documentDecl [ "Shorthand version of `self`" ] 62 | $ declSignature "self_" 63 | $ typeForall [ typeVar "r", typeVar "f" ] 64 | $ typeConstrained 65 | [ typeApp (typeCtor "Applicative.Applicative") [ typeVar "f" ] ] 66 | $ typeArrow [ constructArg rawSelf ] 67 | $ typeFunked "f" 68 | $ typeAttributed 69 | $ typeVar "r" 70 | , declValue "self_" [] $ exprOp (exprIdent "self") 71 | [ binaryOp "<<<" $ exprIdent "Applicative.pure" ] 72 | 73 | , documentDecl 74 | [ "A slightly less permissive version of `Self` that associates Deku Elements to" 75 | , "the primitive element definitions form `purescript-web`. For example, `A_` from `deku`" 76 | , "gets translated to `HTMLAnchorElement` from `purescript-web`, etc." 77 | ] 78 | $ declSignature "selfT" 79 | $ typeForall [ typeVar "name", typeVar "e", typeVar "r", typeVar "f" ] 80 | $ typeConstrained 81 | [ typeApp (typeCtor "Functor.Functor") [ typeVar "f" ] ] 82 | $ typeConstrained 83 | [ typeApp (typeCtor "IsSelf") [ typeVar "e", typeVar "name" ] ] 84 | $ typeArrow [ typeFunked "f" $ selfHandler $ typeVar "e" ] 85 | $ typeFunked "f" 86 | $ typeAttributed 87 | $ typeIndexedAt nominal 88 | $ typeApp (typeCtor "Proxy") [ typeVar "name" ] 89 | , declHandler "selfT" $ handler selfKey rawSelf 90 | 91 | , documentDecl [ "Shorthand version of `selfT`" ] 92 | $ declSignature "selfT_" 93 | $ typeForall [ typeVar "name", typeVar "e", typeVar "r", typeVar "f" ] 94 | $ typeConstrained 95 | [ typeApp (typeCtor "Applicative.Applicative") [ typeVar "f" ] ] 96 | $ typeConstrained 97 | [ typeApp (typeCtor "IsSelf") [ typeVar "e", typeVar "name" ] ] 98 | $ typeArrow [ selfHandler $ typeVar "e" ] 99 | $ typeFunked "f" 100 | $ typeAttributed 101 | $ typeIndexedAt nominal 102 | $ typeApp (typeCtor "Proxy") [ typeVar "name" ] 103 | , declValue "selfT_" [] $ exprOp (exprIdent "selfT") 104 | [ binaryOp "<<<" $ exprIdent "Applicative.pure" ] 105 | 106 | ] 107 | $ bind es case _ of 108 | TypeEvent t mod -> 109 | [ declInstance Nothing [] 110 | "IsSelf" 111 | [ constructIndex $ TypeEvent t mod 112 | , typeString t 113 | ] 114 | [] 115 | ] 116 | 117 | where 118 | 119 | selfHandler :: Partial => Type Void -> Type Void 120 | selfHandler intf = 121 | typeArrow [ intf ] $ typeApp (typeCtor "Effect.Effect") 122 | [ typeCtor "Data.Unit.Unit" ] 123 | 124 | rawSelf :: TypeStub 125 | rawSelf = 126 | TypeEvent "Element" "Web.DOM.Element" -------------------------------------------------------------------------------- /codegen/src/DOM/Parse.purs: -------------------------------------------------------------------------------- 1 | module DOM.Parse where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import DOM.Common (Attribute, Ctor(..), Element, Event, Interface, TagNS(..), mkAttribute, mkElement, mkHandler, mkInterface) 7 | import DOM.IDL as IDL 8 | import DOM.Spec as Spec 9 | import DOM.TypeStub (TypeStub) 10 | import Data.Array as Array 11 | import Data.Function (on) 12 | import Data.Maybe (Maybe(..), fromMaybe, maybe) 13 | import Data.String as String 14 | import Data.Tuple (Tuple(..)) 15 | import Data.Tuple.Nested (type (/\), (/\)) 16 | import Data.Variant (Variant, match) 17 | import Foreign.Object as Foreign 18 | import Safe.Coerce (coerce) 19 | 20 | type Source = Variant 21 | ( dfn :: Spec.KeywordSpec 22 | , events :: Spec.EventSpec 23 | , idlparsed :: Spec.InterfaceSpec 24 | , elements :: Spec.TagSpec 25 | ) 26 | 27 | type Specification = 28 | { attributes :: Array Attribute 29 | , events :: Array Event 30 | , interfaces :: Array Interface 31 | , elements :: Array Element 32 | } 33 | 34 | -- | Sorts an array of definitions into a specification. 35 | parse :: TagNS -> Array Source -> Specification 36 | parse ns sources = do 37 | let 38 | -- merge all chunks of Source into one record of arrays/objects to work with 39 | source 40 | :: { dfn :: Array Spec.Definition 41 | , event :: Array Spec.EventDef 42 | , inheritance :: Foreign.Object (Array String) 43 | , members :: Foreign.Object (Array Spec.Member) 44 | , extension :: Foreign.Object (Array Spec.Mixin) 45 | , element :: Array Spec.Tag 46 | } 47 | source = 48 | Array.foldMap 49 | ( match 50 | { dfn: \{ dfns } -> empty { dfn = dfns } 51 | , events: \{ events: evs } -> empty { event = evs } 52 | , idlparsed: \{ idlparsed: { idlNames, idlExtendedNames } } -> 53 | empty 54 | { inheritance = map (Array.fromFoldable <<< _.inheritance) 55 | idlNames 56 | , members = map (maybe mempty identity <<< _.members) idlNames 57 | , extension = idlExtendedNames 58 | } 59 | 60 | , elements: \{ elements: els } -> empty { element = els } 61 | } 62 | ) 63 | sources 64 | 65 | where 66 | 67 | empty = 68 | { dfn: [] 69 | , event: [] 70 | , inheritance: Foreign.empty 71 | , members: Foreign.empty 72 | , extension: Foreign.empty 73 | , element: [] 74 | } 75 | 76 | -- mapping of attribute to valid keywords 77 | keywords :: Foreign.Object (Array String) 78 | keywords = do 79 | map Array.nub $ Foreign.fromFoldableWith append do 80 | dfn <- Array.filter (not <<< eq "argument" <<< _.type) source.dfn 81 | text <- dfn.linkingText 82 | for <- Array.nub $ Array.mapMaybe forAttribute dfn.for 83 | pure $ for /\ pure text 84 | 85 | where 86 | 87 | forAttribute :: String -> Maybe String 88 | forAttribute f = 89 | case String.split (String.Pattern "/") f of 90 | [ _, attr ] | attr /= "" -> 91 | Just attr 92 | 93 | _ -> 94 | Nothing 95 | 96 | elements :: Foreign.Object Element 97 | elements = 98 | Foreign.fromFoldable 99 | $ bind source.element case _ of 100 | { name, interface: Just interface } -> 101 | Tuple name <$> (Array.fromFoldable $ mkElement ns interface name) 102 | 103 | _ -> 104 | [] 105 | 106 | -- we have the interface definitions in `interfaceSource` but those only contain properties. For SSR we need the 107 | -- actual attributes and those only show up in the definitions as `element-attr`. 108 | attributeMembers :: Foreign.Object (Array Attribute) 109 | attributeMembers = 110 | Foreign.fromFoldableWith append 111 | $ bind source.dfn case _ of 112 | -- basic attributes 113 | { type: "element-attr", for, linkingText } -> do 114 | attr <- flip Array.mapMaybe linkingText \attr -> 115 | case String.stripPrefix (String.Pattern "on") attr of 116 | -- ignore "on" attributes for events, these are described better by the `EventSpec` 117 | Just _ -> 118 | Nothing 119 | 120 | Nothing -> 121 | Just attr 122 | 123 | let kws = keywordsFor attr 124 | 125 | attribute <- Array.fromFoldable $ mkAttribute kws attr 126 | interface <- coerce $ map tagToInterface for 127 | pure $ interface /\ pure attribute 128 | 129 | -- could not find a definition for aria attributes so we translate the properties instead 130 | { type: "attribute", for: [ "ARIAMixin" ], linkingText } -> 131 | pure $ "ARIAMixin" /\ flip Array.mapMaybe linkingText \prop -> do 132 | let 133 | attr = unAria prop 134 | kws = keywordsFor attr 135 | mkAttribute kws attr 136 | 137 | -- css styling properties for svg 138 | { type: "property", for: [], linkingText } | ns == SVG -> 139 | pure $ "SVGElement" /\ flip Array.mapMaybe linkingText \prop -> do 140 | let kws = keywordsFor prop 141 | mkAttribute kws prop 142 | 143 | { type: "property", for, linkingText } | ns == SVG -> do 144 | prop <- linkingText 145 | let kws = keywordsFor prop 146 | attribute <- Array.fromFoldable $ mkAttribute kws prop 147 | interface <- coerce $ tagToInterface <$> for 148 | pure $ interface /\ pure attribute 149 | 150 | _ -> 151 | [] 152 | where 153 | 154 | -- dfn contains some pseudo interfaces which we have to map 155 | tagToInterface :: String -> Ctor 156 | tagToInterface "global" = Ctor "Element" 157 | tagToInterface "html-global" = Ctor "HTMLElement" 158 | tagToInterface "htmlsvg-global" = Ctor "HTMLOrSVGElement" 159 | tagToInterface tag = case Foreign.lookup tag elements of 160 | Just { interface } -> 161 | interface 162 | 163 | Nothing -> 164 | -- will throw either at generation or compilation 165 | Ctor $ "!NoInterfaceFor" <> tag 166 | 167 | keywordsFor :: String -> Array String 168 | keywordsFor attr = 169 | fromMaybe mempty $ Foreign.lookup attr keywords 170 | 171 | -- | Converts the property names of the ARIAMixin interface to the corresponding attribute name 172 | unAria :: String -> String 173 | unAria prop = case String.stripPrefix (String.Pattern "aria") prop of 174 | Nothing -> 175 | prop -- "role" is not prefixed with aria 176 | 177 | Just rawAttr -> case rawAttr of 178 | _ 179 | | Just elementStripped <- 180 | String.stripSuffix (String.Pattern "Element") rawAttr -> 181 | "aria-" <> String.toLower elementStripped 182 | 183 | _ 184 | | Just elementsStripped <- 185 | String.stripSuffix (String.Pattern "Elements") rawAttr -> 186 | "aria-" <> String.toLower elementsStripped 187 | 188 | _ -> 189 | "aria-" <> String.toLower rawAttr 190 | 191 | -- the interface specifications do contain the events but not the interface of the emitted event itself. Those 192 | -- can be found by running through the event specifications 193 | eventMembers :: Foreign.Object (Array Event) 194 | eventMembers = 195 | Foreign.fromFoldableWith append 196 | $ bind source.event \{ type: name, targets, interface: eventType } -> do 197 | interface <- targets 198 | maybe mempty (pure <<< Tuple interface <<< pure) $ mkHandler 199 | eventType 200 | name 201 | 202 | interfaceMembers :: Foreign.Object (Array (Ctor /\ TypeStub)) 203 | interfaceMembers = 204 | map (Array.nub) 205 | $ Foreign.unionWith append (extractMember attributeMembers) 206 | (extractMember eventMembers) 207 | 208 | -- the only thing we actually need the interface specifications for is the relation between interfaces. We need 209 | -- to know which interface inherits, extends or mixes into another. 210 | interfaces :: Array Interface 211 | interfaces = do 212 | flip Array.mapMaybe (Foreign.toUnfoldable source.members) \(name /\ _) -> 213 | do 214 | let 215 | bases = Array.filter fixSpec 216 | (IDL.resolveInterface source.inheritance source.extension name) 217 | members = fromMaybe mempty $ Foreign.lookup name interfaceMembers 218 | mkInterface bases members name 219 | 220 | where 221 | 222 | fixSpec = case _ of 223 | "LinkStyle" -> false 224 | _ -> true 225 | 226 | -- this would in theory leave out attributes with the same name but different types. In practice all attributes 227 | -- are stringly typed. 228 | attributes :: Array Attribute 229 | attributes = 230 | Array.nubBy (compare `on` _.name) $ Array.concat $ Foreign.values 231 | attributeMembers 232 | 233 | events :: Array Event 234 | events = 235 | Array.nubBy (compare `on` _.name) $ Array.concat $ Foreign.values 236 | eventMembers 237 | 238 | { attributes, events, elements: Foreign.values elements, interfaces } 239 | 240 | extractMember 241 | :: forall f1 f2 r 242 | . Functor f1 243 | => Functor f2 244 | => f1 (f2 { index :: Ctor, type :: TypeStub | r }) 245 | -> f1 (f2 (Ctor /\ TypeStub)) 246 | extractMember = 247 | map $ map \{ index, type: t } -> index /\ t -------------------------------------------------------------------------------- /codegen/src/DOM/Spec.purs: -------------------------------------------------------------------------------- 1 | module DOM.Spec where 2 | 3 | import Prelude 4 | 5 | import Data.Argonaut.Core (isArray, isObject) 6 | import Data.Argonaut.Decode (class DecodeJson, JsonDecodeError(..), decodeJson) 7 | import Data.Argonaut.Decode.Decoders (decodeJObject) 8 | import Data.Argonaut.Encode (class EncodeJson) 9 | import Data.Argonaut.Encode.Generic (genericEncodeJson) 10 | import Data.Either (Either(..), note) 11 | import Data.Generic.Rep (class Generic) 12 | import Data.Maybe (Maybe) 13 | import Foreign.Object as Foreign 14 | 15 | type TagSpec = 16 | { spec :: 17 | { title :: String 18 | , url :: String 19 | } 20 | , elements :: Array Tag 21 | } 22 | 23 | type Tag = 24 | { name :: String 25 | , interface :: Maybe String 26 | , obsolete :: Maybe Boolean 27 | } 28 | 29 | type EventSpec = 30 | { spec :: { title :: String, url :: String } 31 | , events :: Array EventDef 32 | } 33 | 34 | type EventDef = 35 | { href :: Maybe String 36 | , src :: { format :: String, href :: Maybe String } 37 | , type :: String 38 | , targets :: Array String 39 | , interface :: String 40 | , bubbles :: Maybe Boolean 41 | } 42 | 43 | type InterfaceSpec = 44 | { spec :: 45 | { title :: String 46 | , url :: String 47 | } 48 | , idlparsed :: IDL 49 | } 50 | 51 | type IDL = 52 | { idlNames :: Foreign.Object Interface 53 | , idlExtendedNames :: Foreign.Object (Array Mixin) 54 | } 55 | 56 | type Interface = 57 | { type :: String 58 | , name :: String 59 | , inheritance :: Maybe String 60 | , members :: Maybe (Array Member) 61 | , fragment :: String 62 | } 63 | 64 | data Member 65 | = Constructor 66 | | Operation { name :: String } 67 | | Attribute Attribute 68 | | Const 69 | | Field { name :: String } 70 | | Iterable 71 | 72 | derive instance Eq Member 73 | derive instance Ord Member 74 | derive instance Generic Member _ 75 | instance DecodeJson Member where 76 | decodeJson json = do 77 | member <- decodeJObject json 78 | type_ <- decodeJson =<< note MissingValue (Foreign.lookup "type" member) 79 | case type_ of 80 | "constructor" -> 81 | pure Constructor 82 | 83 | "operation" -> 84 | Operation <$> decodeJson json 85 | 86 | "attribute" -> 87 | Attribute <$> decodeJson json 88 | 89 | "const" -> 90 | pure Const 91 | 92 | "field" -> 93 | Field <$> decodeJson json 94 | 95 | "iterable" -> 96 | pure Iterable 97 | 98 | "maplike" -> 99 | pure Iterable 100 | 101 | "setlike" -> 102 | pure Iterable 103 | 104 | _ -> 105 | Left $ UnexpectedValue json 106 | 107 | instance EncodeJson Member where 108 | encodeJson = genericEncodeJson 109 | 110 | data Mixin 111 | = Includes 112 | { fragment :: String 113 | , includes :: String 114 | } 115 | | Interface 116 | { inheritance :: Maybe String 117 | , members :: Maybe (Array Member) 118 | , partial :: Boolean 119 | } 120 | 121 | derive instance Eq Mixin 122 | derive instance Ord Mixin 123 | derive instance Generic Mixin _ 124 | instance DecodeJson Mixin where 125 | decodeJson json = do 126 | member <- decodeJObject json 127 | type_ <- decodeJson =<< note MissingValue (Foreign.lookup "type" member) 128 | case type_ of 129 | "includes" -> 130 | Includes <$> decodeJson json 131 | 132 | "interface" -> 133 | Interface <$> decodeJson json 134 | 135 | "interface mixin" -> 136 | Interface <$> decodeJson json 137 | 138 | _ -> 139 | Left $ UnexpectedValue json 140 | 141 | instance EncodeJson Mixin where 142 | encodeJson = genericEncodeJson 143 | 144 | type Attribute = 145 | { name :: String 146 | , idlType :: IDLType 147 | , readonly :: Maybe Boolean 148 | } 149 | 150 | data IDLType 151 | = Union (Array IDLType) 152 | | Descriptor IDLDescriptor 153 | | Primitive String 154 | 155 | derive instance Eq IDLType 156 | derive instance Ord IDLType 157 | derive instance Generic IDLType _ 158 | instance DecodeJson IDLType where 159 | decodeJson json = 160 | if isObject json then 161 | Descriptor <$> decodeJson json 162 | 163 | else if isArray json then 164 | Union <$> decodeJson json 165 | 166 | else 167 | Primitive <$> decodeJson json 168 | 169 | instance EncodeJson IDLType where 170 | encodeJson a = genericEncodeJson a 171 | 172 | type IDLDescriptor = 173 | { nullable :: Boolean 174 | , idlType :: IDLType 175 | } 176 | 177 | type KeywordSpec = 178 | { spec :: 179 | { title :: String 180 | , url :: String 181 | } 182 | , dfns :: Array Definition 183 | } 184 | 185 | type Definition = 186 | { id :: String 187 | , href :: String 188 | , linkingText :: Array String 189 | , localLinkingText :: Array String 190 | , informative :: Boolean 191 | , access :: String 192 | , for :: Array String 193 | , type :: String 194 | , definedIn :: String 195 | , heading :: 196 | { id :: Maybe String 197 | , href :: String 198 | , title :: String 199 | , number :: Maybe String 200 | } 201 | } -------------------------------------------------------------------------------- /codegen/src/DOM/TypeStub.purs: -------------------------------------------------------------------------------- 1 | module DOM.TypeStub where 2 | 3 | import Prelude 4 | import Prim hiding (Type) 5 | 6 | import Data.Array as Array 7 | import Data.Generic.Rep (class Generic) 8 | import Partial.Unsafe (unsafePartial) 9 | import PureScript.CST.Types (Expr, ImportDecl, Type) 10 | import Tidy.Codegen (binaryOp, declImportAs, exprApp, exprIdent, exprString, typeApp, typeArrow, typeCtor) 11 | import Tidy.Codegen.Types (BinaryOp) 12 | 13 | -- | Intermediate type between `IDLType` and `Type a` so we can implement an `Ord` and `Eq` instance for deduping. 14 | data TypeStub 15 | = TypeInt 16 | | TypeString 17 | | TypeBoolean 18 | | TypeNumber 19 | | TypeUnit 20 | | TypeEvent String String 21 | 22 | derive instance Eq TypeStub 23 | derive instance Ord TypeStub 24 | derive instance Generic TypeStub _ 25 | 26 | -- | Type as it appears in the index. 27 | constructIndex :: forall a. TypeStub -> Type a 28 | constructIndex = unsafePartial case _ of 29 | TypeInt -> typeCtor "Int" 30 | TypeString -> typeCtor "String" 31 | TypeBoolean -> typeCtor "Boolean" 32 | TypeNumber -> typeCtor "Number" 33 | 34 | TypeUnit -> 35 | typeCtor "Data.Unit.Unit" 36 | 37 | TypeEvent t mod -> 38 | typeCtor $ mod <> "." <> t 39 | 40 | -- | Type as argument. 41 | constructArg :: forall a. TypeStub -> Type a 42 | constructArg = unsafePartial case _ of 43 | TypeInt -> typeCtor "Int" 44 | TypeString -> typeCtor "String" 45 | TypeBoolean -> typeCtor "Boolean" 46 | TypeNumber -> typeCtor "Number" 47 | 48 | TypeUnit -> 49 | typeCtor "Data.Unit.Unit" 50 | 51 | TypeEvent t mod -> 52 | typeArrow [ typeCtor $ mod <> "." <> t ] $ typeApp 53 | (typeCtor "Effect.Effect") 54 | [ typeCtor "Data.Unit.Unit" ] 55 | 56 | -- | Generates the necessary imports for the handler of collection of `TypeStub`s. 57 | handlerImports :: forall e. Array TypeStub -> Array (ImportDecl e) 58 | handlerImports stubs = 59 | unsafePartial $ flip map (Array.nub $ bind stubs modules) \mod -> 60 | declImportAs mod [] mod 61 | 62 | where 63 | 64 | modules = case _ of 65 | TypeInt -> 66 | [ "Deku.Attribute", "Data.Show" ] -- prop', show 67 | 68 | TypeString -> 69 | [ "Deku.Attribute" ] -- prop' 70 | 71 | TypeBoolean -> 72 | [ "Deku.Attribute", "Data.Show" ] -- prop', show 73 | 74 | TypeNumber -> 75 | [ "Deku.Attribute", "Data.Show" ] -- prop', show 76 | 77 | TypeEvent _ mod -> 78 | [ "Deku.Attribute" -- cb, cb' 79 | , mod -- the Event type 80 | , "Effect" -- Effect 81 | , "Data.Unit" -- Unit 82 | , "Unsafe.Coerce" -- unsafeCoerce 83 | ] 84 | 85 | TypeUnit -> 86 | [ "Deku.Attribute", "Data.Unit" ] -- unset' 87 | 88 | -- | Generates the necessary imports for the index of a collection of `TypeStub`s. 89 | indexImports :: forall e. Array TypeStub -> Array (ImportDecl e) 90 | indexImports stubs = 91 | unsafePartial $ flip map (Array.nub $ bind stubs modules) \mod -> 92 | declImportAs mod [] mod 93 | 94 | where 95 | 96 | modules = case _ of 97 | TypeInt -> 98 | [] -- prop', show 99 | 100 | TypeString -> 101 | [] -- prop' 102 | 103 | TypeBoolean -> 104 | [] -- prop', show 105 | 106 | TypeNumber -> 107 | [] -- prop', show 108 | 109 | TypeEvent _ mod -> 110 | [ mod ] -- the Event type 111 | 112 | TypeUnit -> 113 | [ "Data.Unit" ] -- unset' 114 | 115 | -- | Generates a handler that can convert the type indicated by the `TypeStub` to an `AttributeValue`. 116 | handler :: forall e. String -> TypeStub -> Array (BinaryOp (Expr e)) 117 | handler key = unsafePartial case _ of 118 | TypeInt -> 119 | [ binaryOp "<<<" $ exprApp (exprIdent "Deku.Attribute.prop'") 120 | [ exprString key ] 121 | , binaryOp "<<<" $ exprIdent "Data.Show.show" 122 | ] 123 | 124 | TypeString -> 125 | [ binaryOp "<<<" $ exprApp (exprIdent "Deku.Attribute.prop'") 126 | [ exprString key ] 127 | ] 128 | 129 | TypeBoolean -> 130 | [ binaryOp "<<<" $ exprApp (exprIdent "Deku.Attribute.prop'") 131 | [ exprString key ] 132 | , binaryOp "<<<" $ exprIdent "Data.Show.show" 133 | ] 134 | 135 | TypeNumber -> 136 | [ binaryOp "<<<" $ exprApp (exprIdent "Deku.Attribute.prop'") 137 | [ exprString key ] 138 | , binaryOp "<<<" $ exprIdent "Data.Show.show" 139 | ] 140 | 141 | TypeEvent _ _ -> 142 | [ binaryOp "<<<" $ exprApp (exprIdent "Deku.Attribute.cb'") 143 | [ exprString key ] 144 | , binaryOp "<<<" $ exprIdent "Deku.Attribute.cb" 145 | , binaryOp "<<<" $ exprIdent "Unsafe.Coerce.unsafeCoerce" 146 | ] 147 | -------------------------------------------------------------------------------- /codegen/src/FS.purs: -------------------------------------------------------------------------------- 1 | -- | Some helpers to generate folders and cache files. 2 | module FS where 3 | 4 | import Prelude 5 | 6 | import Control.Monad.Except (ExceptT(..), except, withExceptT) 7 | import Data.Argonaut.Core as Json 8 | import Data.Argonaut.Decode (class DecodeJson, JsonDecodeError, decodeJson, parseJson, printJsonDecodeError) 9 | import Data.Argonaut.Encode (class EncodeJson, encodeJson) 10 | import Data.Array as Array 11 | import Data.Either (Either(..)) 12 | import Data.Foldable (for_) 13 | import Data.String as String 14 | import Effect.Aff (Aff, Error, attempt, error, message) 15 | import Effect.Aff.Class (liftAff) 16 | import Fetch (fetch) 17 | import Node.Encoding (Encoding(..)) 18 | import Node.FS.Aff (mkdir, readTextFile, stat, writeTextFile) 19 | import Node.Path as Path 20 | 21 | cachedFetch 22 | :: forall @t. DecodeJson t => String -> String -> ExceptT Error Aff t 23 | cachedFetch cacheName url = withExceptT 24 | (message >>> append (cacheName <> ": ") >>> error) 25 | do 26 | file <- liftAff $ attempt $ readTextFile UTF8 cacheName 27 | text <- case file of 28 | Left _ -> do 29 | tagFetch <- ExceptT $ attempt $ fetch url {} 30 | txt <- liftAff tagFetch.text 31 | void $ liftAff $ attempt $ writeTextFile UTF8 cacheName txt 32 | pure txt 33 | 34 | Right txt -> 35 | pure txt 36 | 37 | json <- withExceptT fromJsonError $ except $ parseJson text 38 | withExceptT fromJsonError $ except $ decodeJson json :: _ t 39 | 40 | where 41 | 42 | fromJsonError :: JsonDecodeError -> Error 43 | fromJsonError = 44 | printJsonDecodeError >>> error 45 | 46 | createDir :: String -> ExceptT Error Aff Unit 47 | createDir dirs = do 48 | let 49 | paths :: Array String 50 | paths = Array.scanl (\l r -> Path.concat [ l, r ]) "." $ String.split 51 | (String.Pattern "/") 52 | dirs 53 | 54 | for_ paths \dir -> do 55 | exists <- liftAff $ attempt $ stat dir 56 | case exists of 57 | Left _ -> 58 | liftAff $ mkdir dir 59 | 60 | _ -> 61 | pure unit 62 | 63 | dump :: forall a. EncodeJson a => String -> a -> ExceptT Error Aff Unit 64 | dump file content = do 65 | let txt = Json.stringifyWithIndent 4 $ encodeJson content 66 | ExceptT $ attempt $ writeTextFile UTF8 file txt -------------------------------------------------------------------------------- /codegen/src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Except (ExceptT, runExceptT) 6 | import DOM.Common (Ctor(..), Interface, TagNS(..), mkAttribute, unSnake) 7 | import DOM.Indexed as Indexed 8 | import DOM.Parse as Parse 9 | import DOM.TypeStub (TypeStub(..)) 10 | import Data.Argonaut.Decode (class DecodeJson) 11 | import Data.Array as Array 12 | import Data.Either (blush) 13 | import Data.Foldable (for_) 14 | import Data.Maybe (Maybe(..)) 15 | import Data.Set as Set 16 | import Data.String as String 17 | import Data.Symbol (class IsSymbol, reflectSymbol) 18 | import Data.Traversable (sequence) 19 | import Data.Tuple.Nested ((/\)) 20 | import Data.Variant (Variant, inj) 21 | import Effect (Effect) 22 | import Effect.Aff (Aff, Error, launchAff_, message) 23 | import Effect.Class.Console as Console 24 | import FS as FS 25 | import Node.Path as Path 26 | import Prim.Row (class Cons) 27 | import Type.Proxy (Proxy(..)) 28 | 29 | main :: Effect Unit 30 | main = launchAff_ do 31 | r <- runExceptT generate 32 | for_ (blush r) \e -> do 33 | Console.log $ message e 34 | 35 | cachePath = "codegen/cache" :: String 36 | 37 | fetch 38 | :: forall @label @spec r1 r2 39 | . IsSymbol label 40 | => Cons label spec r1 r2 41 | => DecodeJson spec 42 | => String 43 | -> ExceptT Error Aff (Variant r2) 44 | fetch url = inj (Proxy @label) <$> do 45 | let 46 | urlFilename = Path.basename url 47 | cacheName = reflectSymbol (Proxy @label) 48 | localFilename = Path.concat [ cachePath, cacheName, urlFilename ] 49 | FS.cachedFetch @spec localFilename url 50 | 51 | generate :: ExceptT Error Aff Unit 52 | generate = do 53 | 54 | FS.createDir $ cachePath <> "/dfn" 55 | FS.createDir $ cachePath <> "/events" 56 | FS.createDir $ cachePath <> "/idlparsed" 57 | FS.createDir $ cachePath <> "/elements" 58 | 59 | html <- Parse.parse HTML <$> sequence 60 | [ fetch @"dfn" 61 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/html.json" 62 | , fetch @"dfn" 63 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/html-media-capture.json" 64 | , fetch @"dfn" 65 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/pointerlock-2.json" 66 | , fetch @"dfn" 67 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/selection-api.json" 68 | , fetch @"dfn" 69 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/css-transitions-1.json" 70 | , fetch @"dfn" 71 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/css-transitions-2.json" 72 | , fetch @"dfn" 73 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/wai-aria-1.3.json" 74 | 75 | , fetch @"events" 76 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/html.json" 77 | , fetch @"events" 78 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/touch-events.json" 79 | , fetch @"events" 80 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/uievents.json" 81 | , fetch @"events" 82 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/pointerevents3.json" 83 | , fetch @"events" 84 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/css-animations-1.json" 85 | , fetch @"events" 86 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/css-transitions-1.json" 87 | , fetch @"events" 88 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/mediacapture-handle-actions.json" 89 | , fetch @"events" 90 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/mediacapture-streams.json" 91 | , fetch @"events" 92 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/mediastream-recording.json" 93 | 94 | , fetch @"idlparsed" 95 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/dom.json" 96 | , fetch @"idlparsed" 97 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/html.json" 98 | , fetch @"idlparsed" 99 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/wai-aria-1.3.json" 100 | 101 | , fetch @"elements" 102 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/elements/html.json" 103 | ] 104 | 105 | svg <- fixSVG <<< Parse.parse SVG <$> sequence 106 | [ fetch @"dfn" 107 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/SVG2.json" 108 | , fetch @"dfn" 109 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/svg-integration.json" 110 | , fetch @"dfn" 111 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/svg-strokes.json" 112 | , fetch @"dfn" 113 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/fill-stroke-3.json" 114 | , fetch @"dfn" 115 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/filter-effects-1.json" 116 | , fetch @"dfn" 117 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/svg-animations.json" 118 | 119 | , fetch @"events" 120 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/events/svg-animations.json" 121 | 122 | , fetch @"idlparsed" 123 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/SVG2.json" 124 | , fetch @"idlparsed" 125 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/svg-animations.json" 126 | , fetch @"idlparsed" 127 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/filter-effects-1.json" 128 | , fetch @"idlparsed" 129 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/css-masking-1.json" 130 | 131 | , fetch @"elements" 132 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/elements/SVG2.json" 133 | , fetch @"elements" 134 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/elements/svg-animations.json" 135 | , fetch @"elements" 136 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/elements/filter-effects-1.json" 137 | , fetch @"elements" 138 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/elements/css-masking-1.json" 139 | ] 140 | 141 | mathml <- Parse.parse MathML <$> sequence 142 | [ fetch @"dfn" 143 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/mathml-core.json" 144 | , fetch @"dfn" 145 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/dfns/mathml4.json" 146 | 147 | , fetch @"idlparsed" 148 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/idlparsed/mathml-core.json" 149 | 150 | , fetch @"elements" 151 | "https://raw.githubusercontent.com/w3c/webref/curated/ed/elements/mathml-core.json" 152 | ] 153 | 154 | Indexed.generate html svg mathml 155 | 156 | -- SVG spec is barely useful 157 | fixSVG :: Parse.Specification -> Parse.Specification 158 | fixSVG svgBase = 159 | svgBase 160 | { interfaces = 161 | map (missingPresentationProperties) svgBase.interfaces 162 | <> [ svgText, svgPresentation ] 163 | , attributes = do 164 | let 165 | existing = Set.fromFoldable $ _.name <$> svgBase.attributes 166 | patched = flip Array.mapMaybe 167 | (svgTextMembers <> svgPresentationMembers) 168 | \member -> 169 | if Set.member member existing then Nothing 170 | else mkAttribute mempty member 171 | svgBase.attributes <> patched 172 | } 173 | 174 | missingPresentationProperties :: Interface -> Interface 175 | missingPresentationProperties = case _ of 176 | txt@{ name } 177 | | name `Array.elem` 178 | [ "SVGTextElement", "SVGTextPathElement", "SVGTspanElement" ] -> 179 | txt { bases = txt.bases <> [ svgText.ctor, svgPresentation.ctor ] } 180 | 181 | fe@{ name } | Just _ <- String.stripPrefix (String.Pattern "SVGFe") name -> 182 | fe 183 | { bases = fe.bases <> 184 | [ svgPresentation.ctor, Ctor "SVGFilterPrimitiveElement" ] 185 | } 186 | 187 | animate@{ name: "SVGAnimateElement" } -> 188 | animate { members = animate.members <> [ Ctor "by" /\ TypeString ] } 189 | 190 | animate@{ name } 191 | | Just _ <- String.stripPrefix (String.Pattern "SVGAnimate") name -> 192 | animate 193 | { bases = animate.bases <> 194 | [ svgPresentation.ctor, Ctor "SVGAnimateElement" ] 195 | } 196 | 197 | svg@{ name: "SVGSVGElement" } -> 198 | svg 199 | { members = svg.members <> 200 | [ Ctor "height" /\ TypeString 201 | , Ctor "width" /\ TypeString 202 | ] 203 | , bases = svg.bases <> [ svgPresentation.ctor ] 204 | } 205 | 206 | clippath@{ name: "SVGClipPathElement" } -> 207 | clippath 208 | { members = clippath.members <> 209 | [ Ctor "clipPathUnits" /\ TypeString ] 210 | } 211 | 212 | id -> 213 | id { bases = id.bases <> [ svgPresentation.ctor ] } 214 | 215 | svgText :: Interface 216 | svgText = 217 | { ctor: Ctor "SvgText" 218 | , name: "SvgText" 219 | , bases: [] 220 | , members: map ((_ /\ TypeString) <<< Ctor <<< unSnake) svgTextMembers 221 | } 222 | 223 | svgTextMembers :: Array String 224 | svgTextMembers = 225 | [ "alignment-baseline" 226 | , "baseline-shift" 227 | , "dominant-baseline" 228 | , "font-family" 229 | , "font-size" 230 | , "font-size-adjust" 231 | , "font-stretch" 232 | , "font-style" 233 | , "font-variant" 234 | , "font-weight" 235 | , "letter-spacing" 236 | , "text-decoration" 237 | , "word-spacing" 238 | , "writing-mode" 239 | , "unicode-bidi" 240 | ] 241 | 242 | svgPresentation :: Interface 243 | svgPresentation = 244 | { ctor: Ctor "SvgPresentation" 245 | , name: "SvgPresentation" 246 | , bases: [] 247 | , members: map ((_ /\ TypeString) <<< Ctor <<< unSnake) svgPresentationMembers 248 | } 249 | 250 | svgPresentationMembers :: Array String 251 | svgPresentationMembers = 252 | [ "pathLength" 253 | , "mask" 254 | , "opacity" 255 | , "overflow" 256 | , "clip-path" 257 | , "clip-rule" 258 | , "cursor" 259 | , "display" 260 | , "transform" 261 | , "transform-origin" 262 | , "visibility" 263 | ] -------------------------------------------------------------------------------- /deku-core/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: deku-core 3 | dependencies: 4 | - aff 5 | - arrays 6 | - catenable-lists 7 | - control 8 | - debug 9 | - effect 10 | - either 11 | - fast-vect 12 | - filterable 13 | - foldable-traversable 14 | - foreign-object 15 | - free 16 | - heterogeneous 17 | - hyrule 18 | - maybe 19 | - newtype 20 | - nullable 21 | - ordered-collections 22 | - prelude 23 | - profunctor 24 | - quickcheck 25 | - record 26 | - safe-coerce 27 | - st 28 | - strings 29 | - stringutils 30 | - tldr 31 | - transformers 32 | - typelevel-prelude 33 | - tuples 34 | - unsafe-coerce 35 | - unsafe-reference 36 | - untagged-union 37 | - web-dom 38 | - web-dom-parser 39 | - web-events 40 | - web-html 41 | - web-uievents 42 | - yoga-json 43 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Attribute.purs: -------------------------------------------------------------------------------- 1 | -- | Low-level, fine-grained control of attributes. For more high-level functions, see 2 | -- | [Deku.Attributes](https://pursuit.purescript.org/packages/purescript-deku/docs/Deku.Attributes). 3 | -- | In this module, you'll find functions to set and unset attributes and listeners on elements. 4 | -- | There's also the `xdata` function that allows you to construct an aribitrary data attribute. 5 | module Deku.Attribute (module Deku.Core) where 6 | 7 | import Deku.Core 8 | ( Attribute 9 | , Attribute' 10 | , Key(..) 11 | , Value(..) 12 | , unsafeUnAttribute 13 | , unsafeAttribute 14 | , prop' 15 | , cb' 16 | , unset' 17 | , cb 18 | , Cb(..) 19 | , xdata 20 | ) 21 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Control.purs: -------------------------------------------------------------------------------- 1 | module Deku.Control (module Deku.Core) where 2 | 3 | import Deku.Core (text_, text, elementify, portal) 4 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Do.purs: -------------------------------------------------------------------------------- 1 | -- | Rebindable `do` notation for Deku apps. See the [Deku readme](https://github.com/mikesol/purescript-deku/blob/main/README.md) and the [Deku guide](https://purescript-deku.netlify.app) for examples of where 2 | -- | to use `Deku.Do`. 3 | module Deku.Do 4 | ( bind 5 | , discard 6 | ) where 7 | 8 | import Prelude hiding (bind, discard) 9 | 10 | bind :: forall a r q. ((a -> r) -> q) -> (a -> r) -> q 11 | bind f a = f a 12 | 13 | -- we do not use any warnings for discard 14 | discard :: forall r q. ((Unit -> r) -> q) -> (Unit -> r) -> q 15 | discard = bind 16 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Effect.purs: -------------------------------------------------------------------------------- 1 | -- | Deku.Effect strives to have parity with the hooks API. 2 | -- | The difference is that all of these functions execute at the top level 3 | -- | either in `Effect` or `ST`. That allows you to use the same deku-like 4 | -- | syntax in a `do` as you would in a Deku.do block. 5 | module Deku.Effect 6 | ( useHot 7 | , useMailboxed' 8 | , useMailboxed 9 | , useRant 10 | , useState' 11 | , useRant' 12 | , useRefST 13 | , useState 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Control.Alt (alt, (<|>)) 19 | import Control.Monad.ST.Class (liftST) 20 | import Control.Monad.ST.Global (Global) 21 | import Control.Monad.ST.Internal (ST) 22 | import Control.Monad.ST.Internal as STRef 23 | import Control.Plus (empty) 24 | import Data.Tuple.Nested (type (/\), (/\)) 25 | import Effect (Effect) 26 | import FRP.Event as Event 27 | import FRP.Poll (Poll, sample, stToPoll) 28 | import FRP.Poll as Poll 29 | 30 | -- | A state hook. See [`useState`](https://purescript-deku.netlify.app/core-concepts/state#the-state-hook) in the Deku guide for example usage. 31 | useState' 32 | :: forall a 33 | . Effect ((a -> Effect Unit) /\ Poll a) 34 | useState' = do 35 | { poll, push } <- liftST Poll.create 36 | pure (push /\ poll) 37 | 38 | useState 39 | :: forall a 40 | . a 41 | -> Effect ((a -> Effect Unit) /\ Poll a) 42 | useState a = do 43 | push /\ event <- useState' 44 | pure (push /\ (pure a <|> event)) 45 | 46 | useHot 47 | :: forall a 48 | . a 49 | -> Effect (Effect Unit /\ (a -> Effect Unit) /\ Poll a) 50 | useHot a = do 51 | push /\ poll <- useState' 52 | u /\ r <- useRefST a poll 53 | pure (u /\ push /\ (stToPoll r <|> poll)) 54 | 55 | useRant :: forall a. Poll a -> Effect (Effect Unit /\ Poll a) 56 | useRant e = do 57 | { poll, unsubscribe } <- liftST $ Poll.rant e 58 | pure (liftST unsubscribe /\ poll) 59 | 60 | useRant' 61 | :: forall t a 62 | . (Poll t -> Poll a) 63 | -> Effect (Effect Unit /\ (t -> Effect Unit) /\ (Poll a)) 64 | useRant' f0 = do 65 | push /\ e <- useState' 66 | u /\ m <- useRant (f0 e) 67 | pure (u /\ push /\ m) 68 | 69 | -- | A hook that takes an initial value and an event and produces 70 | -- | a reference to the value that can be used in listeners. While the value 71 | -- | itself is mutable, it cannot be changed by the consumer of the ref. 72 | useRefST 73 | :: forall a 74 | . a 75 | -> Poll a 76 | -> Effect (Effect Unit /\ ST Global a) 77 | useRefST a e = do 78 | r <- liftST $ STRef.new a 79 | ep <- liftST $ Event.create 80 | u <- Event.subscribe (sample e ep.event) \aa -> liftST $ void $ STRef.write aa 81 | r 82 | ep.push identity 83 | pure (u /\ STRef.read r) 84 | 85 | -- | A hook that provides an event creator instead of events. Event creators turn into events when 86 | -- | given an address, at which point they listen for a payload. This is useful when listening to 87 | -- | large domains like updates of single items over large lists. It runs in _O(log n)_ time. 88 | -- | For example usage, see [`useMailboxed`](https://purescript-deku.netlify.app/core-concepts/more-hooks#use-mailboxed) in the Deku guide. 89 | useMailboxed' 90 | :: forall a b 91 | . Ord a 92 | => Effect (({ address :: a, payload :: b } -> Effect Unit) /\ (a -> Poll b)) 93 | useMailboxed' = do 94 | { poll, push } <- liftST $ Poll.mailbox 95 | pure (push /\ poll) 96 | 97 | useMailboxed 98 | :: forall a b 99 | . Ord a 100 | => { address :: a, payload :: b } 101 | -> Effect (({ address :: a, payload :: b } -> Effect Unit) /\ (a -> Poll b)) 102 | useMailboxed i = do 103 | { poll, push } <- liftST $ Poll.mailbox 104 | pure 105 | ( push /\ 106 | ( alt <$> (eq i.address >>> if _ then pure i.payload else empty) <*> 107 | poll 108 | ) 109 | ) 110 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Hooks.purs: -------------------------------------------------------------------------------- 1 | -- | Deku Hooks, modeled after React Hooks, are a way to have stateful poll in Deku. 2 | -- | At a basic level, Deku hooks look very much like their react counterparts: 3 | -- | 4 | -- | ```purescript 5 | -- | Deku.do 6 | -- | setCount /\ count <- useState 0 7 | -- | Deku.button (click' $ counter <#> add 1 >>> setCount) [ textShow' count ] 8 | -- | ``` 9 | -- | 10 | -- | Deku hooks are covered more extensively in the 11 | -- | [Deku guide section on state](https://purescript-deku.netlify.app/core-concepts/state) 12 | -- | and the [Deku guide section on collections](https://purescript-deku.netlify.app/core-concepts/collections). 13 | module Deku.Hooks 14 | ( module Deku.Core 15 | , (<#~>) 16 | , (<$~>) 17 | , cycle 18 | , guard 19 | , guardWith 20 | , switcher 21 | , switcherFlipped 22 | ) where 23 | 24 | import Prelude 25 | 26 | import Data.Maybe (Maybe(..)) 27 | import Deku.Core (Nut(..), dynOptions, useDeflect, useDyn, useDynAtBeginning, useDynAtBeginningWith, useDynAtEnd, useDynAtEndWith, useDynWith, useHot, useHotRant, useMailboxed', useMailboxedS', useMailboxed, useMailboxedS, useRant, useRant', useRef, useRefST, useSkimmed, useSplit, useState, useState', useStateTagged') 28 | import Deku.Do as Deku 29 | import FRP.Poll (Poll) 30 | 31 | guard :: Poll Boolean -> Nut -> Nut 32 | guard b e = switcher (if _ then e else mempty) b 33 | 34 | guardWith :: forall a. (Poll (Maybe a)) -> (a -> Nut) -> Nut 35 | guardWith m f = m <#~> case _ of 36 | Just x -> f x 37 | Nothing -> mempty 38 | 39 | -- | Like `bindFlipped`, except instead of working with a monad, it dips into an `Poll` 40 | -- | and creates a `Nut`. This allows you to use an event to switch between different 41 | -- | bits of DOM. This is how a [Virtual DOM](https://en.wikipedia.org/wiki/Virtual_DOM) works 42 | -- | in its most basic, unoptimized form. As a result, `switcher`, while convenient, is inefficient 43 | -- | and should be used when the content needs to be replaced wholesale. For a more efficient 44 | -- | approach, see the `useDyn` hook. 45 | switcher :: forall a. (a -> Nut) -> Poll a -> Nut 46 | switcher f poll = Deku.do 47 | skimmed <- useSkimmed poll 48 | rantedSkimmed <- useRant skimmed 49 | { value } <- useDynAtBeginningWith skimmed $ dynOptions 50 | { remove = \_ -> rantedSkimmed $> unit } 51 | 52 | f value 53 | 54 | cycle :: Poll Nut -> Nut 55 | cycle = switcher identity 56 | 57 | infixl 4 switcher as <$~> 58 | 59 | -- | A flipped version of `switcher`. 60 | switcherFlipped :: forall a. Poll a -> (a -> Nut) -> Nut 61 | switcherFlipped a b = switcher b a 62 | 63 | infixl 1 switcherFlipped as <#~> 64 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Internal/Ancestry.purs: -------------------------------------------------------------------------------- 1 | module Deku.Internal.Ancestry 2 | ( root 3 | , element 4 | , dyn 5 | , portal 6 | , fixed 7 | , toStringRepresentationInDOM 8 | , unsafeFakeAncestry 9 | , hasElementParent 10 | , unsafeCollectLineage 11 | , reconstructAncestry 12 | , Ancestry 13 | , DekuAncestry(..) 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Control.Monad.Except (except) 19 | import Data.Either (Either(..), either) 20 | import Data.List.NonEmpty (singleton) 21 | import Data.Maybe (Maybe(..)) 22 | import Data.String as String 23 | import Foreign (ForeignError(..)) 24 | import Yoga.JSON as Yoga 25 | 26 | -- Fixed and Element track total 27 | data DekuAncestry 28 | = Element Int DekuAncestry 29 | | Dyn Int DekuAncestry 30 | | Portal Int DekuAncestry 31 | | Fixed Int DekuAncestry 32 | | Root 33 | 34 | newtype AncestryHelperType = AncestryHelperType { t :: String } 35 | newtype AncestryHelperIA = AncestryHelperIA { i :: Int, a :: DekuAncestry } 36 | 37 | derive newtype instance Yoga.ReadForeign AncestryHelperType 38 | derive newtype instance Yoga.WriteForeign AncestryHelperType 39 | derive newtype instance Yoga.ReadForeign AncestryHelperIA 40 | derive newtype instance Yoga.WriteForeign AncestryHelperIA 41 | 42 | instance Yoga.ReadForeign DekuAncestry where 43 | readImpl x = do 44 | AncestryHelperType { t } <- Yoga.readImpl x 45 | case t of 46 | "Element" -> do 47 | AncestryHelperIA { i, a } <- Yoga.readImpl x 48 | pure $ Element i a 49 | "Dyn" -> do 50 | AncestryHelperIA { i, a } <- Yoga.readImpl x 51 | pure $ Dyn i a 52 | "Portal" -> do 53 | AncestryHelperIA { i, a } <- Yoga.readImpl x 54 | pure $ Portal i a 55 | "Fixed" -> do 56 | AncestryHelperIA { i, a } <- Yoga.readImpl x 57 | pure $ Fixed i a 58 | "Root" -> pure Root 59 | _ -> except $ Left 60 | (singleton $ ForeignError ("Unknown DekuAncestry type: " <> t)) 61 | 62 | instance Yoga.WriteForeign DekuAncestry where 63 | writeImpl = case _ of 64 | Element i a -> Yoga.writeImpl { i, a, t: "Element" } 65 | Dyn i a -> Yoga.writeImpl { i, a, t: "Dyn" } 66 | Portal i a -> Yoga.writeImpl { i, a, t: "Portal" } 67 | Fixed i a -> Yoga.writeImpl { i, a, t: "Fixed" } 68 | Root -> Yoga.writeImpl { t: "Root" } 69 | 70 | instance Show DekuAncestry where 71 | show (Element i a) = "Element " <> show i <> " " <> show a 72 | show (Dyn i a) = "Dyn " <> show i <> " " <> show a 73 | show (Portal i a) = "Portal " <> show i <> " " <> show a 74 | show (Fixed i a) = "Fixed " <> show i <> " " <> show a 75 | show Root = "Root" 76 | 77 | derive instance Eq DekuAncestry 78 | derive instance Ord DekuAncestry 79 | 80 | data Ancestry 81 | = RealAncestry 82 | { rep :: String, lineage :: DekuAncestry, hasElementParent :: Boolean } 83 | | FakeAncestry { rep :: String } 84 | 85 | instance Yoga.ReadForeign Ancestry where 86 | readImpl = map (either RealAncestry FakeAncestry) <<< Yoga.readImpl 87 | 88 | instance Yoga.WriteForeign Ancestry where 89 | writeImpl = toEither >>> Yoga.writeImpl 90 | where 91 | toEither (RealAncestry a) = Left a 92 | toEither (FakeAncestry a) = Right a 93 | 94 | instance Eq Ancestry where 95 | eq (RealAncestry a) (RealAncestry b) = a.rep == b.rep 96 | eq (FakeAncestry a) (FakeAncestry b) = a.rep == b.rep 97 | eq (RealAncestry a) (FakeAncestry b) = a.rep == b.rep 98 | eq (FakeAncestry a) (RealAncestry b) = a.rep == b.rep 99 | 100 | instance Ord Ancestry where 101 | compare (RealAncestry a) (RealAncestry b) = compare a.rep b.rep 102 | compare (FakeAncestry a) (FakeAncestry b) = compare a.rep b.rep 103 | compare (RealAncestry a) (FakeAncestry b) = compare a.rep b.rep 104 | compare (FakeAncestry a) (RealAncestry b) = compare a.rep b.rep 105 | 106 | instance Show Ancestry where 107 | show (RealAncestry a) = "RealAncestry " <> show a 108 | show (FakeAncestry a) = "FakeAncestry " <> show a 109 | 110 | hasElementParent :: Ancestry -> Boolean 111 | hasElementParent (RealAncestry a) = a.hasElementParent 112 | -- todo: this is not correct, as a dyn would cancel this 113 | -- not currently used, but fix it eventually 114 | hasElementParent (FakeAncestry { rep }) = String.contains (String.Pattern "e") 115 | rep 116 | 117 | root :: Ancestry 118 | root = RealAncestry { rep: "", lineage: Root, hasElementParent: false } 119 | 120 | element :: Int -> Ancestry -> Ancestry 121 | element i (RealAncestry a) = RealAncestry 122 | { rep: a.rep <> "e" <> show i 123 | , lineage: Element i a.lineage 124 | , hasElementParent: true 125 | } 126 | element i (FakeAncestry a) = FakeAncestry 127 | { rep: a.rep <> "e" <> show i } 128 | 129 | dyn :: Int -> Ancestry -> Ancestry 130 | dyn i (RealAncestry a) = RealAncestry 131 | { rep: a.rep <> "d" <> show i 132 | , lineage: Dyn i a.lineage 133 | , hasElementParent: false 134 | } 135 | dyn i (FakeAncestry a) = FakeAncestry 136 | { rep: a.rep <> "d" <> show i } 137 | 138 | portal :: Int -> Ancestry -> Ancestry 139 | portal i (RealAncestry a) = RealAncestry 140 | { rep: a.rep <> "p" <> show i 141 | , lineage: Portal i a.lineage 142 | , hasElementParent: a.hasElementParent 143 | } 144 | portal i (FakeAncestry a) = FakeAncestry 145 | { rep: a.rep <> "p" <> show i } 146 | 147 | fixed :: Int -> Ancestry -> Ancestry 148 | fixed i (RealAncestry a) = RealAncestry 149 | { rep: a.rep <> "f" <> show i 150 | , lineage: Fixed i a.lineage 151 | , hasElementParent: a.hasElementParent 152 | } 153 | fixed i (FakeAncestry a) = FakeAncestry 154 | { rep: a.rep <> "f" <> show i } 155 | 156 | toStringRepresentationInDOM :: Ancestry -> String 157 | toStringRepresentationInDOM (RealAncestry { rep }) = rep 158 | toStringRepresentationInDOM (FakeAncestry { rep }) = rep 159 | 160 | unsafeFakeAncestry :: String -> Ancestry 161 | unsafeFakeAncestry rep = FakeAncestry { rep } 162 | 163 | unsafeCollectLineage :: Ancestry -> Maybe DekuAncestry 164 | unsafeCollectLineage (RealAncestry { lineage }) = Just lineage 165 | unsafeCollectLineage (FakeAncestry _) = Nothing 166 | 167 | reconstructAncestry :: DekuAncestry -> Ancestry 168 | reconstructAncestry (Element i a) = element i $ reconstructAncestry a 169 | reconstructAncestry (Dyn i a) = dyn i $ reconstructAncestry a 170 | reconstructAncestry (Portal i a) = portal i $ reconstructAncestry a 171 | reconstructAncestry (Fixed i a) = fixed i $ reconstructAncestry a 172 | reconstructAncestry Root = root 173 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Internal/Entities.purs: -------------------------------------------------------------------------------- 1 | module Deku.Internal.Entities where 2 | 3 | import Unsafe.Coerce (unsafeCoerce) 4 | 5 | data DekuElement 6 | 7 | toDekuElement :: forall @a. a -> DekuElement 8 | toDekuElement = unsafeCoerce 9 | 10 | fromDekuElement :: forall @a. DekuElement -> a 11 | fromDekuElement = unsafeCoerce 12 | 13 | data DekuText 14 | 15 | toDekuText :: forall @a. a -> DekuText 16 | toDekuText = unsafeCoerce 17 | 18 | fromDekuText :: forall @a. DekuText -> a 19 | fromDekuText = unsafeCoerce 20 | 21 | data DekuEvent 22 | 23 | toDekuEvent :: forall @a. a -> DekuEvent 24 | toDekuEvent = unsafeCoerce 25 | 26 | fromDekuEvent :: forall @a. DekuEvent -> a 27 | fromDekuEvent = unsafeCoerce 28 | 29 | newtype DekuChild = DekuChild DekuElement 30 | newtype DekuParent = DekuParent DekuElement -------------------------------------------------------------------------------- /deku-core/src/Deku/Pursx.js: -------------------------------------------------------------------------------- 1 | import * as htmlparser2 from "htmlparser2"; 2 | 3 | export const createParser = (onOpenTag) => (onText) => (onCloseTag) => () => { 4 | return new htmlparser2.Parser({ 5 | onopentag(tagname, attributes) { 6 | onOpenTag(tagname)(attributes)(); 7 | }, 8 | ontext(text) { 9 | onText(text)(); 10 | }, 11 | onclosetag(tagname) { 12 | onCloseTag(tagname)(); 13 | }, 14 | }); 15 | }; 16 | 17 | export const write = (parser) => (data) => () => parser.write(data); 18 | 19 | export const end = (parser) => () => parser.end(); 20 | 21 | export const splitOnDelimiter = (delimiter) => (str) => 22 | str 23 | .split(new RegExp(`(${delimiter}[^${delimiter}]+${delimiter})`)) 24 | .map((part) => 25 | part.replace(new RegExp(`^${delimiter}|${delimiter}$`, "g"), "") 26 | ); 27 | 28 | export const removeOuterTags = (html) => 29 | html.replace(/^[^>]*>([\s\S]*?)<[^<]*$/, '$1'); 30 | 31 | export const getOuterTagInfo = (html) => { 32 | const result = { 33 | tagName: '', 34 | attributes: {} 35 | }; 36 | 37 | // Regular expression to match the outermost tag and capture the tag name and attributes 38 | const tagMatch = html.match(/^<(\w+)([^>]*)>/); 39 | 40 | if (tagMatch) { 41 | result.tagName = tagMatch[1]; 42 | 43 | // Extracting attributes 44 | const attrString = tagMatch[2]; 45 | const attrRegex = /(\w+)=["']([^"']*)["']/g; 46 | let match; 47 | 48 | while ((match = attrRegex.exec(attrString)) !== null) { 49 | result.attributes[match[1]] = match[2]; 50 | } 51 | } 52 | 53 | return result; 54 | } 55 | -------------------------------------------------------------------------------- /deku-core/src/Deku/Pursx.purs: -------------------------------------------------------------------------------- 1 | module Deku.Pursx 2 | ( Attributable 3 | , AttributableE 4 | , PursxAllowable 5 | , PursxInfo(..) 6 | , PursxInfoMap 7 | , class PursxSubstitutions 8 | , class PursxableToMap 9 | , class PursxableToMapRL 10 | , pursxableToMap 11 | , pursxableToMapRL 12 | , lenientPursx' 13 | , lenientPursx 14 | , pursx' 15 | , pursx 16 | ) where 17 | 18 | import Prelude 19 | 20 | import Control.Monad.ST (ST, run) 21 | import Control.Monad.ST.Class (liftST) 22 | import Control.Monad.ST.Ref as STRef 23 | import Data.Either (Either(..), isLeft, isRight) 24 | import Data.Exists (Exists, mkExists, runExists) 25 | import Data.FoldableWithIndex (foldlWithIndex) 26 | import Data.List (List(..), (:)) 27 | import Data.Map (Map) 28 | import Data.Map as Map 29 | import Data.Maybe (Maybe(..), fromMaybe) 30 | import Data.Newtype (un) 31 | import Data.Symbol (class IsSymbol, reflectSymbol) 32 | import Data.Tuple (uncurry) 33 | import Data.Tuple.Nested ((/\)) 34 | import Deku.Core (Attribute, DOMInterpret(..), Nut(..), PSR(..), attributeAtYourOwnRisk, elementify, text_) 35 | import Deku.Internal.Region (StaticRegion(..)) 36 | import Deku.PursxParser (AttributeVerb, ElementVerb, PursxState, PxElt'P) 37 | import Effect.Uncurried (mkEffectFn2, runEffectFn2) 38 | import FRP.Poll (Poll) 39 | import Foreign.Object (Object, toUnfoldable) 40 | import Foreign.Object as Object 41 | import Prim.Row as Row 42 | import Prim.RowList as RL 43 | import Record as Record 44 | import TLDR.Combinators.Class (class Parse) 45 | import TLDR.List as L 46 | import TLDR.Result as R 47 | import Type.Equality (class TypeEquals, to) 48 | import Type.Proxy (Proxy(..)) 49 | import Unsafe.Coerce (unsafeCoerce) 50 | 51 | data Htmlparser2 52 | 53 | foreign import createParser 54 | :: forall r 55 | . (String -> Object String -> ST r Unit) 56 | -> (String -> ST r Unit) 57 | -> (String -> ST r Unit) 58 | -> ST r Htmlparser2 59 | 60 | foreign import write :: forall r. Htmlparser2 -> String -> ST r Unit 61 | 62 | foreign import end :: forall r. Htmlparser2 -> ST r Unit 63 | 64 | newtype Attributable r = Attributable (Poll (Attribute r)) 65 | 66 | unsafeCastAttributable :: forall a b. Attributable a -> Attributable b 67 | unsafeCastAttributable = unsafeCoerce 68 | 69 | unAttribuable :: forall x. Attributable x -> Poll (Attribute x) 70 | unAttribuable (Attributable y) = y 71 | 72 | type AttributableE = Exists Attributable 73 | 74 | type PursxAllowable = Either AttributableE Nut 75 | 76 | type PursxInfoMap = Map String PursxAllowable 77 | data PursxInfo = PursxInfo String PursxInfoMap 78 | 79 | instance Semigroup PursxInfo where 80 | append (PursxInfo a1 b1) (PursxInfo a2 b2) = PursxInfo (a1 <> a2) 81 | (Map.union b1 b2) 82 | 83 | instance Monoid PursxInfo where 84 | mempty = PursxInfo mempty Map.empty 85 | 86 | xa :: forall r. Poll (Attribute r) -> AttributableE 87 | xa a = mkExists (Attributable a) 88 | 89 | useExistingAtt 90 | :: forall e. PursxInfoMap -> String -> String -> Poll (Attribute e) 91 | useExistingAtt mp k v = fromMaybe (pure $ attributeAtYourOwnRisk k v) z 92 | where 93 | z 94 | | k == "data-pursx-att" = case Map.lookup v mp of 95 | Just (Left o) -> Just $ unAttribuable $ runExists unsafeCastAttributable 96 | o 97 | _ -> Nothing 98 | | otherwise = Nothing 99 | 100 | onOpenTag 101 | :: forall r 102 | . PursxInfoMap 103 | -> STRef.STRef r (List (Array Nut -> Nut)) 104 | -> String 105 | -> Object String 106 | -> ST r Unit 107 | onOpenTag info stack name attributes = do 108 | stackValue <- STRef.read stack 109 | let 110 | backup = elementify Nothing name 111 | ( map (uncurry (useExistingAtt info)) $ toUnfoldable 112 | attributes 113 | ) 114 | nut 115 | | name == "pursx" = case (Object.lookup "data-pursx-elt" attributes) of 116 | Just v -> case Map.lookup v info of 117 | Just (Right n) -> pure n 118 | _ -> backup 119 | _ -> backup 120 | | otherwise = backup 121 | void $ STRef.write 122 | (nut : stackValue) 123 | stack 124 | 125 | foreign import getOuterTagInfo :: String -> { 126 | tagName:: String, 127 | attributes:: Object String 128 | } 129 | 130 | optimizedPursx 131 | :: String -> Nut 132 | optimizedPursx html = do 133 | let outerInfo = getOuterTagInfo html 134 | let innerStuff = removeOuterTags html 135 | elementify Nothing outerInfo.tagName 136 | ( map (\(k /\ v) -> (pure $ attributeAtYourOwnRisk k v)) $ toUnfoldable 137 | outerInfo.attributes 138 | ) 139 | [ Nut $ mkEffectFn2 \psr di -> do 140 | anchor <- liftST $ (un StaticRegion (un PSR psr).region).end 141 | runEffectFn2 (un DOMInterpret di).setInnerHTML innerStuff anchor 142 | ] 143 | 144 | onText 145 | :: forall r 146 | . PursxInfoMap 147 | -> STRef.STRef r (List (Array Nut -> Nut)) 148 | -> String 149 | -> ST r Unit 150 | onText _ stack text = do 151 | stackValue <- STRef.read stack 152 | void $ case stackValue of 153 | Nil -> STRef.write (pure (pure nut)) stack 154 | f : rest -> do 155 | STRef.write ((\i -> f ([ nut ] <> i)) : rest) stack 156 | where 157 | nut = text_ text 158 | 159 | onCloseTag 160 | :: forall r 161 | . PursxInfoMap 162 | -> STRef.STRef r (List (Array Nut -> Nut)) 163 | -> String 164 | -> ST r Unit 165 | onCloseTag _ stack _ = do 166 | stackValue <- STRef.read stack 167 | void $ case stackValue of 168 | -- uh oh 169 | Nil -> pure unit 170 | -- fine, we're done 171 | _ : Nil -> pure unit 172 | f : g : rest -> do 173 | void $ STRef.write ((\i -> g ([ f [] ] <> i)) : rest) stack 174 | 175 | foreign import removeOuterTags :: String -> String 176 | 177 | purs :: PursxInfo -> Nut 178 | purs (PursxInfo html i) = if Map.isEmpty i then optimizedPursx html else run do 179 | r <- STRef.new Nil 180 | parser <- createParser (onOpenTag i r) (onText i r) (onCloseTag i r) 181 | write parser html 182 | end parser 183 | o <- STRef.read r 184 | pure $ case o of 185 | Nil -> mempty 186 | f : _ -> f [] 187 | 188 | -- delimiter -- str -- split 189 | foreign import splitOnDelimiter :: String -> String -> Array String 190 | 191 | class PursxableToMap r where 192 | pursxableToMap :: { | r } -> Map String PursxAllowable 193 | 194 | instance (RL.RowToList r rl, PursxableToMapRL rl r) => PursxableToMap r where 195 | pursxableToMap = pursxableToMapRL (Proxy :: _ rl) 196 | 197 | class PursxableToMapRL (rl :: RL.RowList Type) r where 198 | pursxableToMapRL :: Proxy rl -> { | r } -> Map String PursxAllowable 199 | 200 | instance PursxableToMapRL RL.Nil r where 201 | pursxableToMapRL _ _ = Map.empty 202 | 203 | instance 204 | ( Row.Cons k Nut r' r 205 | , IsSymbol k 206 | , PursxableToMapRL rest r 207 | ) => 208 | PursxableToMapRL (RL.Cons k Nut rest) r where 209 | pursxableToMapRL _ r = Map.insert (reflectSymbol (Proxy :: _ k)) 210 | (Right (Record.get (Proxy :: _ k) r)) 211 | (pursxableToMapRL (Proxy :: _ rest) r) 212 | else instance 213 | ( TypeEquals z (Poll (Attribute q)) 214 | , Row.Cons k z r' r 215 | , IsSymbol k 216 | , PursxableToMapRL rest r 217 | ) => 218 | PursxableToMapRL (RL.Cons k z rest) r where 219 | pursxableToMapRL _ r = Map.insert (reflectSymbol (Proxy :: _ k)) 220 | (Left (xa (to ((Record.get (Proxy :: _ k) r) :: z)))) 221 | (pursxableToMapRL (Proxy :: _ rest) r) 222 | 223 | lenientPursx' 224 | :: forall r. PursxableToMap r => String -> String -> { | r } -> Nut 225 | lenientPursx' verb html r = purs $ PursxInfo htmlified mapified 226 | where 227 | split = splitOnDelimiter verb html 228 | ibab i b a = 229 | if i `mod` 2 == 0 then b <> a 230 | else if (isLeft <$> Map.lookup a mapified) == Just true then b 231 | <> " data-pursx-att=\"" 232 | <> a 233 | <> "\" " 234 | else if (isRight <$> Map.lookup a mapified) == Just true then b 235 | <> " a 237 | <> "\">" 238 | else b 239 | htmlified = foldlWithIndex ibab "" split 240 | mapified = pursxableToMap r 241 | 242 | lenientPursx :: forall r. PursxableToMap r => String -> { | r } -> Nut 243 | lenientPursx = lenientPursx' "~" 244 | 245 | -- strict 246 | class PursxSubstitutions 247 | :: RL.RowList Type -> Row Type -> Constraint 248 | class PursxSubstitutions nostr str | nostr -> str 249 | 250 | instance PursxSubstitutions RL.Nil () 251 | 252 | instance 253 | ( Row.Cons k Nut d r 254 | , PursxSubstitutions c d 255 | ) => 256 | PursxSubstitutions (RL.Cons k ElementVerb c) r 257 | 258 | instance 259 | ( Row.Cons k (Poll (Attribute q)) d r 260 | , PursxSubstitutions c d 261 | ) => 262 | PursxSubstitutions (RL.Cons k AttributeVerb c) 263 | r 264 | 265 | pursx' 266 | :: forall @verb (@html :: Symbol) r0 rl0 h t r rl 267 | . IsSymbol html 268 | => IsSymbol verb 269 | => Parse html (PxElt'P verb) (PursxState () L.Nil) (R.Success h t) 270 | (PursxState r0 L.Nil) 271 | => RL.RowToList r0 rl0 272 | => RL.RowToList r rl 273 | => PursxSubstitutions rl0 r 274 | => PursxableToMap r 275 | => { | r } 276 | -> Nut 277 | pursx' = lenientPursx' (reflectSymbol (Proxy :: _ verb)) 278 | (reflectSymbol (Proxy :: _ html)) 279 | 280 | pursx 281 | :: forall (@html :: Symbol) r0 rl0 h t r rl 282 | . IsSymbol html 283 | => Parse html (PxElt'P "~") (PursxState () L.Nil) (R.Success h t) 284 | (PursxState r0 L.Nil) 285 | => RL.RowToList r0 rl0 286 | => RL.RowToList r rl 287 | => PursxSubstitutions rl0 r 288 | => PursxableToMap r 289 | => { | r } 290 | -> Nut 291 | pursx = lenientPursx' (reflectSymbol (Proxy :: _ "~")) 292 | (reflectSymbol (Proxy :: _ html)) 293 | -------------------------------------------------------------------------------- /deku-core/src/Deku/PursxParser.purs: -------------------------------------------------------------------------------- 1 | module Deku.PursxParser where 2 | 3 | import Prelude 4 | 5 | import Prim.Row as Row 6 | import Prim.TypeError (Text) 7 | import TLDR.Combinators (type ($>), type (<$), type (||)) 8 | import TLDR.Combinators as C 9 | import TLDR.Combinators.Class (class ModifyState, class Parse, class ShowParser, SP1, SP2, SP3) 10 | import TLDR.List as L 11 | import TLDR.Matchers (type (|||), type (&&&)) 12 | import TLDR.Matchers as M 13 | import TLDR.Result as R 14 | import TLDR.Sugar as S 15 | import Type.Proxy (Proxy) 16 | 17 | data AttributeVerb 18 | 19 | data ElementVerb 20 | 21 | data NutVerb 22 | 23 | data PursxState :: Row Type -> Type -> Type 24 | data PursxState verbed tagged 25 | 26 | data PursxAttributeName :: Type -> Type 27 | data PursxAttributeName a 28 | 29 | instance 30 | ShowParser (SP1 "PursxAttributeName" a) doc => 31 | ShowParser PursxAttributeName doc 32 | 33 | data PursxElementName :: Type -> Type 34 | data PursxElementName a 35 | 36 | instance 37 | ShowParser (SP1 "PursxElementName" a) doc => 38 | ShowParser PursxElementName doc 39 | 40 | data TagClosingCheck :: Type -> Type 41 | data TagClosingCheck a 42 | 43 | instance 44 | ShowParser (SP1 "TagClosingCheck" a) doc => 45 | ShowParser TagClosingCheck doc 46 | 47 | data TagOpeningCheck :: Type -> Type 48 | data TagOpeningCheck a 49 | 50 | instance 51 | ShowParser (SP1 "TagOpeningCheck" a) doc => 52 | ShowParser TagOpeningCheck doc 53 | 54 | instance 55 | Row.Cons name AttributeVerb i o => 56 | ModifyState sym 57 | (PursxAttributeName (PursxAttribute (Proxy name))) 58 | (PursxState i t) 59 | (PursxState o t) 60 | 61 | instance 62 | Row.Cons name ElementVerb i o => 63 | ModifyState sym 64 | (PursxElementName (PursxElement (Proxy name))) 65 | (PursxState i t) 66 | (PursxState o t) 67 | 68 | instance 69 | ModifyState sym 70 | (TagClosingCheck (TagName name)) 71 | (PursxState i (L.Cons name t)) 72 | (PursxState i t) 73 | 74 | instance 75 | ModifyState sym 76 | (TagOpeningCheck (TagName name)) 77 | (PursxState i t) 78 | (PursxState i (L.Cons name t)) 79 | 80 | instance 81 | ModifyState sym 82 | TagSelfClosing 83 | (PursxState i (L.Cons h t)) 84 | (PursxState i t) 85 | 86 | type AttributeNameHead'M = M.MatchAlpha 87 | type AttributeNameTail'M = M.MatchAlphanumeric ||| M.Literal "-" 88 | ||| M.Literal "_" 89 | ||| M.Literal "." 90 | ||| M.Literal ":" 91 | 92 | type AttributeName'M = AttributeNameHead'M &&& M.Many AttributeNameTail'M 93 | 94 | data AttributeName :: Type -> Type 95 | data AttributeName a 96 | 97 | instance 98 | ShowParser (SP1 "AttributeName" a) doc => 99 | ShowParser (AttributeName a) doc 100 | 101 | type AttributeName'P = AttributeName AttributeName'M 102 | 103 | testAttributeNameSuccess 104 | :: forall @toParse @h @t 105 | . Parse toParse AttributeName'P Unit (R.Success h t) Unit 106 | => Unit 107 | testAttributeNameSuccess = unit 108 | 109 | testAttributeNameSuccess0 = 110 | testAttributeNameSuccess @"""hello""" @(AttributeName (Proxy "hello")) @"" 111 | :: Unit 112 | 113 | data AttributeValue :: Type -> Type 114 | data AttributeValue a 115 | 116 | instance 117 | ShowParser (SP1 "AttributeValue" a) doc => 118 | ShowParser (AttributeValue a) doc 119 | 120 | type QuotedAttributeValue'P q = 121 | S.Bracket 122 | (M.Literal q) 123 | ( AttributeValue 124 | ( M.Many 125 | ( (M.Literal "\\" &&& M.Literal q) ||| 126 | (M.Except (M.Literal q) M.Any) 127 | ) 128 | ) 129 | ) 130 | (M.Literal q) 131 | 132 | type AttributeValue'P = 133 | QuotedAttributeValue'P "\"" || QuotedAttributeValue'P "'" 134 | 135 | data AttributePair :: Type -> Type -> Type 136 | data AttributePair a b 137 | 138 | instance 139 | ShowParser (SP2 "AttributePair" a b) doc => 140 | ShowParser (AttributePair a b) doc 141 | 142 | type AttributePair'P = AttributePair AttributeName'P 143 | ( (M.Many M.MatchWhitespace &&& M.Literal "=" &&& M.Many M.MatchWhitespace) $> 144 | AttributeValue'P 145 | ) 146 | 147 | testAttributePairSuccess 148 | :: forall @toParse @h @t 149 | . Parse toParse AttributePair'P Unit (R.Success h t) Unit 150 | => Unit 151 | testAttributePairSuccess = unit 152 | 153 | testAttributePairSuccess0 = 154 | testAttributePairSuccess @"""hello="world" """ 155 | @( AttributePair (AttributeName (Proxy "hello")) 156 | (AttributeValue (Proxy "world")) 157 | ) 158 | @" " :: Unit 159 | 160 | testAttributePairSuccess1 = 161 | testAttributePairSuccess @"""hello ="wo\"rld" """ 162 | @( AttributePair (AttributeName (Proxy "hello")) 163 | (AttributeValue (Proxy "wo\\\"rld")) 164 | ) 165 | @" " :: Unit 166 | 167 | testAttributePairSuccess2 = 168 | testAttributePairSuccess @"""hello= 'world' """ 169 | @( AttributePair (AttributeName (Proxy "hello")) 170 | (AttributeValue (Proxy "world")) 171 | ) 172 | @" " :: Unit 173 | 174 | data PursxAttribute :: Type -> Type 175 | data PursxAttribute a 176 | 177 | instance 178 | ShowParser (SP1 "PursxAttribute" a) doc => 179 | ShowParser (PursxAttribute a) doc 180 | 181 | type PursxAttribute'P verb = S.Bracket 182 | (M.Literal verb) 183 | ( C.ModifyStateAfterSuccessWithResult PursxAttributeName 184 | (PursxAttribute (M.Some (M.Except (M.Literal verb) M.Any))) 185 | ) 186 | (M.Literal verb) 187 | 188 | data PursxElement :: Type -> Type 189 | data PursxElement a 190 | 191 | instance 192 | ShowParser (SP1 "PursxElement" a) doc => 193 | ShowParser (PursxElement a) doc 194 | 195 | type PursxElement'P verb = S.Bracket 196 | (M.Literal verb) 197 | ( C.ModifyStateAfterSuccessWithResult PursxElementName 198 | (PursxElement (M.Some (M.Except (M.Literal verb) M.Any))) 199 | ) 200 | (M.Literal verb) 201 | 202 | type Attributes'P verb = 203 | C.SepBy 204 | (PursxAttribute'P verb || AttributePair'P) 205 | (M.Some M.MatchWhitespace) 206 | 207 | testAttributesSuccess 208 | :: forall @toParse @h @t @o 209 | . Parse toParse (Attributes'P "~") (PursxState () L.Nil) (R.Success h t) o 210 | => Unit 211 | testAttributesSuccess = unit 212 | 213 | testAttributesSuccess0 = 214 | testAttributesSuccess @"""hello="world" goodbye='world'""" 215 | @( L.Cons 216 | ( AttributePair (AttributeName (Proxy "hello")) 217 | (AttributeValue (Proxy "world")) 218 | ) 219 | 220 | ( L.Cons 221 | ( AttributePair (AttributeName (Proxy "goodbye")) 222 | (AttributeValue (Proxy "world")) 223 | ) 224 | L.Nil 225 | ) 226 | ) 227 | @"" 228 | @(PursxState () L.Nil) :: Unit 229 | 230 | testAttributesSuccess1 = 231 | testAttributesSuccess @"""hello="world" ~funtimes~ goodbye='world'""" 232 | @( L.Cons 233 | ( AttributePair (AttributeName (Proxy "hello")) 234 | (AttributeValue (Proxy "world")) 235 | ) 236 | 237 | ( L.Cons 238 | (PursxAttribute (Proxy "funtimes")) 239 | ( L.Cons 240 | ( AttributePair (AttributeName (Proxy "goodbye")) 241 | (AttributeValue (Proxy "world")) 242 | ) 243 | L.Nil 244 | ) 245 | ) 246 | ) 247 | @"" 248 | @(PursxState (funtimes :: AttributeVerb) L.Nil) :: Unit 249 | 250 | type TagNameHead'M = M.MatchAlpha 251 | type TagNameTail'M = M.MatchAlphanumeric ||| M.Literal "-" 252 | 253 | type TagName'M = TagNameHead'M &&& M.Many TagNameTail'M 254 | 255 | data TagName :: Type -> Type 256 | data TagName a 257 | 258 | instance ShowParser (SP1 "TagName" a) doc => ShowParser (TagName a) doc 259 | 260 | type TagName'P = TagName TagName'M 261 | 262 | data TagSelfClosing 263 | 264 | instance ShowParser TagSelfClosing (Text "TagSelfClosing") 265 | 266 | type TagSelfClosing'P = C.ModifyStateAfterSuccessOnConstant TagSelfClosing 267 | ((S.L2 "/" ">") $> (C.Const TagSelfClosing)) 268 | 269 | data TagClosing :: Type -> Type -> Type 270 | data TagClosing children tag 271 | 272 | instance 273 | ShowParser (SP2 "TagClosing" a b) doc => 274 | ShowParser (TagClosing a b) doc 275 | 276 | type NoCloseNoVerb verb = M.Many (M.Except (S.L1 "<" ||| S.L1 verb) M.Any) 277 | 278 | type TagClosing'P elt verb = TagClosing 279 | ( S.Bracket (S.L1 ">") 280 | ( S.Bracket (NoCloseNoVerb verb) 281 | ( C.SepBy 282 | (Comment'P || elt || PursxElement'P verb) 283 | (NoCloseNoVerb verb) 284 | ) 285 | (NoCloseNoVerb verb) 286 | ) 287 | (S.L2 "<" "/") 288 | ) 289 | (C.ModifyStateAfterSuccessWithResult TagClosingCheck TagName'P <$ S.L1 ">") 290 | 291 | data Comment 292 | instance ShowParser Comment (Text "Comment") 293 | 294 | type CommentEnd = S.L3 "-" "-" ">" 295 | type Comment'P = ((S.L4 "<" "!" "-" "-" &&& M.Many (M.Except CommentEnd M.Any) &&& CommentEnd) $> (C.Const Comment)) 296 | 297 | data PxElt :: Type -> Type -> Type -> Type 298 | data PxElt tag atts next 299 | 300 | instance 301 | ShowParser (SP3 "PxElt" a b c) doc => 302 | ShowParser (PxElt a b c) doc 303 | 304 | type PxElt'P verb = S.WS 305 | ( C.Fix 306 | ( pxElt :: 307 | PxElt 308 | ( S.L1 "<" $> 309 | (C.ModifyStateAfterSuccessWithResult TagOpeningCheck TagName'P) 310 | ) 311 | ((M.Some M.MatchWhitespace $> Attributes'P verb) || (C.Const L.Nil)) 312 | ( M.Many M.MatchWhitespace $> 313 | (TagSelfClosing'P || TagClosing'P (Proxy "pxElt") verb) 314 | ) 315 | ) 316 | ) 317 | 318 | testSuccess 319 | :: forall @toParse @t @o h 320 | . Parse toParse (PxElt'P "~") (PursxState () L.Nil) (R.Success h t) o 321 | => Unit 322 | testSuccess = unit 323 | 324 | testSuccess0 = 325 | testSuccess @"""
""" @"" @(PursxState () L.Nil) 326 | :: Unit 327 | 328 | testSuccess1 = 329 | testSuccess @"""
""" @"" @(PursxState () L.Nil) 330 | :: Unit 331 | 332 | testSuccess2 = 333 | testSuccess @"""""" @"" @(PursxState () L.Nil) 334 | :: Unit 335 | 336 | testSuccess3 = 337 | testSuccess @"""
""" @"" @(PursxState () L.Nil) 338 | :: Unit 339 | 340 | testSuccess4 = 341 | testSuccess @"""
~zz~
""" @"" 342 | @(PursxState (zz :: ElementVerb) L.Nil) 343 | :: Unit 344 | 345 | testSuccess5 = 346 | testSuccess @"""
""" @"" @(PursxState () L.Nil) 347 | :: Unit 348 | 349 | testSuccess6 = 350 | testSuccess 351 | @""" 352 |
353 |
354 |

Main Title

355 |
356 | 357 |
358 |
359 |

Section Title

360 |

This is a paragraph inside a section.

361 |

Another paragraph with a link.

362 |
363 |
364 |

Article Title

365 |

This is an article paragraph.

366 |
367 |

Article footer content.

368 |
369 |
370 |
371 | 374 |
375 | """ 376 | @"" 377 | @(PursxState () L.Nil) 378 | :: Unit -------------------------------------------------------------------------------- /deku-core/src/Deku/PxTypes.purs: -------------------------------------------------------------------------------- 1 | module Deku.PxTypes where 2 | 3 | data PxAtt 4 | data PxNut -------------------------------------------------------------------------------- /deku-core/src/Deku/UnsafeDOM.js: -------------------------------------------------------------------------------- 1 | const cbs = new WeakMap(); 2 | 3 | export const pushCb = ( name, cb, el ) => 4 | { 5 | var ns = cbs.get( el ); 6 | if( ns != null ) 7 | ns[ name ] = cb; 8 | else 9 | cbs.set( el, { [name] : cb } ); 10 | }; 11 | 12 | export const popCb = ( name, el ) => 13 | { 14 | var ns = cbs.get( el ); 15 | if( ns == null ) 16 | return null; 17 | else 18 | { 19 | var result = ns[ name ] ?? null; 20 | ns[ name ] = undefined; 21 | return result; 22 | } 23 | }; 24 | 25 | export const createElement = (t) => document.createElement(t); 26 | export const after = ( cs, t) => t.after.apply( t, cs ); 27 | export const prepend = ( cs, t ) => t.prepend.apply( t, cs ); 28 | 29 | export const createElementNS = (ns, t) => document.createElementNS(ns, t); 30 | export const createText = ( t ) => document.createTextNode( t ); 31 | export const createDocumentFragment = () => document.createDocumentFragment(); 32 | 33 | export const setTextContent = (value, node) => (node.textContent = value); 34 | 35 | export const addEventListener = (type, listener, useCapture, target) => 36 | target.addEventListener(type, listener, useCapture); 37 | 38 | export const removeEventListener = (type, listener, useCapture, target) => 39 | target.removeEventListener(type, listener, useCapture); 40 | 41 | export const eventListener = (fn) => fn; 42 | -------------------------------------------------------------------------------- /deku-core/src/Deku/UnsafeDOM.purs: -------------------------------------------------------------------------------- 1 | -- maybe remove this module in favor of just using Web.DOM 2 | module Deku.UnsafeDOM where 3 | 4 | import Prelude 5 | 6 | import Data.Nullable (Nullable) 7 | import Effect (Effect) 8 | import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4) 9 | import Web.DOM (Element, Node, Text) 10 | import Web.Event.Event (Event, EventType) 11 | import Web.Event.EventTarget (EventListener, EventTarget) 12 | 13 | foreign import createElement :: EffectFn1 String Element 14 | foreign import createElementNS :: EffectFn2 String String Element 15 | foreign import createDocumentFragment :: Effect Element 16 | 17 | foreign import createText :: EffectFn1 String Text 18 | foreign import setTextContent :: EffectFn2 String Node Unit 19 | 20 | foreign import pushCb :: EffectFn3 String EventListener Element Unit 21 | foreign import popCb :: EffectFn2 String Element (Nullable EventListener) 22 | 23 | foreign import after :: EffectFn2 (Array Node) Node Unit 24 | foreign import prepend :: EffectFn2 (Array Node) Node Unit 25 | 26 | foreign import addEventListener 27 | :: EffectFn4 EventType 28 | EventListener 29 | Boolean 30 | EventTarget 31 | Unit 32 | 33 | -- | Removes a listener to an event target. The boolean argument indicates 34 | -- | whether the listener should be removed for the "capture" phase. 35 | foreign import removeEventListener 36 | :: EffectFn4 EventType 37 | EventListener 38 | Boolean 39 | EventTarget 40 | Unit 41 | 42 | foreign import eventListener 43 | :: forall a 44 | . EffectFn1 (EffectFn1 Event a) 45 | EventListener 46 | -------------------------------------------------------------------------------- /deku-css/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: deku-css 3 | dependencies: 4 | - deku-core 5 | - hyrule 6 | - css -------------------------------------------------------------------------------- /deku-css/src/Deku/CSS.purs: -------------------------------------------------------------------------------- 1 | -- | Exports a single function, `render`, which takes a `CSS` value from `purescript-css` 2 | -- | and returns a `String` of CSS that can be used with `style_` from `Deku.Attributes`. 3 | module Deku.CSS (render) where 4 | 5 | import Prelude 6 | 7 | import CSS (CSS, Key, Rule(..), Value, collect, runS) 8 | import Data.Either (Either, hush) 9 | import Data.Filterable (filterMap) 10 | import Data.Maybe (Maybe(..)) 11 | import Data.String (joinWith) 12 | import Data.Tuple (Tuple(..)) 13 | import Foreign.Object (Object) 14 | import Foreign.Object as Object 15 | 16 | -- | Takes a `CSS` value from `purescript-css` 17 | -- | and returns a `String` of CSS that can be used with `style_` from `Deku.Attributes`. 18 | render ∷ CSS → String 19 | render = toString 20 | <<< rules 21 | <<< runS 22 | where 23 | toString ∷ Object String → String 24 | toString = joinWith "; " <<< Object.foldMap 25 | (\key val → [ key <> ": " <> val ]) 26 | 27 | rules ∷ Array Rule → Object String 28 | rules rs = Object.fromFoldable properties 29 | where 30 | properties ∷ Array (Tuple String String) 31 | properties = filterMap property rs >>= collect >>> rights 32 | 33 | property ∷ Rule → Maybe (Tuple (Key Unit) Value) 34 | property (Property k v) = Just (Tuple k v) 35 | property _ = Nothing 36 | 37 | rights ∷ ∀ a b. Array (Either a b) → Array b 38 | rights = filterMap hush -------------------------------------------------------------------------------- /deku-dom/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: deku-dom 3 | dependencies: 4 | - deku-core 5 | - hyrule 6 | - web-html 7 | - web-uievents 8 | - web-pointerevents 9 | - web-touchevents -------------------------------------------------------------------------------- /deku-dom/src/Deku/DOM/Combinators.purs: -------------------------------------------------------------------------------- 1 | module Deku.DOM.Combinators where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable (for_) 6 | import Data.Maybe (Maybe) 7 | import Data.Symbol (class IsSymbol, reflectSymbol) 8 | import Deku.Attribute (Attribute, unsafeAttribute, unset') 9 | import Deku.DOM.Self as Self 10 | import Effect (Effect) 11 | import Effect.Aff (Milliseconds(..), delay, launchAff_) 12 | import Effect.Class (liftEffect) 13 | import Prim.Row as Row 14 | import Type.Proxy (Proxy(..)) 15 | import Web.DOM (Element) 16 | import Web.Event.Event as Web 17 | import Web.Event.EventTarget (EventTarget) 18 | import Web.HTML.HTMLInputElement (checked, fromEventTarget, value, valueAsNumber) 19 | import Web.HTML.HTMLSelectElement as SE 20 | 21 | transformOn 22 | :: ∀ a b r f 23 | . Functor f => 24 | { fromEventTarget :: EventTarget -> Maybe a 25 | , value :: a -> Effect b 26 | } 27 | -> (f (Web.Event -> Effect Unit) -> f (Attribute r)) 28 | -> f (b -> Effect Unit) 29 | -> f (Attribute r) 30 | transformOn { fromEventTarget, value } listener = 31 | listener <<< map \push e -> 32 | for_ (Web.target e >>= fromEventTarget) 33 | $ value >=> push 34 | 35 | -- | Runs an effect when the element triggers the given event. 36 | runOn 37 | :: forall e r f 38 | . Functor f 39 | => (f (e -> Effect Unit) -> f (Attribute r)) 40 | -> f (Effect Unit) 41 | -> f (Attribute r) 42 | runOn listener = 43 | listener <<< map const 44 | 45 | -- | Shorthand version of `runOn`. 46 | runOn_ 47 | :: forall e r f 48 | . Applicative f 49 | => (f (e -> Effect Unit) -> f (Attribute r)) 50 | -> Effect Unit 51 | -> f (Attribute r) 52 | runOn_ listener = 53 | runOn listener <<< pure 54 | 55 | -- | Runs an effect with the `checked` value of the target element when it triggers the given event. 56 | checkedOn 57 | :: forall r f 58 | . Functor f 59 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 60 | -> f (Boolean -> Effect Unit) 61 | -> f (Attribute r) 62 | checkedOn = 63 | transformOn { fromEventTarget, value: checked } 64 | 65 | -- | Shorthand version of `checkedOn`. 66 | checkedOn_ 67 | :: forall r f 68 | . Applicative f 69 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 70 | -> (Boolean -> Effect Unit) 71 | -> f (Attribute r) 72 | checkedOn_ listener = 73 | checkedOn listener <<< pure 74 | 75 | -- | Runs an effect with the `valueAsNumber` property of the target element when it triggers the given event. 76 | numberOn 77 | :: forall r f 78 | . Functor f 79 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 80 | -> f (Number -> Effect Unit) 81 | -> f (Attribute r) 82 | numberOn = 83 | transformOn { fromEventTarget, value: valueAsNumber } 84 | 85 | -- | Shorthand version of `numberOn`. 86 | numberOn_ 87 | :: forall r f 88 | . Applicative f 89 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 90 | -> (Number -> Effect Unit) 91 | -> f (Attribute r) 92 | numberOn_ listener = 93 | numberOn listener <<< pure 94 | 95 | -- | Runs an effect with the `value` property of the target element when it triggers the given event. 96 | valueOn 97 | :: forall r f 98 | . Functor f 99 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 100 | -> f (String -> Effect Unit) 101 | -> f (Attribute r) 102 | valueOn = 103 | transformOn { fromEventTarget, value } 104 | 105 | -- | Shorthand version of `valueOn`. 106 | valueOn_ 107 | :: forall r f 108 | . Applicative f 109 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 110 | -> (String -> Effect Unit) 111 | -> f (Attribute r) 112 | valueOn_ listener = 113 | valueOn listener <<< pure 114 | 115 | -- | Runs an effect with the `value` property of the target select element when it triggers the given event. 116 | selectOn 117 | :: forall r f 118 | . Functor f 119 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 120 | -> f (String -> Effect Unit) 121 | -> f (Attribute r) 122 | selectOn = 123 | transformOn { fromEventTarget: SE.fromEventTarget, value: SE.value } 124 | 125 | -- | Shorthad version of `selectOn`. 126 | selectOn_ 127 | :: forall r f 128 | . Applicative f 129 | => (f (Web.Event -> Effect Unit) -> f (Attribute r)) 130 | -> (String -> Effect Unit) 131 | -> f (Attribute r) 132 | selectOn_ listener = 133 | selectOn listener <<< pure 134 | 135 | -- | Converts an `Attribute` constructor to an `Attribute` unsetter. 136 | -- | 137 | -- | ```purescript 138 | -- | div [ _class "selected" selected, unset _class unselected ] [ text "button" ] 139 | -- | ``` 140 | unset 141 | :: forall @s v e r' r f 142 | . IsSymbol s 143 | => Row.Cons s v r' r 144 | => Functor f 145 | => f e 146 | -> f (Attribute r) 147 | unset trigger = trigger $> unsafeAttribute (unset' 148 | (fixMe $ reflectSymbol (Proxy :: Proxy s))) 149 | where 150 | fixMe "klass" = "class" 151 | fixMe x = x 152 | 153 | -- | Sets a listener that injects a primitive DOM element into a closed scope immediately after element creation. 154 | -- | Importantly, this does _not happen_ on the same tick as the element creation but rather during the next DOM tick. 155 | -- | This is to guarantee that element creation happens before trying to use the element. 156 | -- | In practice this delay will be on the order of microseconds but it can veer into milliseconds if 157 | -- | the UI thread is particularly busy. 158 | injectElement 159 | :: forall e f 160 | . Applicative f 161 | => (Element -> Effect Unit) 162 | -> f (Attribute e) 163 | injectElement f = 164 | Self.self_ \s -> launchAff_ do 165 | delay $ Milliseconds 0.0 166 | liftEffect $ f s 167 | 168 | -- | A typesafe version of `injectElement` that uses `SelfT` instead of `Self`. 169 | injectElementT 170 | :: forall r f typedElement tag 171 | . Applicative f 172 | => Self.IsSelf typedElement tag 173 | => (typedElement -> Effect Unit) 174 | -> f (Attribute (__tag :: Proxy tag | r)) 175 | injectElementT f = 176 | Self.selfT_ \s -> launchAff_ do 177 | delay $ Milliseconds 0.0 178 | liftEffect $ f s 179 | -------------------------------------------------------------------------------- /deku-dom/src/Deku/DOM/MathML/Attributes.purs: -------------------------------------------------------------------------------- 1 | -- | This module contains reexports of all the attributes. 2 | -- This module has been automatically generated by running `spago run -p codegen`. 3 | -- Any changes may be overwritten. 4 | module Deku.DOM.MathML.Attributes 5 | ( module Combinators 6 | , encoding 7 | , encoding_ 8 | , selection 9 | , selection_ 10 | , actiontype 11 | , actiontype_ 12 | , accentunder 13 | , accentunder_ 14 | , accent 15 | , accent_ 16 | , voffset 17 | , voffset_ 18 | , lspace 19 | , lspace_ 20 | , depth 21 | , depth_ 22 | , height 23 | , height_ 24 | , width 25 | , width_ 26 | , linethickness 27 | , linethickness_ 28 | , maxsize 29 | , maxsize_ 30 | , minsize 31 | , minsize_ 32 | , rspace 33 | , rspace_ 34 | , movablelimits 35 | , movablelimits_ 36 | , largeop 37 | , largeop_ 38 | , symmetric 39 | , symmetric_ 40 | , stretchy 41 | , stretchy_ 42 | , form 43 | , form_ 44 | , separator 45 | , separator_ 46 | , fence 47 | , fence_ 48 | , alttext 49 | , alttext_ 50 | , display 51 | , display_ 52 | ) where 53 | 54 | import Control.Applicative (pure, class Applicative) as Applicative 55 | import Control.Category ((<<<)) 56 | import Data.Functor (map, class Functor) as Functor 57 | import Deku.DOM.Combinators (unset) as Combinators 58 | import Deku.Attribute as Deku.Attribute 59 | 60 | encoding 61 | :: forall r f 62 | . Functor.Functor f 63 | => f String 64 | -> f (Deku.Attribute.Attribute (encoding :: String | r)) 65 | encoding = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "encoding") 66 | 67 | encoding_ 68 | :: forall r f 69 | . Applicative.Applicative f 70 | => String 71 | -> f (Deku.Attribute.Attribute (encoding :: String | r)) 72 | encoding_ = encoding <<< Applicative.pure 73 | 74 | selection 75 | :: forall r f 76 | . Functor.Functor f 77 | => f String 78 | -> f (Deku.Attribute.Attribute (selection :: String | r)) 79 | selection = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "selection") 80 | 81 | selection_ 82 | :: forall r f 83 | . Applicative.Applicative f 84 | => String 85 | -> f (Deku.Attribute.Attribute (selection :: String | r)) 86 | selection_ = selection <<< Applicative.pure 87 | 88 | actiontype 89 | :: forall r f 90 | . Functor.Functor f 91 | => f String 92 | -> f (Deku.Attribute.Attribute (actiontype :: String | r)) 93 | actiontype = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "actiontype") 94 | 95 | actiontype_ 96 | :: forall r f 97 | . Applicative.Applicative f 98 | => String 99 | -> f (Deku.Attribute.Attribute (actiontype :: String | r)) 100 | actiontype_ = actiontype <<< Applicative.pure 101 | 102 | accentunder 103 | :: forall r f 104 | . Functor.Functor f 105 | => f String 106 | -> f (Deku.Attribute.Attribute (accentunder :: String | r)) 107 | accentunder = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "accentunder") 108 | 109 | accentunder_ 110 | :: forall r f 111 | . Applicative.Applicative f 112 | => String 113 | -> f (Deku.Attribute.Attribute (accentunder :: String | r)) 114 | accentunder_ = accentunder <<< Applicative.pure 115 | 116 | accent 117 | :: forall r f 118 | . Functor.Functor f 119 | => f String 120 | -> f (Deku.Attribute.Attribute (accent :: String | r)) 121 | accent = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "accent") 122 | 123 | accent_ 124 | :: forall r f 125 | . Applicative.Applicative f 126 | => String 127 | -> f (Deku.Attribute.Attribute (accent :: String | r)) 128 | accent_ = accent <<< Applicative.pure 129 | 130 | voffset 131 | :: forall r f 132 | . Functor.Functor f 133 | => f String 134 | -> f (Deku.Attribute.Attribute (voffset :: String | r)) 135 | voffset = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "voffset") 136 | 137 | voffset_ 138 | :: forall r f 139 | . Applicative.Applicative f 140 | => String 141 | -> f (Deku.Attribute.Attribute (voffset :: String | r)) 142 | voffset_ = voffset <<< Applicative.pure 143 | 144 | lspace 145 | :: forall r f 146 | . Functor.Functor f 147 | => f String 148 | -> f (Deku.Attribute.Attribute (lspace :: String | r)) 149 | lspace = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "lspace") 150 | 151 | lspace_ 152 | :: forall r f 153 | . Applicative.Applicative f 154 | => String 155 | -> f (Deku.Attribute.Attribute (lspace :: String | r)) 156 | lspace_ = lspace <<< Applicative.pure 157 | 158 | depth 159 | :: forall r f. Functor.Functor f => f String -> f (Deku.Attribute.Attribute (depth :: String | r)) 160 | depth = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "depth") 161 | 162 | depth_ 163 | :: forall r f 164 | . Applicative.Applicative f 165 | => String 166 | -> f (Deku.Attribute.Attribute (depth :: String | r)) 167 | depth_ = depth <<< Applicative.pure 168 | 169 | height 170 | :: forall r f 171 | . Functor.Functor f 172 | => f String 173 | -> f (Deku.Attribute.Attribute (height :: String | r)) 174 | height = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "height") 175 | 176 | height_ 177 | :: forall r f 178 | . Applicative.Applicative f 179 | => String 180 | -> f (Deku.Attribute.Attribute (height :: String | r)) 181 | height_ = height <<< Applicative.pure 182 | 183 | width 184 | :: forall r f. Functor.Functor f => f String -> f (Deku.Attribute.Attribute (width :: String | r)) 185 | width = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "width") 186 | 187 | width_ 188 | :: forall r f 189 | . Applicative.Applicative f 190 | => String 191 | -> f (Deku.Attribute.Attribute (width :: String | r)) 192 | width_ = width <<< Applicative.pure 193 | 194 | linethickness 195 | :: forall r f 196 | . Functor.Functor f 197 | => f String 198 | -> f (Deku.Attribute.Attribute (linethickness :: String | r)) 199 | linethickness = Functor.map 200 | (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "linethickness") 201 | 202 | linethickness_ 203 | :: forall r f 204 | . Applicative.Applicative f 205 | => String 206 | -> f (Deku.Attribute.Attribute (linethickness :: String | r)) 207 | linethickness_ = linethickness <<< Applicative.pure 208 | 209 | maxsize 210 | :: forall r f 211 | . Functor.Functor f 212 | => f String 213 | -> f (Deku.Attribute.Attribute (maxsize :: String | r)) 214 | maxsize = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "maxsize") 215 | 216 | maxsize_ 217 | :: forall r f 218 | . Applicative.Applicative f 219 | => String 220 | -> f (Deku.Attribute.Attribute (maxsize :: String | r)) 221 | maxsize_ = maxsize <<< Applicative.pure 222 | 223 | minsize 224 | :: forall r f 225 | . Functor.Functor f 226 | => f String 227 | -> f (Deku.Attribute.Attribute (minsize :: String | r)) 228 | minsize = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "minsize") 229 | 230 | minsize_ 231 | :: forall r f 232 | . Applicative.Applicative f 233 | => String 234 | -> f (Deku.Attribute.Attribute (minsize :: String | r)) 235 | minsize_ = minsize <<< Applicative.pure 236 | 237 | rspace 238 | :: forall r f 239 | . Functor.Functor f 240 | => f String 241 | -> f (Deku.Attribute.Attribute (rspace :: String | r)) 242 | rspace = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "rspace") 243 | 244 | rspace_ 245 | :: forall r f 246 | . Applicative.Applicative f 247 | => String 248 | -> f (Deku.Attribute.Attribute (rspace :: String | r)) 249 | rspace_ = rspace <<< Applicative.pure 250 | 251 | movablelimits 252 | :: forall r f 253 | . Functor.Functor f 254 | => f String 255 | -> f (Deku.Attribute.Attribute (movablelimits :: String | r)) 256 | movablelimits = Functor.map 257 | (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "movablelimits") 258 | 259 | movablelimits_ 260 | :: forall r f 261 | . Applicative.Applicative f 262 | => String 263 | -> f (Deku.Attribute.Attribute (movablelimits :: String | r)) 264 | movablelimits_ = movablelimits <<< Applicative.pure 265 | 266 | largeop 267 | :: forall r f 268 | . Functor.Functor f 269 | => f String 270 | -> f (Deku.Attribute.Attribute (largeop :: String | r)) 271 | largeop = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "largeop") 272 | 273 | largeop_ 274 | :: forall r f 275 | . Applicative.Applicative f 276 | => String 277 | -> f (Deku.Attribute.Attribute (largeop :: String | r)) 278 | largeop_ = largeop <<< Applicative.pure 279 | 280 | symmetric 281 | :: forall r f 282 | . Functor.Functor f 283 | => f String 284 | -> f (Deku.Attribute.Attribute (symmetric :: String | r)) 285 | symmetric = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "symmetric") 286 | 287 | symmetric_ 288 | :: forall r f 289 | . Applicative.Applicative f 290 | => String 291 | -> f (Deku.Attribute.Attribute (symmetric :: String | r)) 292 | symmetric_ = symmetric <<< Applicative.pure 293 | 294 | stretchy 295 | :: forall r f 296 | . Functor.Functor f 297 | => f String 298 | -> f (Deku.Attribute.Attribute (stretchy :: String | r)) 299 | stretchy = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "stretchy") 300 | 301 | stretchy_ 302 | :: forall r f 303 | . Applicative.Applicative f 304 | => String 305 | -> f (Deku.Attribute.Attribute (stretchy :: String | r)) 306 | stretchy_ = stretchy <<< Applicative.pure 307 | 308 | form 309 | :: forall r f. Functor.Functor f => f String -> f (Deku.Attribute.Attribute (form :: String | r)) 310 | form = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "form") 311 | 312 | form_ 313 | :: forall r f 314 | . Applicative.Applicative f 315 | => String 316 | -> f (Deku.Attribute.Attribute (form :: String | r)) 317 | form_ = form <<< Applicative.pure 318 | 319 | separator 320 | :: forall r f 321 | . Functor.Functor f 322 | => f String 323 | -> f (Deku.Attribute.Attribute (separator :: String | r)) 324 | separator = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "separator") 325 | 326 | separator_ 327 | :: forall r f 328 | . Applicative.Applicative f 329 | => String 330 | -> f (Deku.Attribute.Attribute (separator :: String | r)) 331 | separator_ = separator <<< Applicative.pure 332 | 333 | fence 334 | :: forall r f. Functor.Functor f => f String -> f (Deku.Attribute.Attribute (fence :: String | r)) 335 | fence = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "fence") 336 | 337 | fence_ 338 | :: forall r f 339 | . Applicative.Applicative f 340 | => String 341 | -> f (Deku.Attribute.Attribute (fence :: String | r)) 342 | fence_ = fence <<< Applicative.pure 343 | 344 | alttext 345 | :: forall r f 346 | . Functor.Functor f 347 | => f String 348 | -> f (Deku.Attribute.Attribute (alttext :: String | r)) 349 | alttext = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "alttext") 350 | 351 | alttext_ 352 | :: forall r f 353 | . Applicative.Applicative f 354 | => String 355 | -> f (Deku.Attribute.Attribute (alttext :: String | r)) 356 | alttext_ = alttext <<< Applicative.pure 357 | 358 | display 359 | :: forall r f 360 | . Functor.Functor f 361 | => f String 362 | -> f (Deku.Attribute.Attribute (display :: String | r)) 363 | display = Functor.map (Deku.Attribute.unsafeAttribute <<< Deku.Attribute.prop' "display") 364 | 365 | display_ 366 | :: forall r f 367 | . Applicative.Applicative f 368 | => String 369 | -> f (Deku.Attribute.Attribute (display :: String | r)) 370 | display_ = display <<< Applicative.pure 371 | -------------------------------------------------------------------------------- /deku-dom/src/Deku/DOM/SVG/Listeners.purs: -------------------------------------------------------------------------------- 1 | -- | This module contains reexports of all the event listeners. 2 | -- This module has been automatically generated by running `spago run -p codegen`. 3 | -- Any changes may be overwritten. 4 | module Deku.DOM.SVG.Listeners (module Combinators, repeat, repeat_, end, end_, begin, begin_) where 5 | 6 | import Control.Applicative (pure, class Applicative) as Applicative 7 | import Control.Category ((<<<)) 8 | import Data.Functor (map, class Functor) as Functor 9 | import Deku.DOM.Combinators (unset, injectElement, injectElementT, runOn, runOn_, numberOn, numberOn_, checkedOn, checkedOn_, valueOn, valueOn_, selectOn, selectOn_) as Combinators 10 | import Deku.Attribute as Deku.Attribute 11 | import Web.Event.Internal.Types as Web.Event.Internal.Types 12 | import Effect as Effect 13 | import Data.Unit as Data.Unit 14 | import Unsafe.Coerce as Unsafe.Coerce 15 | 16 | repeat 17 | :: forall r f 18 | . Functor.Functor f 19 | => f (Web.Event.Internal.Types.Event -> Effect.Effect Data.Unit.Unit) 20 | -> f (Deku.Attribute.Attribute (repeat :: Web.Event.Internal.Types.Event | r)) 21 | repeat = Functor.map 22 | ( Deku.Attribute.unsafeAttribute <<< Deku.Attribute.cb' "repeat" <<< Deku.Attribute.cb <<< 23 | Unsafe.Coerce.unsafeCoerce 24 | ) 25 | 26 | repeat_ 27 | :: forall r f 28 | . Applicative.Applicative f 29 | => (Web.Event.Internal.Types.Event -> Effect.Effect Data.Unit.Unit) 30 | -> f (Deku.Attribute.Attribute (repeat :: Web.Event.Internal.Types.Event | r)) 31 | repeat_ = repeat <<< Applicative.pure 32 | 33 | end 34 | :: forall r f 35 | . Functor.Functor f 36 | => f (Web.Event.Internal.Types.Event -> Effect.Effect Data.Unit.Unit) 37 | -> f (Deku.Attribute.Attribute (end :: Web.Event.Internal.Types.Event | r)) 38 | end = Functor.map 39 | ( Deku.Attribute.unsafeAttribute <<< Deku.Attribute.cb' "end" <<< Deku.Attribute.cb <<< 40 | Unsafe.Coerce.unsafeCoerce 41 | ) 42 | 43 | end_ 44 | :: forall r f 45 | . Applicative.Applicative f 46 | => (Web.Event.Internal.Types.Event -> Effect.Effect Data.Unit.Unit) 47 | -> f (Deku.Attribute.Attribute (end :: Web.Event.Internal.Types.Event | r)) 48 | end_ = end <<< Applicative.pure 49 | 50 | begin 51 | :: forall r f 52 | . Functor.Functor f 53 | => f (Web.Event.Internal.Types.Event -> Effect.Effect Data.Unit.Unit) 54 | -> f (Deku.Attribute.Attribute (begin :: Web.Event.Internal.Types.Event | r)) 55 | begin = Functor.map 56 | ( Deku.Attribute.unsafeAttribute <<< Deku.Attribute.cb' "begin" <<< Deku.Attribute.cb <<< 57 | Unsafe.Coerce.unsafeCoerce 58 | ) 59 | 60 | begin_ 61 | :: forall r f 62 | . Applicative.Applicative f 63 | => (Web.Event.Internal.Types.Event -> Effect.Effect Data.Unit.Unit) 64 | -> f (Deku.Attribute.Attribute (begin :: Web.Event.Internal.Types.Event | r)) 65 | begin_ = begin <<< Applicative.pure 66 | -------------------------------------------------------------------------------- /deku-dom/src/Deku/DOM/Self.purs: -------------------------------------------------------------------------------- 1 | -- This module has been automatically generated by running `spago run -p codegen`. 2 | -- Any changes may be overwritten. 3 | module Deku.DOM.Self where 4 | 5 | import Control.Applicative (pure, class Applicative) as Applicative 6 | import Control.Category ((<<<)) 7 | import Data.Functor (map, class Functor) as Functor 8 | import Type.Proxy (Proxy) 9 | import Deku.Attribute as Deku.Attribute 10 | import Web.DOM.Element as Web.DOM.Element 11 | import Effect as Effect 12 | import Data.Unit as Data.Unit 13 | import Unsafe.Coerce as Unsafe.Coerce 14 | import Web.HTML.HTMLAnchorElement as Web.HTML.HTMLAnchorElement 15 | import Web.HTML.HTMLAreaElement as Web.HTML.HTMLAreaElement 16 | import Web.HTML.HTMLAudioElement as Web.HTML.HTMLAudioElement 17 | import Web.HTML.HTMLBRElement as Web.HTML.HTMLBRElement 18 | import Web.HTML.HTMLBaseElement as Web.HTML.HTMLBaseElement 19 | import Web.HTML.HTMLBodyElement as Web.HTML.HTMLBodyElement 20 | import Web.HTML.HTMLButtonElement as Web.HTML.HTMLButtonElement 21 | import Web.HTML.HTMLCanvasElement as Web.HTML.HTMLCanvasElement 22 | import Web.HTML.HTMLDivElement as Web.HTML.HTMLDivElement 23 | import Web.HTML.HTMLEmbedElement as Web.HTML.HTMLEmbedElement 24 | import Web.HTML.HTMLFormElement as Web.HTML.HTMLFormElement 25 | import Web.HTML.HTMLHRElement as Web.HTML.HTMLHRElement 26 | import Web.HTML.HTMLHeadElement as Web.HTML.HTMLHeadElement 27 | import Web.HTML.HTMLHtmlElement as Web.HTML.HTMLHtmlElement 28 | import Web.HTML.HTMLInputElement as Web.HTML.HTMLInputElement 29 | import Web.HTML.HTMLLabelElement as Web.HTML.HTMLLabelElement 30 | import Web.HTML.HTMLLegendElement as Web.HTML.HTMLLegendElement 31 | import Web.HTML.HTMLLinkElement as Web.HTML.HTMLLinkElement 32 | import Web.HTML.HTMLMapElement as Web.HTML.HTMLMapElement 33 | import Web.HTML.HTMLMetaElement as Web.HTML.HTMLMetaElement 34 | import Web.HTML.HTMLMeterElement as Web.HTML.HTMLMeterElement 35 | import Web.HTML.HTMLObjectElement as Web.HTML.HTMLObjectElement 36 | import Web.HTML.HTMLOptionElement as Web.HTML.HTMLOptionElement 37 | import Web.HTML.HTMLOutputElement as Web.HTML.HTMLOutputElement 38 | import Web.HTML.HTMLParagraphElement as Web.HTML.HTMLParagraphElement 39 | import Web.HTML.HTMLParamElement as Web.HTML.HTMLParamElement 40 | import Web.HTML.HTMLPreElement as Web.HTML.HTMLPreElement 41 | import Web.HTML.HTMLProgressElement as Web.HTML.HTMLProgressElement 42 | import Web.HTML.HTMLScriptElement as Web.HTML.HTMLScriptElement 43 | import Web.HTML.HTMLSelectElement as Web.HTML.HTMLSelectElement 44 | import Web.HTML.HTMLSourceElement as Web.HTML.HTMLSourceElement 45 | import Web.HTML.HTMLSpanElement as Web.HTML.HTMLSpanElement 46 | import Web.HTML.HTMLStyleElement as Web.HTML.HTMLStyleElement 47 | import Web.HTML.HTMLTableDataCellElement as Web.HTML.HTMLTableDataCellElement 48 | import Web.HTML.HTMLTableElement as Web.HTML.HTMLTableElement 49 | import Web.HTML.HTMLTemplateElement as Web.HTML.HTMLTemplateElement 50 | import Web.HTML.HTMLTextAreaElement as Web.HTML.HTMLTextAreaElement 51 | import Web.HTML.HTMLTimeElement as Web.HTML.HTMLTimeElement 52 | import Web.HTML.HTMLTitleElement as Web.HTML.HTMLTitleElement 53 | import Web.HTML.HTMLTrackElement as Web.HTML.HTMLTrackElement 54 | import Web.HTML.HTMLVideoElement as Web.HTML.HTMLVideoElement 55 | 56 | class IsSelf (element :: Type) (name :: Symbol) | element -> name 57 | 58 | -- | Creates a special event where an Deku element can have its raw DOM element 59 | -- | injected into a closure. All bets are off type-safety wise. This is useful 60 | -- | when you need to manipulate the element itself, like for example attaching 61 | -- | properties to it, etc. 62 | self 63 | :: forall r f 64 | . Functor.Functor f 65 | => f (Web.DOM.Element.Element -> Effect.Effect Data.Unit.Unit) 66 | -> f (Deku.Attribute.Attribute r) 67 | self = Functor.map 68 | ( Deku.Attribute.unsafeAttribute <<< Deku.Attribute.cb' "@self@" <<< Deku.Attribute.cb <<< 69 | Unsafe.Coerce.unsafeCoerce 70 | ) 71 | 72 | -- | Shorthand version of `self` 73 | self_ 74 | :: forall r f 75 | . Applicative.Applicative f 76 | => (Web.DOM.Element.Element -> Effect.Effect Data.Unit.Unit) 77 | -> f (Deku.Attribute.Attribute r) 78 | self_ = self <<< Applicative.pure 79 | 80 | -- | A slightly less permissive version of `Self` that associates Deku Elements to 81 | -- | the primitive element definitions form `purescript-web`. For example, `A_` from `deku` 82 | -- | gets translated to `HTMLAnchorElement` from `purescript-web`, etc. 83 | selfT 84 | :: forall name e r f 85 | . Functor.Functor f 86 | => IsSelf e name 87 | => f (e -> Effect.Effect Data.Unit.Unit) 88 | -> f (Deku.Attribute.Attribute (__tag :: Proxy name | r)) 89 | selfT = Functor.map 90 | ( Deku.Attribute.unsafeAttribute <<< Deku.Attribute.cb' "@self@" <<< Deku.Attribute.cb <<< 91 | Unsafe.Coerce.unsafeCoerce 92 | ) 93 | 94 | -- | Shorthand version of `selfT` 95 | selfT_ 96 | :: forall name e r f 97 | . Applicative.Applicative f 98 | => IsSelf e name 99 | => (e -> Effect.Effect Data.Unit.Unit) 100 | -> f (Deku.Attribute.Attribute (__tag :: Proxy name | r)) 101 | selfT_ = selfT <<< Applicative.pure 102 | 103 | instance IsSelf Web.HTML.HTMLAnchorElement.HTMLAnchorElement "HTMLAnchorElement" 104 | instance IsSelf Web.HTML.HTMLAreaElement.HTMLAreaElement "HTMLAreaElement" 105 | instance IsSelf Web.HTML.HTMLAudioElement.HTMLAudioElement "HTMLAudioElement" 106 | instance IsSelf Web.HTML.HTMLBRElement.HTMLBRElement "HTMLBRElement" 107 | instance IsSelf Web.HTML.HTMLBaseElement.HTMLBaseElement "HTMLBaseElement" 108 | instance IsSelf Web.HTML.HTMLBodyElement.HTMLBodyElement "HTMLBodyElement" 109 | instance IsSelf Web.HTML.HTMLButtonElement.HTMLButtonElement "HTMLButtonElement" 110 | instance IsSelf Web.HTML.HTMLCanvasElement.HTMLCanvasElement "HTMLCanvasElement" 111 | instance IsSelf Web.HTML.HTMLDivElement.HTMLDivElement "HTMLDivElement" 112 | instance IsSelf Web.HTML.HTMLEmbedElement.HTMLEmbedElement "HTMLEmbedElement" 113 | instance IsSelf Web.HTML.HTMLFormElement.HTMLFormElement "HTMLFormElement" 114 | instance IsSelf Web.HTML.HTMLHRElement.HTMLHRElement "HTMLHRElement" 115 | instance IsSelf Web.HTML.HTMLHeadElement.HTMLHeadElement "HTMLHeadElement" 116 | instance IsSelf Web.HTML.HTMLHtmlElement.HTMLHtmlElement "HTMLHtmlElement" 117 | instance IsSelf Web.HTML.HTMLInputElement.HTMLInputElement "HTMLInputElement" 118 | instance IsSelf Web.HTML.HTMLLabelElement.HTMLLabelElement "HTMLLabelElement" 119 | instance IsSelf Web.HTML.HTMLLegendElement.HTMLLegendElement "HTMLLegendElement" 120 | instance IsSelf Web.HTML.HTMLLinkElement.HTMLLinkElement "HTMLLinkElement" 121 | instance IsSelf Web.HTML.HTMLMapElement.HTMLMapElement "HTMLMapElement" 122 | instance IsSelf Web.HTML.HTMLMetaElement.HTMLMetaElement "HTMLMetaElement" 123 | instance IsSelf Web.HTML.HTMLMeterElement.HTMLMeterElement "HTMLMeterElement" 124 | instance IsSelf Web.HTML.HTMLObjectElement.HTMLObjectElement "HTMLObjectElement" 125 | instance IsSelf Web.HTML.HTMLOptionElement.HTMLOptionElement "HTMLOptionElement" 126 | instance IsSelf Web.HTML.HTMLOutputElement.HTMLOutputElement "HTMLOutputElement" 127 | instance IsSelf Web.HTML.HTMLParagraphElement.HTMLParagraphElement "HTMLParagraphElement" 128 | instance IsSelf Web.HTML.HTMLParamElement.HTMLParamElement "HTMLParamElement" 129 | instance IsSelf Web.HTML.HTMLPreElement.HTMLPreElement "HTMLPreElement" 130 | instance IsSelf Web.HTML.HTMLProgressElement.HTMLProgressElement "HTMLProgressElement" 131 | instance IsSelf Web.HTML.HTMLScriptElement.HTMLScriptElement "HTMLScriptElement" 132 | instance IsSelf Web.HTML.HTMLSelectElement.HTMLSelectElement "HTMLSelectElement" 133 | instance IsSelf Web.HTML.HTMLSourceElement.HTMLSourceElement "HTMLSourceElement" 134 | instance IsSelf Web.HTML.HTMLSpanElement.HTMLSpanElement "HTMLSpanElement" 135 | instance IsSelf Web.HTML.HTMLStyleElement.HTMLStyleElement "HTMLStyleElement" 136 | instance 137 | IsSelf Web.HTML.HTMLTableDataCellElement.HTMLTableDataCellElement "HTMLTableDataCellElement" 138 | 139 | instance IsSelf Web.HTML.HTMLTableElement.HTMLTableElement "HTMLTableElement" 140 | instance IsSelf Web.HTML.HTMLTemplateElement.HTMLTemplateElement "HTMLTemplateElement" 141 | instance IsSelf Web.HTML.HTMLTextAreaElement.HTMLTextAreaElement "HTMLTextAreaElement" 142 | instance IsSelf Web.HTML.HTMLTimeElement.HTMLTimeElement "HTMLTimeElement" 143 | instance IsSelf Web.HTML.HTMLTitleElement.HTMLTitleElement "HTMLTitleElement" 144 | instance IsSelf Web.HTML.HTMLTrackElement.HTMLTrackElement "HTMLTrackElement" 145 | instance IsSelf Web.HTML.HTMLVideoElement.HTMLVideoElement "HTMLVideoElement" 146 | -------------------------------------------------------------------------------- /deku-dom/src/Deku/DOMInterpret.js: -------------------------------------------------------------------------------- 1 | export const setInnerHtml = (html, element) => { 2 | element.innerHTML = html; 3 | } -------------------------------------------------------------------------------- /deku-dom/src/Deku/DOMInterpret.purs: -------------------------------------------------------------------------------- 1 | module Deku.DOMInterpret where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.ST.Class (liftST) 6 | import Data.Array.ST as STArray 7 | import Data.Exists (Exists, mkExists, runExists) 8 | import Data.Foldable (for_, traverse_) 9 | import Data.List (List(..), (:)) 10 | import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust) 11 | import Data.Nullable (toMaybe) 12 | import Data.Tuple (Tuple(..)) 13 | import Deku.Core (SetInnerHtml) 14 | import Deku.Core as Core 15 | import Deku.Internal.Entities (DekuChild(..), DekuElement, DekuParent(..), fromDekuElement, fromDekuText, toDekuElement, toDekuText) 16 | import Deku.Internal.Region (Anchor(..)) 17 | import Deku.UnsafeDOM (addEventListener, after, createDocumentFragment, createElement, createElementNS, createText, eventListener, popCb, prepend, pushCb, removeEventListener, setTextContent) 18 | import Effect (Effect, whileE) 19 | import Effect.Exception (error, throwException) 20 | import Effect.Ref as Ref 21 | import Effect.Uncurried (EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, mkEffectFn3, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4) 22 | import Partial.Unsafe (unsafePartial) 23 | import Safe.Coerce (coerce) 24 | import Unsafe.Coerce (unsafeCoerce) 25 | import Unsafe.Reference (unsafeRefEq) 26 | import Web.DOM (ChildNode, Element, Node) 27 | import Web.DOM.ChildNode (remove) 28 | import Web.DOM.Element (removeAttribute, setAttribute) 29 | import Web.DOM.Node (firstChild, nextSibling) 30 | import Web.DOM.Text as Text 31 | import Web.Event.Event (EventType(..)) 32 | import Web.Event.Event as Web 33 | import Web.Event.Internal.Types (EventTarget) 34 | import Web.HTML.HTMLButtonElement as HTMLButtonElement 35 | import Web.HTML.HTMLFieldSetElement as HTMLFieldSetElement 36 | import Web.HTML.HTMLInputElement as HTMLInputElement 37 | import Web.HTML.HTMLKeygenElement as HTMLKeygenElement 38 | import Web.HTML.HTMLLinkElement as HTMLLinkElement 39 | import Web.HTML.HTMLOptGroupElement as HTMLOptGroupElement 40 | import Web.HTML.HTMLOptionElement as HTMLOptionElement 41 | import Web.HTML.HTMLSelectElement as HTMLSelectElement 42 | import Web.HTML.HTMLTextAreaElement as HTMLTextAreaElement 43 | 44 | makeElementEffect :: Core.MakeElement 45 | makeElementEffect = mkEffectFn3 \_ ns tag -> do 46 | elt <- case coerce ns :: Maybe String of 47 | Nothing -> runEffectFn1 createElement (coerce tag) 48 | Just ns' -> runEffectFn2 createElementNS (coerce ns') (coerce tag) 49 | pure $ toDekuElement elt 50 | 51 | attachElementEffect :: Core.AttachElement 52 | attachElementEffect = 53 | mkEffectFn2 \(DekuChild el) -> runEffectFn2 attachNodeEffect 54 | [ fromDekuElement @Node el ] 55 | 56 | setPropEffect :: Core.SetProp 57 | setPropEffect = mkEffectFn3 \(Core.Key k) (Core.Value v) elt' -> do 58 | let elt = fromDekuElement elt' 59 | let 60 | o 61 | | k == "value" 62 | , Just ie <- HTMLInputElement.fromElement elt = HTMLInputElement.setValue 63 | v 64 | ie 65 | | k == "value" 66 | , Just tx <- HTMLTextAreaElement.fromElement elt = 67 | HTMLTextAreaElement.setValue v tx 68 | | k == "checked" 69 | , Just ie <- HTMLInputElement.fromElement elt = 70 | HTMLInputElement.setChecked (v == "true") ie 71 | | k == "disabled" 72 | , Just fe <- 73 | getDisableable elt disableables = runExists 74 | (\(FeO { f, e }) -> f (v == "true") e) 75 | fe 76 | | otherwise = setAttribute k v elt 77 | o 78 | 79 | setCbEffect :: Core.SetCb 80 | setCbEffect = mkEffectFn3 \(Core.Key k) (Core.Cb v) elt' -> do 81 | if k == "@self@" then do 82 | void $ v ((unsafeCoerce :: DekuElement -> Web.Event) elt') 83 | else do 84 | let asElt = fromDekuElement @Element elt' 85 | l <- runEffectFn2 popCb k asElt 86 | let eventType = EventType k 87 | let eventTarget = fromDekuElement @EventTarget elt' 88 | for_ (toMaybe l) \toRemove -> runEffectFn4 removeEventListener eventType 89 | toRemove 90 | false 91 | eventTarget 92 | nl <- runEffectFn1 eventListener $ mkEffectFn1 v 93 | runEffectFn4 addEventListener eventType nl false eventTarget 94 | runEffectFn3 pushCb k nl asElt 95 | 96 | unsetAttributeEffect :: Core.UnsetAttribute 97 | unsetAttributeEffect = mkEffectFn2 \(Core.Key k) elt' -> do 98 | let asElt = fromDekuElement @Element elt' 99 | l <- runEffectFn2 popCb k asElt 100 | let asEventTarget = fromDekuElement @EventTarget elt' 101 | let eventType = EventType k 102 | for_ (toMaybe l) \toRemove -> do 103 | runEffectFn4 removeEventListener eventType toRemove false asEventTarget 104 | removeAttribute k asElt 105 | 106 | removeElementEffect :: Core.RemoveElement 107 | removeElementEffect = mkEffectFn1 \e -> do 108 | remove (fromDekuElement @ChildNode e) 109 | 110 | newtype FeI e = FeI 111 | { f :: Boolean -> e -> Effect Unit, e :: Element -> Maybe e } 112 | 113 | newtype FeO e = FeO { f :: Boolean -> e -> Effect Unit, e :: e } 114 | 115 | disableables ∷ List (Exists FeI) 116 | disableables = 117 | mkExists 118 | ( FeI 119 | { e: HTMLButtonElement.fromElement 120 | , f: HTMLButtonElement.setDisabled 121 | } 122 | ) 123 | : mkExists 124 | ( FeI 125 | { e: HTMLInputElement.fromElement 126 | , f: HTMLInputElement.setDisabled 127 | } 128 | ) 129 | : mkExists 130 | ( FeI 131 | { e: HTMLFieldSetElement.fromElement 132 | , f: HTMLFieldSetElement.setDisabled 133 | } 134 | ) 135 | : mkExists 136 | ( FeI 137 | { e: HTMLKeygenElement.fromElement 138 | , f: HTMLKeygenElement.setDisabled 139 | } 140 | ) 141 | : mkExists 142 | ( FeI 143 | { e: HTMLLinkElement.fromElement 144 | , f: HTMLLinkElement.setDisabled 145 | } 146 | ) 147 | : mkExists 148 | ( FeI 149 | { e: HTMLOptGroupElement.fromElement 150 | , f: HTMLOptGroupElement.setDisabled 151 | } 152 | ) 153 | : mkExists 154 | ( FeI 155 | { e: HTMLOptionElement.fromElement 156 | , f: HTMLOptionElement.setDisabled 157 | } 158 | ) 159 | : mkExists 160 | ( FeI 161 | { e: HTMLSelectElement.fromElement 162 | , f: HTMLSelectElement.setDisabled 163 | } 164 | ) 165 | : mkExists 166 | ( FeI 167 | { e: HTMLTextAreaElement.fromElement 168 | , f: HTMLTextAreaElement.setDisabled 169 | } 170 | ) 171 | : Nil 172 | 173 | getDisableable :: Element -> List (Exists FeI) -> Maybe (Exists FeO) 174 | getDisableable elt = go 175 | 176 | where 177 | 178 | go Nil = Nothing 179 | go (x : _) 180 | | Just o <- 181 | runExists 182 | (\(FeI { f, e }) -> e elt <#> \e' -> mkExists (FeO { f, e: e' })) 183 | x = Just o 184 | go (_ : y) = go y 185 | 186 | makeTextEffect :: Core.MakeText 187 | makeTextEffect = mkEffectFn2 \_ mstr -> do 188 | txt <- runEffectFn1 createText (fromMaybe "" mstr) 189 | pure $ toDekuText txt 190 | 191 | attachTextEffect :: Core.AttachText 192 | attachTextEffect = 193 | mkEffectFn2 \txt -> do 194 | runEffectFn2 attachNodeEffect [ fromDekuText @Node txt ] 195 | 196 | setTextEffect :: Core.SetText 197 | setTextEffect = mkEffectFn2 \str txt' -> do 198 | let txt = fromDekuText @Node txt' 199 | runEffectFn2 setTextContent str txt 200 | 201 | removeTextEffect :: Core.RemoveText 202 | removeTextEffect = mkEffectFn1 \t -> do 203 | remove (Text.toChildNode (fromDekuText t)) 204 | 205 | bufferPortal :: Core.BufferPortal 206 | bufferPortal = do 207 | frag <- createDocumentFragment 208 | pure $ Tuple 0 $ DekuParent $ toDekuElement frag 209 | 210 | -- | Uses [after](https://developer.mozilla.org/en-US/docs/Web/API/Element/after) and 211 | -- | [prepend](https://developer.mozilla.org/en-US/docs/Web/API/Element/prepend) to efficiently move the collected 212 | -- | nodes. To collect the `Node`s we simply iterate from the beginning(via 213 | -- | [firstChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/firstChild) or 214 | -- | [nextSibling](https://developer.mozilla.org/en-US/docs/Web/API/Node/nextSibling)) until we find the end `Node` via 215 | -- | referential equality. 216 | beamRegionEffect :: Core.BeamRegion 217 | beamRegionEffect = mkEffectFn3 case _, _, _ of 218 | _, ParentStart _, _ -> 219 | pure unit 220 | 221 | ParentStart (DekuParent parent), end, target -> do 222 | firstChild (fromDekuElement @Node parent) >>= traverse_ \first -> 223 | runEffectFn3 beamNodes first (toNode end) target 224 | 225 | fromBegin, fromEnd, target -> do 226 | let 227 | beginNode = toNode fromBegin 228 | endNode = toNode fromEnd 229 | 230 | -- if beginning equals the end, `nextSibling` would overshoot, so just check now and abort 231 | if unsafeRefEq beginNode endNode then 232 | pure unit 233 | else 234 | nextSibling beginNode >>= traverse_ \first -> 235 | runEffectFn3 beamNodes first endNode target 236 | 237 | where 238 | 239 | beamNodes :: EffectFn3 Node Node Anchor Unit 240 | beamNodes = mkEffectFn3 \first end target -> do 241 | acc <- liftST $ STArray.new 242 | next <- Ref.new $ Just first 243 | 244 | whileE (isJust <$> Ref.read next) do 245 | current <- unsafePartial $ fromJust <$> Ref.read next 246 | void $ liftST $ STArray.push current acc 247 | 248 | if unsafeRefEq current end then 249 | void $ Ref.write Nothing next 250 | else do 251 | nextCandidate <- nextSibling current 252 | void $ Ref.write nextCandidate next 253 | 254 | nodes <- liftST $ STArray.unsafeFreeze acc 255 | runEffectFn2 attachNodeEffect nodes target 256 | 257 | toNode :: Anchor -> Node 258 | toNode a = unsafePartial case a of 259 | Element el -> fromDekuElement @Node el 260 | Text txt -> fromDekuText @Node txt 261 | 262 | attachNodeEffect :: EffectFn2 (Array Node) Anchor Unit 263 | attachNodeEffect = mkEffectFn2 \nodes anchor -> do 264 | case anchor of 265 | ParentStart (DekuParent parent) -> do 266 | runEffectFn2 prepend nodes (fromDekuElement @Node parent) 267 | 268 | Element el -> do 269 | runEffectFn2 after nodes (fromDekuElement @Node el) 270 | 271 | Text txt -> do 272 | runEffectFn2 after nodes (fromDekuText @Node txt) 273 | 274 | foreign import setInnerHtml :: EffectFn2 String DekuElement Unit 275 | 276 | setInnerHtmlEffect :: SetInnerHtml 277 | setInnerHtmlEffect = mkEffectFn2 \html anchor -> do 278 | case anchor of 279 | ParentStart (DekuParent parent) -> do 280 | runEffectFn2 setInnerHtml html parent 281 | 282 | Element _ -> do 283 | throwException $ error "setInnerHtmlEffect: Cannot set innerHTML on an Element" 284 | 285 | Text _ -> do 286 | throwException $ error "setInnerHtmlEffect: Cannot set innerHTML on an Element" 287 | -------------------------------------------------------------------------------- /deku-spa/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: deku-spa 3 | dependencies: 4 | - deku-core -------------------------------------------------------------------------------- /deku-spa/src/Deku/SPA.purs: -------------------------------------------------------------------------------- 1 | -- | These functions are used to run a Deku application. 2 | module Deku.SPA 3 | ( runInElement 4 | , runInBody 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Control.Monad.ST.Class (liftST) 10 | import Control.Monad.ST.Uncurried (runSTFn1, runSTFn3) 11 | import Data.Maybe (maybe) 12 | import Deku.Core (Nut(..), newPSR) 13 | import Deku.SPAInterpret (spaInterpret) 14 | import Deku.Internal.Ancestry as Ancestry 15 | import Deku.Internal.Entities (DekuParent(..), toDekuElement) 16 | import Deku.Internal.Region as Region 17 | import Effect (Effect) 18 | import Effect.Exception (error, throwException) 19 | import Effect.Uncurried (runEffectFn2) 20 | import FRP.Poll (create) 21 | import Web.DOM as Web.DOM 22 | import Web.HTML (window) 23 | import Web.HTML.HTMLDocument (body) 24 | import Web.HTML.HTMLElement (toElement) 25 | import Web.HTML.Window (document) 26 | 27 | -- | Runs a deku application in a DOM element, returning a canceler that can 28 | -- | be used to cancel the application. 29 | runInElement 30 | :: Web.DOM.Element 31 | -> Nut 32 | -> Effect (Effect Unit) 33 | runInElement elt (Nut nut) = do 34 | { poll: lifecycle, push: dispose } <- liftST create 35 | region <- liftST $ runSTFn1 Region.fromParent (DekuParent $ toDekuElement elt) 36 | scope <- liftST $ runSTFn3 newPSR Ancestry.root lifecycle region 37 | void $ runEffectFn2 nut scope spaInterpret 38 | pure $ dispose unit 39 | 40 | doInBody :: forall i o. (Web.DOM.Element -> i -> Effect o) -> i -> Effect o 41 | doInBody f elt = do 42 | b' <- window >>= document >>= body 43 | maybe (throwException (error "Could not find element")) 44 | (flip f elt) 45 | (toElement <$> b') 46 | 47 | -- | Runs a deku application in the body of a document, returning a canceler that can 48 | -- | be used to cancel the application. 49 | runInBody 50 | :: Nut 51 | -> Effect (Effect Unit) 52 | runInBody = doInBody runInElement 53 | -------------------------------------------------------------------------------- /deku-spa/src/Deku/SPAInterpret.purs: -------------------------------------------------------------------------------- 1 | module Deku.SPAInterpret where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.ST.Uncurried (mkSTFn1, mkSTFn2) 6 | import Deku.Core as Core 7 | import Deku.DOMInterpret as I 8 | 9 | spaInterpret :: Core.DOMInterpret 10 | spaInterpret = Core.DOMInterpret 11 | { dynamicDOMInterpret: \_ -> spaInterpret 12 | , portalDOMInterpret: \_ -> spaInterpret 13 | -- 14 | , isBoring: const false 15 | , makeElement: I.makeElementEffect 16 | , attachElement: I.attachElementEffect 17 | , initializeElementRendering: mkSTFn2 \_ _ -> pure unit 18 | , initializeTextRendering: mkSTFn2 \_ _ -> pure unit 19 | , markElementAsImpure: mkSTFn1 \_ -> pure unit 20 | , setProp: I.setPropEffect 21 | , setCb: I.setCbEffect 22 | , unsetAttribute: I.unsetAttributeEffect 23 | , removeElement: I.removeElementEffect 24 | -- 25 | , makeText: I.makeTextEffect 26 | , attachText: I.attachTextEffect 27 | , setText: I.setTextEffect 28 | , removeText: I.removeTextEffect 29 | , markTextAsImpure: mkSTFn1 \_ -> pure unit 30 | -- 31 | , beamRegion: I.beamRegionEffect 32 | , initializePortalRendering: mkSTFn1 \_ -> pure unit 33 | , markPortalAsRendered: mkSTFn1 \_ -> pure unit 34 | , bufferPortal: I.bufferPortal 35 | -- 36 | , initializeDynRendering: mkSTFn1 \_ -> pure unit 37 | , initializeFixedRendering: mkSTFn1 \_ -> pure unit 38 | , setInnerHTML: I.setInnerHtmlEffect 39 | } -------------------------------------------------------------------------------- /deku-ssr/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: deku-ssr 3 | dependencies: 4 | - deku-core 5 | -------------------------------------------------------------------------------- /deku-ssr/src/Deku/HydratingInterpret.purs: -------------------------------------------------------------------------------- 1 | module Deku.HydratingInterpret 2 | ( hydratingInterpret 3 | , makeElement 4 | , makeText 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Control.Monad.ST.Class (liftST) 10 | import Control.Monad.ST.Global (Global) 11 | import Control.Monad.ST.Internal as STRef 12 | import Control.Monad.ST.Uncurried (mkSTFn1, mkSTFn2) 13 | import Data.Map as Map 14 | import Data.Maybe (Maybe(..)) 15 | import Data.Set as Set 16 | import Data.Tuple (Tuple(..)) 17 | import Deku.Core (MakeElement, MakeText) 18 | import Deku.Core as Core 19 | import Deku.SPAInterpret (spaInterpret) 20 | import Deku.Internal.Ancestry (Ancestry) 21 | import Deku.Internal.Entities (toDekuElement, toDekuText) 22 | import Deku.DOMInterpret as I 23 | import Effect.Uncurried (mkEffectFn2, mkEffectFn3) 24 | import Web.DOM as Web.DOM 25 | 26 | makeElement 27 | :: Map.Map Ancestry Web.DOM.Element 28 | -> MakeElement 29 | makeElement renderingInfo = mkEffectFn3 \id _ _ -> do 30 | let ri = Map.lookup id renderingInfo 31 | case ri of 32 | Nothing -> pure $ toDekuElement unit -- force crash 33 | Just value -> pure $ toDekuElement value 34 | 35 | makeText :: Map.Map Ancestry Web.DOM.Text -> MakeText 36 | makeText textNodeCache = mkEffectFn2 \id _ -> 37 | case Map.lookup id textNodeCache of 38 | Nothing -> pure $ toDekuText unit -- force crash 39 | Just t -> pure $ toDekuText t 40 | 41 | hydratingInterpret 42 | :: Set.Set Ancestry 43 | -> STRef.STRef Global Int 44 | -> Map.Map Ancestry Web.DOM.Element 45 | -> Map.Map Ancestry Web.DOM.Text 46 | -> Set.Set Ancestry 47 | -> Core.DOMInterpret 48 | hydratingInterpret 49 | boring 50 | portalRef 51 | elementCache 52 | textNodeCache 53 | renderedPortals = 54 | Core.DOMInterpret 55 | { 56 | -- we could likely make `dynamicDOMInterpret` a no-op 57 | -- should be harmless, though, as this will be called rarely if at all 58 | -- because SSR code will only trigger dynamic elements 59 | -- in case there's a dyn with pure polls that aren't optimized as being pure 60 | dynamicDOMInterpret: \_ -> spaInterpret 61 | , portalDOMInterpret: \a -> 62 | if Set.member a renderedPortals then hydratingInterpret boring 63 | portalRef 64 | elementCache 65 | textNodeCache 66 | renderedPortals 67 | else spaInterpret 68 | -- 69 | , isBoring: flip Set.member boring 70 | , makeElement: makeElement elementCache 71 | -- attachments should never happen during hydration 72 | -- the dynamicDOMInterpret should always kick in 73 | -- when an attachment actually needs to occur 74 | -- so we make it a noop 75 | , attachElement: mkEffectFn2 \_ _ -> pure unit 76 | , initializeElementRendering: mkSTFn2 \_ _ -> pure unit 77 | , initializeTextRendering: mkSTFn2 \_ _ -> pure unit 78 | , markElementAsImpure: mkSTFn1 \_ -> pure unit 79 | , setProp: mkEffectFn3 \_ _ _ -> pure unit 80 | , setCb: I.setCbEffect 81 | , unsetAttribute: I.unsetAttributeEffect 82 | , removeElement: I.removeElementEffect 83 | , makeText: makeText textNodeCache 84 | , attachText: mkEffectFn2 \_ _ -> pure unit 85 | , setText: mkEffectFn2 \_ _ -> pure unit 86 | , removeText: I.removeTextEffect 87 | , markTextAsImpure: mkSTFn1 \_ -> pure unit 88 | -- 89 | , beamRegion: I.beamRegionEffect 90 | , markPortalAsRendered: mkSTFn1 \_ -> pure unit 91 | , bufferPortal: do 92 | i <- liftST $ STRef.modify (_ + 1) portalRef 93 | Tuple _ p <- I.bufferPortal 94 | pure $ Tuple i p 95 | , initializePortalRendering: mkSTFn1 \_ -> pure unit 96 | , initializeDynRendering: mkSTFn1 \_ -> pure unit 97 | , initializeFixedRendering: mkSTFn1 \_ -> pure unit 98 | , setInnerHTML: mkEffectFn2 \_ _ -> pure unit 99 | } -------------------------------------------------------------------------------- /deku-ssr/src/Deku/SSR.js: -------------------------------------------------------------------------------- 1 | export const innerHTML = (element) => () => element.innerHTML; 2 | 3 | export const transformTextNode = (id) => (textNode) => () => { 4 | 5 | let beforeComment = document.createComment(`d$i@${id}`); 6 | let afterComment = document.createComment(`d$o@${id}`); 7 | 8 | if (textNode && textNode.parentNode) { 9 | textNode.parentNode.insertBefore(beforeComment, textNode); 10 | textNode.parentNode.insertBefore(afterComment, textNode); 11 | textNode.parentNode.insertBefore(textNode, afterComment); 12 | } 13 | }; 14 | 15 | export const mapIdsToTextNodes = (rootElement) => () => { 16 | const result = []; 17 | 18 | // Create a TreeWalker to traverse the DOM tree and show all comments 19 | const treeWalker = document.createTreeWalker( 20 | rootElement, 21 | NodeFilter.SHOW_COMMENT, 22 | { 23 | acceptNode: function (node) { 24 | if ( 25 | node.nodeType === Node.COMMENT_NODE && 26 | node.nodeValue.match(/^d\$i@.*$/) 27 | ) { 28 | return NodeFilter.FILTER_ACCEPT; 29 | } 30 | return NodeFilter.FILTER_SKIP; 31 | }, 32 | }, 33 | false 34 | ); 35 | 36 | // Use the TreeWalker to find the comment nodes 37 | let currentNode; 38 | while ((currentNode = treeWalker.nextNode())) { 39 | const match = currentNode.nodeValue.match(/^d\$i@(.*)$/); 40 | if (match) { 41 | const id = match[1]; 42 | let nextNode = currentNode.nextSibling; 43 | 44 | if (nextNode && nextNode.nodeType === Node.TEXT_NODE) { 45 | result.push({ k: id, v: nextNode }); 46 | } else { 47 | // Create a new text node, insert it after the comment, and make it the value 48 | const newTextNode = document.createTextNode(""); 49 | currentNode.parentNode.insertBefore(newTextNode, nextNode); 50 | result.push({ k: id, v: newTextNode }); 51 | } 52 | } 53 | } 54 | 55 | return result; 56 | }; 57 | -------------------------------------------------------------------------------- /deku-ssr/src/Deku/SSR.purs: -------------------------------------------------------------------------------- 1 | -- | These functions are used to run a Deku application. 2 | module Deku.SSR 3 | ( ssrInElement 4 | , ssrInBody 5 | , hydrateInElement 6 | , hydrateInBody 7 | , SSROutput 8 | ) where 9 | 10 | import Prelude 11 | 12 | import Control.Monad.ST.Class (liftST) 13 | import Control.Monad.ST.Internal as ST 14 | import Control.Monad.ST.Uncurried (runSTFn1, runSTFn3) 15 | import Control.Monad.Writer (lift, runWriterT, tell) 16 | import Data.Array as Array 17 | import Data.Bifunctor (lmap) 18 | import Data.Filterable (filterMap) 19 | import Data.FoldableWithIndex (forWithIndex_) 20 | import Data.Map as Map 21 | import Data.Map.Internal (Map(..)) 22 | import Data.Maybe (Maybe(..), maybe) 23 | import Data.Newtype (un) 24 | import Data.Set as Set 25 | import Data.String as String 26 | import Data.Traversable (foldl, for_, sequence, traverse) 27 | import Data.Tuple (Tuple(..), swap) 28 | import Data.Tuple.Nested ((/\)) 29 | import Deku.Core (Nut(..), newPSR) 30 | import Deku.HydratingInterpret (hydratingInterpret) 31 | import Deku.Internal.Ancestry (Ancestry, DekuAncestry(..), reconstructAncestry, unsafeCollectLineage) 32 | import Deku.Internal.Ancestry as Ancestry 33 | import Deku.Internal.Entities (DekuParent(..), fromDekuElement, fromDekuText, toDekuElement) 34 | import Deku.Internal.Region as Region 35 | import Deku.SSR.Optimize (hasPlainAncestry, truncateLineageBy1) 36 | import Deku.SSRInterpret (SSRElementRenderingInfo(..), SSRTextRenderingInfo(..), ssrInterpret) 37 | import Effect (Effect) 38 | import Effect.Exception (error, throwException) 39 | import Effect.Uncurried (runEffectFn2) 40 | import FRP.Poll (create) 41 | import Web.DOM as Web.DOM 42 | import Web.DOM.Element (getAttribute, removeAttribute, setAttribute, toParentNode) 43 | import Web.DOM.Element as Element 44 | import Web.DOM.Node (nextSibling, parentNode, previousSibling, removeChild) 45 | import Web.DOM.NodeList (toArray) 46 | import Web.DOM.ParentNode (QuerySelector(..), querySelectorAll) 47 | import Web.DOM.Text as Text 48 | import Web.HTML (window) 49 | import Web.HTML.HTMLDocument (body) 50 | import Web.HTML.HTMLElement (toElement) 51 | import Web.HTML.Window (document) 52 | 53 | doInBody :: forall i o. (Web.DOM.Element -> i -> Effect o) -> i -> Effect o 54 | doInBody f elt = do 55 | b' <- window >>= document >>= body 56 | maybe (throwException (error "Could not find element")) 57 | (flip f elt) 58 | (toElement <$> b') 59 | 60 | foreign import innerHTML :: Web.DOM.Element -> Effect String 61 | 62 | foreign import transformTextNode :: String -> Web.DOM.Text -> Effect Unit 63 | 64 | foreign import mapIdsToTextNodes 65 | :: Web.DOM.Element -> Effect (Array { k :: String, v :: Web.DOM.Text }) 66 | 67 | type SSROutput = 68 | { html :: String 69 | , livePortals :: Array Ancestry 70 | , boring :: Array Ancestry 71 | } 72 | 73 | -- we run this over all of the entries that are _not_ super safe 74 | -- in order to be super-duper safe, something can't be an ancestor of 75 | -- something that's unsafe, even if _it_ is safe 76 | -- for example, there could be a D.div that is completely safe but 77 | -- deep down in the tree in contains a dyn 78 | -- this will mark it as unsafe 79 | ancestryNotPresentIn :: DekuAncestry -> Set.Set DekuAncestry -> Boolean 80 | ancestryNotPresentIn needle haystack = any (Set.toMap haystack) 81 | where 82 | ff (Element i a) (Element j b) 83 | | i == j = ff a b 84 | | otherwise = false 85 | ff (Fixed i a) (Fixed j b) 86 | | i == j = ff a b 87 | | otherwise = false 88 | ff (Portal i a) (Portal j b) 89 | | i == j = ff a b 90 | | otherwise = false 91 | ff (Dyn i a) (Dyn j b) 92 | | i == j = ff a b 93 | | otherwise = false 94 | ff Root Root = true 95 | ff _ _ = false 96 | -- f returns true if the ancestry is present and false otherwise 97 | f a@(Element _ r) = ff needle a || f r 98 | f a@(Fixed _ r) = ff needle a || f r 99 | f a@(Dyn _ r) = ff needle a || f r 100 | f a@(Portal _ r) = ff needle a || f r 101 | f Root = ff needle Root 102 | any = case _ of 103 | Leaf -> true 104 | -- f guarantees that the ancestry is not present 105 | -- so if it is false, it terminates early 106 | Node _ _ mk _ ml mr -> not f mk && any ml && any mr 107 | 108 | ssrInElement 109 | :: Web.DOM.Element 110 | -> Nut 111 | -> Effect SSROutput 112 | ssrInElement elt (Nut nut) = do 113 | { poll: lifecycle, push: dispose } <- liftST create 114 | textCacheRef <- liftST $ ST.new Map.empty 115 | elementCacheRef <- liftST $ ST.new Map.empty 116 | purePortalsRef <- liftST $ ST.new Set.empty 117 | portalCacheRef <- liftST $ ST.new Set.empty 118 | dynCacheRef <- liftST $ ST.new Set.empty 119 | fixedCacheRef <- liftST $ ST.new Set.empty 120 | portalCtrRef <- liftST $ ST.new (-1) 121 | let 122 | di = ssrInterpret portalCtrRef textCacheRef elementCacheRef 123 | purePortalsRef 124 | portalCacheRef 125 | dynCacheRef 126 | fixedCacheRef 127 | region <- liftST $ runSTFn1 Region.fromParent (DekuParent $ toDekuElement elt) 128 | scope <- liftST $ runSTFn3 newPSR 129 | Ancestry.root 130 | lifecycle 131 | region 132 | 133 | void $ runEffectFn2 nut scope di 134 | elementCache <- liftST $ ST.read elementCacheRef 135 | textCache <- liftST $ ST.read textCacheRef 136 | forWithIndex_ elementCache \tag value -> do 137 | setAttribute "data-deku-ssr" (Ancestry.toStringRepresentationInDOM tag) $ 138 | fromDekuElement (un SSRElementRenderingInfo value).backingElement 139 | forWithIndex_ textCache \tag value -> do 140 | transformTextNode (Ancestry.toStringRepresentationInDOM tag) $ fromDekuText 141 | (un SSRTextRenderingInfo value).backingText 142 | let 143 | setMapOpPar = Set.fromFoldable 144 | <<< filterMap (unsafeCollectLineage >=> truncateLineageBy1) 145 | <<< (Set.toUnfoldable :: _ -> Array _) 146 | setMapOp = Set.fromFoldable 147 | <<< filterMap unsafeCollectLineage 148 | <<< (Set.toUnfoldable :: _ -> Array _) 149 | -- 150 | allParDynAncestry <- setMapOpPar <$> (liftST $ ST.read dynCacheRef) 151 | allParPortalAncestry <- setMapOpPar <$> (liftST $ ST.read portalCacheRef) 152 | allParFixedAncestry <- setMapOpPar <$> (liftST $ ST.read fixedCacheRef) 153 | -- 154 | allDynAncestry <- setMapOp <$> (liftST $ ST.read dynCacheRef) 155 | allPortalAncestry <- setMapOp <$> (liftST $ ST.read portalCacheRef) 156 | allFixedAncestry <- setMapOp <$> (liftST $ ST.read fixedCacheRef) 157 | -- 158 | let 159 | allDynamicEntries = allDynAncestry <> allPortalAncestry <> allFixedAncestry 160 | allDekuEltAndTextAncestries = 161 | foldl (\b a -> maybe b (flip Set.insert b) $ unsafeCollectLineage a) 162 | Set.empty $ Map.keys textCache <> Map.keys elementCache 163 | safeEntries = Set.filter 164 | ( hasPlainAncestry 165 | (allParDynAncestry <> allParPortalAncestry <> allParFixedAncestry) 166 | allDynamicEntries 167 | ) 168 | allDekuEltAndTextAncestries 169 | elementCache' = Map.fromFoldable $ filterMap 170 | (lmap unsafeCollectLineage >>> swap >>> sequence >>> map swap) 171 | (Map.toUnfoldable elementCache :: Array _) 172 | textCache' = Map.fromFoldable $ filterMap 173 | (lmap unsafeCollectLineage >>> swap >>> sequence >>> map swap) 174 | (Map.toUnfoldable textCache :: Array _) 175 | Tuple _ superSafeEntries <- map (map Set.fromFoldable) $ runWriterT $ for_ 176 | safeEntries 177 | \se -> do 178 | for_ (Map.lookup se elementCache') 179 | \(SSRElementRenderingInfo { isImpure, backingElement }) -> 180 | when (not isImpure) do 181 | tell [ se ] 182 | lift do 183 | removeAttribute "data-deku-ssr" $ fromDekuElement backingElement 184 | for_ (Map.lookup se textCache') 185 | \(SSRTextRenderingInfo { backingText, isImpure }) -> 186 | when (not isImpure) do 187 | tell [ se ] 188 | lift do 189 | let tn = Text.toNode $ fromDekuText backingText 190 | prevComment <- previousSibling tn 191 | nextComment <- nextSibling tn 192 | for_ prevComment \pc -> 193 | for_ nextComment \nc -> do 194 | par <- parentNode pc 195 | for_ par \p -> do 196 | removeChild pc p 197 | removeChild nc p 198 | let 199 | superDuperSafeEntries = Set.filter 200 | ( flip ancestryNotPresentIn 201 | ( Set.difference (allDekuEltAndTextAncestries <> allDynamicEntries) 202 | superSafeEntries 203 | ) 204 | ) 205 | superSafeEntries 206 | boring = Set.filter 207 | ( maybe true (not $ flip Set.member superDuperSafeEntries) <<< 208 | truncateLineageBy1 209 | ) 210 | superDuperSafeEntries 211 | htmlString <- innerHTML elt 212 | dispose unit 213 | livePortals <- liftST $ ST.read purePortalsRef 214 | pure $ 215 | { html: String.replace (String.Pattern "data-deku-value") 216 | (String.Replacement "value") 217 | htmlString 218 | , livePortals: Array.fromFoldable livePortals 219 | , boring:reconstructAncestry <$> Array.fromFoldable boring 220 | } 221 | 222 | ssrInBody 223 | :: Nut 224 | -> Effect SSROutput 225 | ssrInBody = doInBody ssrInElement 226 | 227 | hydrateInElement 228 | :: forall r 229 | . { livePortals :: Array Ancestry 230 | , boring :: Array Ancestry 231 | | r 232 | } 233 | -> Web.DOM.Element 234 | -> Nut 235 | -> Effect (Effect Unit) 236 | hydrateInElement { livePortals, boring } ielt (Nut nut) = do 237 | { poll: lifecycle, push: dispose } <- liftST create 238 | portalCtrRef <- liftST $ ST.new (-1) 239 | region <- liftST $ runSTFn1 Region.fromParent 240 | (DekuParent $ toDekuElement ielt) 241 | nodes <- 242 | querySelectorAll (QuerySelector "[data-deku-ssr]") (toParentNode ielt) 243 | >>= toArray 244 | kv <- nodes # traverse \node -> do 245 | case Element.fromNode node of 246 | Nothing -> throwException (error "Could not convert node to element") 247 | Just elt -> do 248 | attr <- getAttribute "data-deku-ssr" elt 249 | case attr of 250 | Nothing -> throwException (error "Could not get ssr rep") 251 | Just k -> pure $ Tuple (Ancestry.unsafeFakeAncestry k) elt 252 | textNodes <- 253 | Map.fromFoldable <<< map (\{ k, v } -> Ancestry.unsafeFakeAncestry k /\ v) 254 | <$> 255 | mapIdsToTextNodes ielt 256 | scope <- liftST $ runSTFn3 newPSR Ancestry.root lifecycle region 257 | void $ runEffectFn2 nut scope 258 | ( hydratingInterpret (Set.fromFoldable boring) portalCtrRef (Map.fromFoldable kv) textNodes 259 | (Set.fromFoldable livePortals) 260 | ) 261 | pure $ dispose unit 262 | 263 | hydrateInBody 264 | :: forall r 265 | . { livePortals :: Array Ancestry 266 | , boring :: Array Ancestry 267 | | r 268 | } 269 | -> Nut 270 | -> Effect (Effect Unit) 271 | hydrateInBody = doInBody <<< hydrateInElement 272 | -------------------------------------------------------------------------------- /deku-ssr/src/Deku/SSR/Optimize.purs: -------------------------------------------------------------------------------- 1 | -- In its naïve form, Deku SSR adds tags and identifiers to every DOM element 2 | -- and text. This is unnecessary for sites that have lots of static content. 3 | -- This module provides a way to optimize the SSR output by removing the 4 | -- unnecessary tags and identifiers. It also constructs an `isBoring` cache 5 | -- that identifies which elements can be skipped entirely during hydration. 6 | 7 | module Deku.SSR.Optimize where 8 | 9 | import Prelude 10 | 11 | import Data.Maybe (Maybe(..)) 12 | import Data.Set as Set 13 | import Deku.Internal.Ancestry (DekuAncestry(..)) 14 | 15 | truncateLineageBy1 :: DekuAncestry -> Maybe DekuAncestry 16 | truncateLineageBy1 (Element _ a) = Just a 17 | truncateLineageBy1 (Fixed _ a) = Just a 18 | truncateLineageBy1 (Dyn _ a) = Just a 19 | truncateLineageBy1 (Portal _ a) = Just a 20 | truncateLineageBy1 Root = Nothing 21 | 22 | lacksDynamicChildren :: Set.Set DekuAncestry -> DekuAncestry -> Boolean 23 | lacksDynamicChildren = not $ flip Set.member 24 | 25 | -- todo: a lot of fixed elements will have plain ancestry but are 26 | -- disqualified from this algo currently 27 | -- it's possible to code around that but it requires a lot of attention to detail 28 | -- some tests will currently pick up on that but there aren't enough 29 | -- so if anyone tackles fixed in this function, make sure to write more tests 30 | -- using `fixed` in corner-case-y ways 31 | hasPlainAncestry 32 | :: Set.Set DekuAncestry -> Set.Set DekuAncestry -> DekuAncestry -> Boolean 33 | hasPlainAncestry parDynamos = go 34 | where 35 | -- we always check if the parent has dynamic children 36 | -- if so, it will need to be used as an anchor, so we disqualify it 37 | ldc = lacksDynamicChildren parDynamos 38 | go dynamos an@(Element i a) 39 | -- succeeds if the left and right elements are static 40 | | not 41 | ( Set.member (Element (i - 1) a) dynamos || Set.member 42 | (Element (i + 1) a) 43 | dynamos 44 | ) = ldc an 45 | | otherwise = false 46 | go _ Root = ldc Root 47 | go _ _ = false -------------------------------------------------------------------------------- /deku-ssr/src/Deku/SSRInterpret.purs: -------------------------------------------------------------------------------- 1 | module Deku.SSRInterpret where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.ST.Class (liftST) 6 | import Control.Monad.ST.Global (Global) 7 | import Control.Monad.ST.Internal as STRef 8 | import Control.Monad.ST.Uncurried (STFn1, STFn2, STFn3, mkSTFn1, mkSTFn2, mkSTFn3, runSTFn3) 9 | import Data.Map as Map 10 | import Data.Maybe (Maybe(..)) 11 | import Data.Newtype (class Newtype, over) 12 | import Data.Set as Set 13 | import Data.Tuple (Tuple(..)) 14 | import Deku.Core as Core 15 | import Deku.Internal.Ancestry (Ancestry) 16 | import Deku.Internal.Entities (DekuElement, DekuText, fromDekuElement) 17 | import Deku.DOMInterpret as I 18 | import Effect.Uncurried (mkEffectFn1, mkEffectFn2, mkEffectFn3, runEffectFn3) 19 | import Web.DOM.Element (setAttribute) 20 | 21 | updateRenderingInfo 22 | :: forall k a 23 | . Ord k 24 | => STFn3 k (a -> a) 25 | (STRef.STRef Global (Map.Map k a)) 26 | Global 27 | Unit 28 | updateRenderingInfo = mkSTFn3 \id fn renderingInfo -> do 29 | void $ STRef.modify (Map.alter (map fn) id) renderingInfo 30 | 31 | type SSRElementRenderingInfoCache = Map.Map Ancestry SSRElementRenderingInfo 32 | 33 | newtype SSRElementRenderingInfo = SSRElementRenderingInfo 34 | { isImpure :: Boolean 35 | , ancestry :: Ancestry 36 | , backingElement :: DekuElement 37 | } 38 | 39 | derive instance Newtype SSRElementRenderingInfo _ 40 | 41 | initializeElementRendering 42 | :: STRef.STRef Global SSRElementRenderingInfoCache 43 | -> STFn2 Ancestry DekuElement Global Unit 44 | initializeElementRendering renderingInfo = mkSTFn2 45 | \ancestry backingElement -> do 46 | void $ STRef.modify 47 | ( Map.alter 48 | ( const $ Just $ SSRElementRenderingInfo 49 | { isImpure: false 50 | , ancestry 51 | , backingElement 52 | } 53 | ) 54 | ancestry 55 | ) 56 | renderingInfo 57 | 58 | markTextAsImpure 59 | :: STRef.STRef Global SSRTextRenderingInfoCache 60 | -> STFn1 Ancestry Global Unit 61 | markTextAsImpure renderingInfo = mkSTFn1 \id -> do 62 | runSTFn3 updateRenderingInfo id f renderingInfo 63 | where 64 | f = over SSRTextRenderingInfo \r -> r 65 | { isImpure = true 66 | } 67 | 68 | markElementAsImpure 69 | :: STRef.STRef Global SSRElementRenderingInfoCache 70 | -> STFn1 Ancestry Global Unit 71 | markElementAsImpure renderingInfo = mkSTFn1 \id -> do 72 | runSTFn3 updateRenderingInfo id f renderingInfo 73 | where 74 | f = over SSRElementRenderingInfo \r -> r 75 | { isImpure = true 76 | } 77 | 78 | type SSRTextRenderingInfoCache = Map.Map Ancestry SSRTextRenderingInfo 79 | 80 | newtype SSRTextRenderingInfo = SSRTextRenderingInfo 81 | { ancestry :: Ancestry 82 | , isImpure :: Boolean 83 | , backingText :: DekuText 84 | } 85 | 86 | derive instance Newtype SSRTextRenderingInfo _ 87 | 88 | initializeTextRendering 89 | :: STRef.STRef Global SSRTextRenderingInfoCache 90 | -> STFn2 Ancestry DekuText Global Unit 91 | initializeTextRendering renderingInfo = mkSTFn2 92 | \ancestry backingText -> do 93 | void $ STRef.modify 94 | ( Map.alter 95 | ( const $ Just $ SSRTextRenderingInfo 96 | { ancestry 97 | , isImpure: false 98 | , backingText 99 | } 100 | ) 101 | ancestry 102 | ) 103 | renderingInfo 104 | 105 | ssrInterpret 106 | :: STRef.STRef Global Int 107 | -> STRef.STRef Global SSRTextRenderingInfoCache 108 | -> STRef.STRef Global SSRElementRenderingInfoCache 109 | -> STRef.STRef Global (Set.Set Ancestry) 110 | -> STRef.STRef Global (Set.Set Ancestry) 111 | -> STRef.STRef Global (Set.Set Ancestry) 112 | -> STRef.STRef Global (Set.Set Ancestry) 113 | -> Core.DOMInterpret 114 | ssrInterpret 115 | portalRef 116 | textRenderingInfo 117 | elementRenderingInfo 118 | purePortalCache 119 | portalCache 120 | dynCache 121 | fixedCache = 122 | Core.DOMInterpret 123 | { dynamicDOMInterpret: \_ -> noOpDomInterpret 124 | , portalDOMInterpret: \_ -> ssrInterpret portalRef textRenderingInfo 125 | elementRenderingInfo 126 | purePortalCache 127 | portalCache 128 | dynCache 129 | fixedCache 130 | -- 131 | , isBoring: const false 132 | , makeElement: I.makeElementEffect 133 | , attachElement: I.attachElementEffect 134 | , initializeElementRendering: initializeElementRendering 135 | elementRenderingInfo 136 | , markElementAsImpure: markElementAsImpure 137 | elementRenderingInfo 138 | , setProp: mkEffectFn3 \a@(Core.Key k) b@(Core.Value v) elt' -> do 139 | -- innerHTML doesn't show values 140 | -- so we set it this way and then sub it out later 141 | let elt = fromDekuElement elt' 142 | when (k == "value") do 143 | setAttribute "data-deku-value" v elt 144 | runEffectFn3 I.setPropEffect a b elt' 145 | , setCb: I.setCbEffect 146 | , unsetAttribute: I.unsetAttributeEffect 147 | , removeElement: I.removeElementEffect 148 | -- 149 | , makeText: I.makeTextEffect 150 | , attachText: I.attachTextEffect 151 | , setText: I.setTextEffect 152 | , removeText: I.removeTextEffect 153 | , initializeTextRendering: initializeTextRendering textRenderingInfo 154 | , markTextAsImpure: markTextAsImpure textRenderingInfo 155 | -- 156 | , beamRegion: I.beamRegionEffect 157 | , bufferPortal: do 158 | i <- liftST $ STRef.modify (_ + 1) portalRef 159 | Tuple _ p <- I.bufferPortal 160 | pure $ Tuple i p 161 | , markPortalAsRendered: mkSTFn1 \a -> void $ STRef.modify (Set.insert a) 162 | purePortalCache 163 | , initializePortalRendering: mkSTFn1 \a -> void $ STRef.modify 164 | (Set.insert a) 165 | portalCache 166 | , initializeDynRendering: mkSTFn1 \a -> void $ STRef.modify (Set.insert a) 167 | dynCache 168 | , initializeFixedRendering: mkSTFn1 \a -> void $ STRef.modify (Set.insert a) 169 | fixedCache 170 | , setInnerHTML: I.setInnerHtmlEffect 171 | 172 | } 173 | 174 | noOpDomInterpret 175 | :: Core.DOMInterpret 176 | noOpDomInterpret = 177 | Core.DOMInterpret 178 | { -- we could likely make `dynamicDOMInterpret` a no-op 179 | -- should be harmless, though, as this will be called rarely if at all 180 | -- because SSR code will only trigger dynamic elements 181 | -- in case there's a dyn with pure polls that aren't optimized as being pure 182 | dynamicDOMInterpret: \_ -> noOpDomInterpret 183 | , portalDOMInterpret: \_ -> noOpDomInterpret 184 | -- 185 | , isBoring: const false 186 | , markElementAsImpure: mkSTFn1 \_ -> pure unit 187 | , makeElement: I.makeElementEffect 188 | , attachElement: mkEffectFn2 \_ _ -> pure unit 189 | , initializeElementRendering: mkSTFn2 \_ _ -> pure unit 190 | , initializeTextRendering: mkSTFn2 \_ _ -> pure unit 191 | , setProp: mkEffectFn3 \_ _ _ -> pure unit 192 | , setCb: mkEffectFn3 \_ _ _ -> pure unit 193 | , unsetAttribute: mkEffectFn2 \_ _ -> pure unit 194 | , removeElement: mkEffectFn1 \_ -> pure unit 195 | -- 196 | , makeText: I.makeTextEffect 197 | , attachText: mkEffectFn2 \_ _ -> pure unit 198 | , setText: mkEffectFn2 \_ _ -> pure unit 199 | , removeText: mkEffectFn1 \_ -> pure unit 200 | , markTextAsImpure: mkSTFn1 \_ -> pure unit 201 | -- 202 | , beamRegion: mkEffectFn3 \_ _ _ -> pure unit 203 | , markPortalAsRendered: mkSTFn1 \_ -> pure unit 204 | , bufferPortal: I.bufferPortal 205 | , initializePortalRendering: mkSTFn1 \_ -> pure unit 206 | , initializeDynRendering: mkSTFn1 \_ -> pure unit 207 | , initializeFixedRendering: mkSTFn1 \_ -> pure unit 208 | , setInnerHTML: mkEffectFn2 \_ _ -> pure unit 209 | } -------------------------------------------------------------------------------- /deku-test/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | name: deku-test 3 | publish: 4 | version: 0.9.24 5 | license: "Apache-2.0" 6 | dependencies: 7 | - deku-core 8 | - deku-css 9 | - deku-dom 10 | test: 11 | dependencies: 12 | - arrays 13 | - control 14 | - deku-core 15 | - deku-dom 16 | - deku-spa 17 | - deku-ssr 18 | - effect 19 | - filterable 20 | - foldable-traversable 21 | - hyrule 22 | - maybe 23 | - prelude 24 | - random 25 | - record 26 | - refs 27 | - spec 28 | - spec-node 29 | - st 30 | - tailrec 31 | - tuples 32 | - web-html 33 | main: Test.Main 34 | -------------------------------------------------------------------------------- /deku-test/test/Test/Main.js: -------------------------------------------------------------------------------- 1 | import jsdomGlobal from "jsdom-global"; 2 | export const hackyInnerHTML = (id) => (s) => () => 3 | (document.getElementById(id).innerHTML = s); 4 | export const resetBody = () => { 5 | document.getElementsByTagName("html")[0].innerHTML = 6 | ''; 7 | }; 8 | export const initializeJSDOM = () => jsdomGlobal(); -------------------------------------------------------------------------------- /deku-test/test/Test/TestFriend.purs: -------------------------------------------------------------------------------- 1 | module Test.TestFriend where 2 | 3 | import Data.Maybe (Maybe(..)) 4 | import Effect (Effect) 5 | import Effect.Ref (Ref, new) 6 | 7 | just :: forall @a. a -> Maybe a 8 | just = Just 9 | 10 | nothing :: forall @a. Maybe a 11 | nothing = Nothing 12 | 13 | unlucky :: Effect (Ref Boolean) 14 | unlucky = new false 15 | 16 | dummyId :: Int 17 | dummyId = 42 18 | 19 | ignorableBooleanForTextConstructor :: Boolean 20 | ignorableBooleanForTextConstructor = false 21 | -------------------------------------------------------------------------------- /deku.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikesol/purescript-deku/4d18f6ccebb4a59cdd2a6d2d9e2466349bf8df20/deku.gif -------------------------------------------------------------------------------- /jest.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | testEnvironment: "jsdom" 3 | , testPathIgnorePatterns: ["/node_modules/", "/test/test.js"] 4 | } -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "name": "purescript-deku", 4 | "version": "0.9.13", 5 | "description": "A friendly tree-like structure in the browser.", 6 | "scripts": { 7 | "clean": "rm -rf .spago output node_modules *.lock", 8 | "build": "spago build", 9 | "build:examples": "spago build -p examples", 10 | "test": "spago build && jest && spago test", 11 | "generate": "spago run -p codegen" 12 | }, 13 | "keywords": [], 14 | "author": "", 15 | "license": "ISC", 16 | "devDependencies": { 17 | "@babel/core": "^7.26.10", 18 | "@babel/preset-env": "^7.26.9", 19 | "babel-jest": "^29.7.0", 20 | "bindings": "^1.5.0", 21 | "esbuild": "^0.14.54", 22 | "filter-console": "^0.1.1", 23 | "headless-devtools": "^2.0.1", 24 | "jest": "^29.7.0", 25 | "jest-environment-jsdom": "^29.7.0", 26 | "jquery": "^3.7.1", 27 | "jsdom": "^22.1.0", 28 | "jsdom-global": "^3.0.2", 29 | "netlify-cli": "^8.19.3", 30 | "pulp": "^16.0.2", 31 | "purs-backend-es": "^1.4.3", 32 | "purs-tidy": "^0.10.1", 33 | "spago": "^0.93.43", 34 | "test": "^0.6.0", 35 | "tracealyzer": "^0.10.3" 36 | }, 37 | "dependencies": { 38 | "htmlparser2": "^9.1.0" 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /spago.yaml: -------------------------------------------------------------------------------- 1 | workspace: 2 | packageSet: 3 | registry: 58.0.0 4 | # backend: 5 | # cmd: purs-backend-es 6 | # args: 7 | # - build 8 | extraPackages: 9 | tldr: 10 | git: "https://github.com/mikesol/purescript-tldr.git" 11 | ref: "7945d3f" 12 | dependencies: [prelude] 13 | hyrule: 14 | git: "https://github.com/mikesol/purescript-hyrule.git" 15 | # ref: "bf0833f" 16 | ref: "v2.5.1" 17 | dependencies: 18 | - effect 19 | - avar 20 | - js-timers 21 | - avar 22 | - web-html 23 | - unsafe-reference 24 | - web-uievents 25 | tidy: 26 | repo: "https://github.com/natefaubion/purescript-tidy.git" 27 | version: "v0.10.0" 28 | dependencies: 29 | - arrays 30 | - dodo-printer 31 | - foldable-traversable 32 | - lists 33 | - maybe 34 | - ordered-collections 35 | - partial 36 | - prelude 37 | - language-cst-parser 38 | - strings 39 | - tuples 40 | dodo-printer: 41 | repo: "https://github.com/natefaubion/purescript-dodo-printer" 42 | version: "master" 43 | dependencies: 44 | - aff 45 | - ansi 46 | - arrays 47 | - avar 48 | - console 49 | - "ansi" 50 | - "arrays" 51 | - "avar" 52 | - "console" 53 | - "control" 54 | - "effect" 55 | - "either" 56 | - "exceptions" 57 | - "foldable-traversable" 58 | - "integers" 59 | - "lists" 60 | - "maybe" 61 | - "minibench" 62 | - "newtype" 63 | - "node-buffer" 64 | - "node-child-process" 65 | - "node-fs" 66 | - "node-os" 67 | - "node-path" 68 | - "node-process" 69 | - "node-streams" 70 | - "parallel" 71 | - "partial" 72 | - "prelude" 73 | - "safe-coerce" 74 | - "strings" 75 | - "tuples" 76 | tidy-codegen: 77 | repo: "https://github.com/natefaubion/purescript-tidy-codegen" 78 | version: "main" 79 | dependencies: 80 | - aff 81 | - ansi 82 | - arrays 83 | - avar 84 | - bifunctors 85 | - console 86 | - control 87 | - dodo-printer 88 | - effect 89 | - either 90 | - enums 91 | - exceptions 92 | - filterable 93 | - foldable-traversable 94 | - free 95 | - identity 96 | - integers 97 | - language-cst-parser 98 | - lazy 99 | - lists 100 | - maybe 101 | - newtype 102 | - node-buffer 103 | - node-child-process 104 | - node-fs 105 | - node-path 106 | - node-process 107 | - node-streams 108 | - ordered-collections 109 | - parallel 110 | - partial 111 | - posix-types 112 | - prelude 113 | - record 114 | - safe-coerce 115 | - st 116 | - strings 117 | - tidy 118 | - transformers 119 | - tuples 120 | - type-equality 121 | - unicode 122 | --------------------------------------------------------------------------------