├── .github
    └── workflows
    │   └── ci.yml
├── .gitignore
├── .tidyrc.json
├── LICENSE
├── README.md
├── package-lock.json
├── package.json
├── spago.lock
├── spago.yaml
├── src
    └── Tidy
    │   ├── Codegen.purs
    │   └── Codegen
    │       ├── Class.purs
    │       ├── Common.purs
    │       ├── Monad.purs
    │       ├── Precedence.purs
    │       ├── String.purs
    │       └── Types.purs
└── test
    ├── GenerateExamples.purs
    ├── Main.purs
    ├── Snapshot.purs
    ├── Util.purs
    └── snapshots
        ├── CodegenBinders.output
        ├── CodegenBinders.purs
        ├── CodegenClass.output
        ├── CodegenClass.purs
        ├── CodegenData.output
        ├── CodegenData.purs
        ├── CodegenExamples.output
        ├── CodegenExamples.purs
        ├── CodegenExports.output
        ├── CodegenExports.purs
        ├── CodegenImports.output
        ├── CodegenImports.purs
        ├── CodegenInstance.output
        ├── CodegenInstance.purs
        ├── CodegenMonad.output
        ├── CodegenMonad.purs
        ├── CodegenNewtype.output
        ├── CodegenNewtype.purs
        ├── CodegenReadme.output
        ├── CodegenReadme.purs
        ├── CodegenTypeSynonym.output
        └── CodegenTypeSynonym.purs


/.github/workflows/ci.yml:
--------------------------------------------------------------------------------
 1 | name: CI
 2 | 
 3 | on:
 4 |   push:
 5 |     branches: [main]
 6 |   pull_request:
 7 | 
 8 | jobs:
 9 |   build:
10 |     runs-on: ubuntu-latest
11 | 
12 |     steps:
13 |       - uses: actions/checkout@v4
14 | 
15 |       - uses: actions/setup-node@v4
16 |         with:
17 |           node-version: 20
18 |           cache: 'npm'
19 | 
20 |       - name: Cache PureScript dependencies
21 |         uses: actions/cache@v4
22 |         with:
23 |           key: ${{ runner.os }}-spago-${{ hashFiles('**/spago.lock') }}
24 |           path: |
25 |             .spago
26 |             output
27 | 
28 |       - name: Install npm dependencies
29 |         run: npm install
30 | 
31 |       - name: Build source
32 |         run: npx spago build --pure --pedantic-packages
33 | 
34 |       - name: Run tests
35 |         run: npm run test
36 | 
37 |       - name: Verify formatting
38 |         run: npm run format:check
39 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | /bower_components/
 2 | /node_modules/
 3 | /.pulp-cache/
 4 | /output/
 5 | /generated-docs/
 6 | /.psc-package/
 7 | /.psc*
 8 | /.purs*
 9 | /.psa*
10 | /.spago
11 | /.vscode
12 | 


--------------------------------------------------------------------------------
/.tidyrc.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "importWrap": "source",
 3 |   "indent": 2,
 4 |   "operatorsFile": null,
 5 |   "ribbon": 1,
 6 |   "typeArrowPlacement": "first",
 7 |   "unicode": "never",
 8 |   "width": null
 9 | }
10 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2021 Nathan Faubion
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of
 6 | this software and associated documentation files (the "Software"), to deal in
 7 | the Software without restriction, including without limitation the rights to
 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
 9 | the Software, and to permit persons to whom the Software is furnished to do so,
10 | subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # purescript-tidy-codegen
 2 | 
 3 | Super convenient code-generation for PureScript using `purescript-tidy`.
 4 | 
 5 | ## Introduction
 6 | 
 7 | `tidy-codegen` provides constructors for quickly building CST types from
 8 | `purescript-language-cst-parser`. Paired with `tidy`, code-generators can
 9 | be assembled in hardly any time at all.
10 | 
11 | ```purescript
12 | import Prelude
13 | import PureScript.CST.Types
14 | import Tidy.Codegen
15 | import Tidy.Codegen.Monad
16 | 
17 | import Control.Monad.Writer (tell)
18 | import Data.Maybe (Maybe(..))
19 | import Partial.Unsafe (unsafePartial)
20 | 
21 | exampleModule :: Module Void
22 | exampleModule = unsafePartial $ codegenModule "Data.Maybe" do
23 |   importOpen "Prelude"
24 |   tell
25 |     [ declData "Maybe" [ typeVar "a" ]
26 |         [ dataCtor "Nothing" []
27 |         , dataCtor "Just" [ typeVar "a" ]
28 |         ]
29 | 
30 |     , declDerive Nothing [] "Functor" [ typeCtor "Maybe" ]
31 | 
32 |     , declSignature "maybe" do
33 |         typeForall [ typeVar "a", typeVar "b" ] do
34 |           typeArrow
35 |             [ typeVar "b"
36 |             , typeArrow [ typeVar "a" ] (typeVar "b")
37 |             , typeApp (typeCtor "Maybe") [ typeVar "a" ]
38 |             ]
39 |             (typeVar "b")
40 | 
41 |     , declValue "maybe" [ binderVar "nothing", binderVar "just" ] do
42 |         exprCase [ exprSection ]
43 |           [ caseBranch [ binderCtor "Just" [ binderVar "a" ] ] do
44 |               exprApp (exprIdent "just") [ exprIdent "a" ]
45 |           , caseBranch [ binderCtor "Nothing" [] ] do
46 |               exprIdent "nothing"
47 |           ]
48 |     ]
49 | ```
50 | ```purescript
51 | module Data.Maybe where
52 | 
53 | import Prelude
54 | 
55 | data Maybe a = Nothing | Just a
56 | 
57 | derive instance Functor Maybe
58 | 
59 | maybe :: forall a b. b -> (a -> b) -> Maybe a -> b
60 | maybe nothing just = case _ of
61 |   Just a -> just a
62 |   Nothing -> nothing
63 | ```
64 | 
65 | ## A note on overloading and `Partial`
66 | 
67 | `tidy-codegen` is designed to be fast to write. It features a highly overloaded
68 | API which lets you intuitively construct CST types like it's a bare-bones AST.
69 | It's common to use string and array literals, where the CST types actually use
70 | more specific newtypes or non-empty arrays. In these cases, the overloaded APIs
71 | will do runtime validation (eg. by lexing string literals) and crash if these
72 | arguments are incorrect. This results in a `Partial` constraint which must be
73 | discharged with `unsafePartial`. If you want to avoid this partiality, you can
74 | always pass in the safe types instead with all overloaded APIs and no `Partial`
75 | constraint will be required.
76 | 
77 | ## Examples
78 | 
79 | All of the [snapshot modules](./test/snapshots) are self contained examples,
80 | with their results shown in `.output` files.
81 | 


--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "purescript-tidy-codegen",
 3 |   "scripts": {
 4 |     "examples:clean": "rm test/snapshots/*Examples.purs || true",
 5 |     "examples": "spago test -- '--generate=./src/Tidy/Codegen.purs:CodegenExamples'",
 6 |     "format": "purs-tidy format-in-place src test",
 7 |     "format:check": "purs-tidy check src test",
 8 |     "pretest": "npm run examples:clean && npm run examples",
 9 |     "test": "spago test --pure --offline"
10 |   },
11 |   "devDependencies": {
12 |     "purescript": "^0.15.15",
13 |     "purs-tidy": "^0.11.0",
14 |     "spago": "^0.93.43"
15 |   }
16 | }
17 | 


--------------------------------------------------------------------------------
/spago.lock:
--------------------------------------------------------------------------------
   1 | {
   2 |   "workspace": {
   3 |     "packages": {
   4 |       "tidy-codegen": {
   5 |         "path": "./",
   6 |         "core": {
   7 |           "dependencies": [
   8 |             {
   9 |               "arrays": ">=7.3.0 <8.0.0"
  10 |             },
  11 |             {
  12 |               "bifunctors": ">=6.0.0 <7.0.0"
  13 |             },
  14 |             {
  15 |               "control": ">=6.0.0 <7.0.0"
  16 |             },
  17 |             {
  18 |               "dodo-printer": ">=2.2.3 <3.0.0"
  19 |             },
  20 |             {
  21 |               "effect": ">=4.0.0 <5.0.0"
  22 |             },
  23 |             {
  24 |               "either": ">=6.1.0 <7.0.0"
  25 |             },
  26 |             {
  27 |               "enums": ">=6.0.1 <7.0.0"
  28 |             },
  29 |             {
  30 |               "foldable-traversable": ">=6.0.0 <7.0.0"
  31 |             },
  32 |             {
  33 |               "free": ">=7.1.0 <8.0.0"
  34 |             },
  35 |             {
  36 |               "identity": ">=6.0.0 <7.0.0"
  37 |             },
  38 |             {
  39 |               "integers": ">=6.0.0 <7.0.0"
  40 |             },
  41 |             {
  42 |               "language-cst-parser": ">=0.14.1 <0.15.0"
  43 |             },
  44 |             {
  45 |               "lazy": ">=6.0.0 <7.0.0"
  46 |             },
  47 |             {
  48 |               "lists": ">=7.0.0 <8.0.0"
  49 |             },
  50 |             {
  51 |               "maybe": ">=6.0.0 <7.0.0"
  52 |             },
  53 |             {
  54 |               "newtype": ">=5.0.0 <6.0.0"
  55 |             },
  56 |             {
  57 |               "ordered-collections": ">=3.2.0 <4.0.0"
  58 |             },
  59 |             {
  60 |               "partial": ">=4.0.0 <5.0.0"
  61 |             },
  62 |             {
  63 |               "prelude": ">=6.0.2 <7.0.0"
  64 |             },
  65 |             {
  66 |               "record": ">=4.0.0 <5.0.0"
  67 |             },
  68 |             {
  69 |               "safe-coerce": ">=2.0.0 <3.0.0"
  70 |             },
  71 |             {
  72 |               "st": ">=6.2.0 <7.0.0"
  73 |             },
  74 |             {
  75 |               "strings": ">=6.0.1 <7.0.0"
  76 |             },
  77 |             {
  78 |               "tidy": ">=0.11.1 <0.12.0"
  79 |             },
  80 |             {
  81 |               "transformers": ">=6.1.0 <7.0.0"
  82 |             },
  83 |             {
  84 |               "tuples": ">=7.0.0 <8.0.0"
  85 |             },
  86 |             {
  87 |               "type-equality": ">=4.0.1 <5.0.0"
  88 |             },
  89 |             {
  90 |               "unicode": ">=6.0.0 <7.0.0"
  91 |             }
  92 |           ],
  93 |           "build_plan": [
  94 |             "ansi",
  95 |             "arrays",
  96 |             "bifunctors",
  97 |             "catenable-lists",
  98 |             "const",
  99 |             "contravariant",
 100 |             "control",
 101 |             "distributive",
 102 |             "dodo-printer",
 103 |             "effect",
 104 |             "either",
 105 |             "enums",
 106 |             "exceptions",
 107 |             "exists",
 108 |             "foldable-traversable",
 109 |             "free",
 110 |             "functions",
 111 |             "functors",
 112 |             "gen",
 113 |             "identity",
 114 |             "integers",
 115 |             "invariant",
 116 |             "language-cst-parser",
 117 |             "lazy",
 118 |             "lists",
 119 |             "maybe",
 120 |             "newtype",
 121 |             "nonempty",
 122 |             "numbers",
 123 |             "ordered-collections",
 124 |             "orders",
 125 |             "partial",
 126 |             "prelude",
 127 |             "profunctor",
 128 |             "record",
 129 |             "refs",
 130 |             "safe-coerce",
 131 |             "st",
 132 |             "strings",
 133 |             "tailrec",
 134 |             "tidy",
 135 |             "transformers",
 136 |             "tuples",
 137 |             "type-equality",
 138 |             "typelevel-prelude",
 139 |             "unfoldable",
 140 |             "unicode",
 141 |             "unsafe-coerce"
 142 |           ]
 143 |         },
 144 |         "test": {
 145 |           "dependencies": [
 146 |             "aff",
 147 |             "ansi",
 148 |             "avar",
 149 |             "console",
 150 |             "exceptions",
 151 |             "filterable",
 152 |             "node-buffer",
 153 |             "node-child-process",
 154 |             "node-fs",
 155 |             "node-os",
 156 |             "node-path",
 157 |             "node-process",
 158 |             "node-streams",
 159 |             "parallel",
 160 |             "posix-types"
 161 |           ],
 162 |           "build_plan": [
 163 |             "aff",
 164 |             "ansi",
 165 |             "arraybuffer-types",
 166 |             "arrays",
 167 |             "avar",
 168 |             "bifunctors",
 169 |             "console",
 170 |             "const",
 171 |             "contravariant",
 172 |             "control",
 173 |             "datetime",
 174 |             "distributive",
 175 |             "effect",
 176 |             "either",
 177 |             "enums",
 178 |             "exceptions",
 179 |             "exists",
 180 |             "filterable",
 181 |             "foldable-traversable",
 182 |             "foreign",
 183 |             "foreign-object",
 184 |             "functions",
 185 |             "functors",
 186 |             "gen",
 187 |             "identity",
 188 |             "integers",
 189 |             "invariant",
 190 |             "js-date",
 191 |             "lazy",
 192 |             "lists",
 193 |             "maybe",
 194 |             "newtype",
 195 |             "node-buffer",
 196 |             "node-child-process",
 197 |             "node-event-emitter",
 198 |             "node-fs",
 199 |             "node-os",
 200 |             "node-path",
 201 |             "node-process",
 202 |             "node-streams",
 203 |             "nonempty",
 204 |             "now",
 205 |             "nullable",
 206 |             "numbers",
 207 |             "ordered-collections",
 208 |             "orders",
 209 |             "parallel",
 210 |             "partial",
 211 |             "posix-types",
 212 |             "prelude",
 213 |             "profunctor",
 214 |             "refs",
 215 |             "safe-coerce",
 216 |             "st",
 217 |             "strings",
 218 |             "tailrec",
 219 |             "transformers",
 220 |             "tuples",
 221 |             "type-equality",
 222 |             "typelevel-prelude",
 223 |             "unfoldable",
 224 |             "unsafe-coerce"
 225 |           ]
 226 |         }
 227 |       }
 228 |     },
 229 |     "extra_packages": {}
 230 |   },
 231 |   "packages": {
 232 |     "aff": {
 233 |       "type": "registry",
 234 |       "version": "8.0.0",
 235 |       "integrity": "sha256-5MmdI4+0RHBtSBy+YlU3/Cq4R5W2ih3OaRedJIrVHdk=",
 236 |       "dependencies": [
 237 |         "bifunctors",
 238 |         "control",
 239 |         "datetime",
 240 |         "effect",
 241 |         "either",
 242 |         "exceptions",
 243 |         "foldable-traversable",
 244 |         "functions",
 245 |         "maybe",
 246 |         "newtype",
 247 |         "parallel",
 248 |         "prelude",
 249 |         "refs",
 250 |         "tailrec",
 251 |         "transformers",
 252 |         "unsafe-coerce"
 253 |       ]
 254 |     },
 255 |     "ansi": {
 256 |       "type": "registry",
 257 |       "version": "7.0.0",
 258 |       "integrity": "sha256-ZMB6HD+q9CXvn9fRCmJ8dvuDrOVHcjombL3oNOerVnE=",
 259 |       "dependencies": [
 260 |         "foldable-traversable",
 261 |         "lists",
 262 |         "strings"
 263 |       ]
 264 |     },
 265 |     "arraybuffer-types": {
 266 |       "type": "registry",
 267 |       "version": "3.0.2",
 268 |       "integrity": "sha256-mQKokysYVkooS4uXbO+yovmV/s8b138Ws3zQvOwIHRA=",
 269 |       "dependencies": []
 270 |     },
 271 |     "arrays": {
 272 |       "type": "registry",
 273 |       "version": "7.3.0",
 274 |       "integrity": "sha256-tmcklBlc/muUtUfr9RapdCPwnlQeB3aSrC4dK85gQlc=",
 275 |       "dependencies": [
 276 |         "bifunctors",
 277 |         "control",
 278 |         "foldable-traversable",
 279 |         "functions",
 280 |         "maybe",
 281 |         "nonempty",
 282 |         "partial",
 283 |         "prelude",
 284 |         "safe-coerce",
 285 |         "st",
 286 |         "tailrec",
 287 |         "tuples",
 288 |         "unfoldable",
 289 |         "unsafe-coerce"
 290 |       ]
 291 |     },
 292 |     "avar": {
 293 |       "type": "registry",
 294 |       "version": "5.0.1",
 295 |       "integrity": "sha256-f+bRR3qQPa/GVe4UbLQiJBy7+PzJkUCwT6qNn0UlkMY=",
 296 |       "dependencies": [
 297 |         "aff",
 298 |         "effect",
 299 |         "either",
 300 |         "exceptions",
 301 |         "functions",
 302 |         "maybe"
 303 |       ]
 304 |     },
 305 |     "bifunctors": {
 306 |       "type": "registry",
 307 |       "version": "6.0.0",
 308 |       "integrity": "sha256-/gZwC9YhNxZNQpnHa5BIYerCGM2jeX9ukZiEvYxm5Nw=",
 309 |       "dependencies": [
 310 |         "const",
 311 |         "either",
 312 |         "newtype",
 313 |         "prelude",
 314 |         "tuples"
 315 |       ]
 316 |     },
 317 |     "catenable-lists": {
 318 |       "type": "registry",
 319 |       "version": "7.0.0",
 320 |       "integrity": "sha256-76vYENhwF4BWTBsjeLuErCH2jqVT4M3R1HX+4RwSftA=",
 321 |       "dependencies": [
 322 |         "control",
 323 |         "foldable-traversable",
 324 |         "lists",
 325 |         "maybe",
 326 |         "prelude",
 327 |         "tuples",
 328 |         "unfoldable"
 329 |       ]
 330 |     },
 331 |     "console": {
 332 |       "type": "registry",
 333 |       "version": "6.1.0",
 334 |       "integrity": "sha256-CxmAzjgyuGDmt9FZW51VhV6rBPwR6o0YeKUzA9rSzcM=",
 335 |       "dependencies": [
 336 |         "effect",
 337 |         "prelude"
 338 |       ]
 339 |     },
 340 |     "const": {
 341 |       "type": "registry",
 342 |       "version": "6.0.0",
 343 |       "integrity": "sha256-tNrxDW8D8H4jdHE2HiPzpLy08zkzJMmGHdRqt5BQuTc=",
 344 |       "dependencies": [
 345 |         "invariant",
 346 |         "newtype",
 347 |         "prelude"
 348 |       ]
 349 |     },
 350 |     "contravariant": {
 351 |       "type": "registry",
 352 |       "version": "6.0.0",
 353 |       "integrity": "sha256-TP+ooAp3vvmdjfQsQJSichF5B4BPDHp3wAJoWchip6c=",
 354 |       "dependencies": [
 355 |         "const",
 356 |         "either",
 357 |         "newtype",
 358 |         "prelude",
 359 |         "tuples"
 360 |       ]
 361 |     },
 362 |     "control": {
 363 |       "type": "registry",
 364 |       "version": "6.0.0",
 365 |       "integrity": "sha256-sH7Pg9E96JCPF9PIA6oQ8+BjTyO/BH1ZuE/bOcyj4Jk=",
 366 |       "dependencies": [
 367 |         "newtype",
 368 |         "prelude"
 369 |       ]
 370 |     },
 371 |     "datetime": {
 372 |       "type": "registry",
 373 |       "version": "6.1.0",
 374 |       "integrity": "sha256-g/5X5BBegQWLpI9IWD+sY6mcaYpzzlW5lz5NBzaMtyI=",
 375 |       "dependencies": [
 376 |         "bifunctors",
 377 |         "control",
 378 |         "either",
 379 |         "enums",
 380 |         "foldable-traversable",
 381 |         "functions",
 382 |         "gen",
 383 |         "integers",
 384 |         "lists",
 385 |         "maybe",
 386 |         "newtype",
 387 |         "numbers",
 388 |         "ordered-collections",
 389 |         "partial",
 390 |         "prelude",
 391 |         "tuples"
 392 |       ]
 393 |     },
 394 |     "distributive": {
 395 |       "type": "registry",
 396 |       "version": "6.0.0",
 397 |       "integrity": "sha256-HTDdmEnzigMl+02SJB88j+gAXDx9VKsbvR4MJGDPbOQ=",
 398 |       "dependencies": [
 399 |         "identity",
 400 |         "newtype",
 401 |         "prelude",
 402 |         "tuples",
 403 |         "type-equality"
 404 |       ]
 405 |     },
 406 |     "dodo-printer": {
 407 |       "type": "registry",
 408 |       "version": "2.2.3",
 409 |       "integrity": "sha256-+XQtWgt+ybwvQb+QbJ60wm4/hxGRAQoSmeR+Se+ZT7I=",
 410 |       "dependencies": [
 411 |         "ansi",
 412 |         "either",
 413 |         "foldable-traversable",
 414 |         "integers",
 415 |         "lists",
 416 |         "maybe",
 417 |         "newtype",
 418 |         "partial",
 419 |         "prelude",
 420 |         "safe-coerce",
 421 |         "strings",
 422 |         "tuples"
 423 |       ]
 424 |     },
 425 |     "effect": {
 426 |       "type": "registry",
 427 |       "version": "4.0.0",
 428 |       "integrity": "sha256-eBtZu+HZcMa5HilvI6kaDyVX3ji8p0W9MGKy2K4T6+M=",
 429 |       "dependencies": [
 430 |         "prelude"
 431 |       ]
 432 |     },
 433 |     "either": {
 434 |       "type": "registry",
 435 |       "version": "6.1.0",
 436 |       "integrity": "sha256-6hgTPisnMWVwQivOu2PKYcH8uqjEOOqDyaDQVUchTpY=",
 437 |       "dependencies": [
 438 |         "control",
 439 |         "invariant",
 440 |         "maybe",
 441 |         "prelude"
 442 |       ]
 443 |     },
 444 |     "enums": {
 445 |       "type": "registry",
 446 |       "version": "6.0.1",
 447 |       "integrity": "sha256-HWaD73JFLorc4A6trKIRUeDMdzE+GpkJaEOM1nTNkC8=",
 448 |       "dependencies": [
 449 |         "control",
 450 |         "either",
 451 |         "gen",
 452 |         "maybe",
 453 |         "newtype",
 454 |         "nonempty",
 455 |         "partial",
 456 |         "prelude",
 457 |         "tuples",
 458 |         "unfoldable"
 459 |       ]
 460 |     },
 461 |     "exceptions": {
 462 |       "type": "registry",
 463 |       "version": "6.1.0",
 464 |       "integrity": "sha256-K0T89IHtF3vBY7eSAO7eDOqSb2J9kZGAcDN5+IKsF8E=",
 465 |       "dependencies": [
 466 |         "effect",
 467 |         "either",
 468 |         "maybe",
 469 |         "prelude"
 470 |       ]
 471 |     },
 472 |     "exists": {
 473 |       "type": "registry",
 474 |       "version": "6.0.0",
 475 |       "integrity": "sha256-A0JQHpTfo1dNOj9U5/Fd3xndlRSE0g2IQWOGor2yXn8=",
 476 |       "dependencies": [
 477 |         "unsafe-coerce"
 478 |       ]
 479 |     },
 480 |     "filterable": {
 481 |       "type": "registry",
 482 |       "version": "5.0.0",
 483 |       "integrity": "sha256-cCojJHRnTmpY1j1kegI4CFwghdQ2Fm/8dzM8IlC+lng=",
 484 |       "dependencies": [
 485 |         "arrays",
 486 |         "either",
 487 |         "foldable-traversable",
 488 |         "identity",
 489 |         "lists",
 490 |         "ordered-collections"
 491 |       ]
 492 |     },
 493 |     "foldable-traversable": {
 494 |       "type": "registry",
 495 |       "version": "6.0.0",
 496 |       "integrity": "sha256-fLeqRYM4jUrZD5H4WqcwUgzU7XfYkzO4zhgtNc3jcWM=",
 497 |       "dependencies": [
 498 |         "bifunctors",
 499 |         "const",
 500 |         "control",
 501 |         "either",
 502 |         "functors",
 503 |         "identity",
 504 |         "maybe",
 505 |         "newtype",
 506 |         "orders",
 507 |         "prelude",
 508 |         "tuples"
 509 |       ]
 510 |     },
 511 |     "foreign": {
 512 |       "type": "registry",
 513 |       "version": "7.0.0",
 514 |       "integrity": "sha256-1ORiqoS3HW+qfwSZAppHPWy4/6AQysxZ2t29jcdUMNA=",
 515 |       "dependencies": [
 516 |         "either",
 517 |         "functions",
 518 |         "identity",
 519 |         "integers",
 520 |         "lists",
 521 |         "maybe",
 522 |         "prelude",
 523 |         "strings",
 524 |         "transformers"
 525 |       ]
 526 |     },
 527 |     "foreign-object": {
 528 |       "type": "registry",
 529 |       "version": "4.1.0",
 530 |       "integrity": "sha256-q24okj6mT+yGHYQ+ei/pYPj5ih6sTbu7eDv/WU56JVo=",
 531 |       "dependencies": [
 532 |         "arrays",
 533 |         "foldable-traversable",
 534 |         "functions",
 535 |         "gen",
 536 |         "lists",
 537 |         "maybe",
 538 |         "prelude",
 539 |         "st",
 540 |         "tailrec",
 541 |         "tuples",
 542 |         "typelevel-prelude",
 543 |         "unfoldable"
 544 |       ]
 545 |     },
 546 |     "free": {
 547 |       "type": "registry",
 548 |       "version": "7.1.0",
 549 |       "integrity": "sha256-JAumgEsGSzJCNLD8AaFvuX7CpqS5yruCngi6yI7+V5k=",
 550 |       "dependencies": [
 551 |         "catenable-lists",
 552 |         "control",
 553 |         "distributive",
 554 |         "either",
 555 |         "exists",
 556 |         "foldable-traversable",
 557 |         "invariant",
 558 |         "lazy",
 559 |         "maybe",
 560 |         "prelude",
 561 |         "tailrec",
 562 |         "transformers",
 563 |         "tuples",
 564 |         "unsafe-coerce"
 565 |       ]
 566 |     },
 567 |     "functions": {
 568 |       "type": "registry",
 569 |       "version": "6.0.0",
 570 |       "integrity": "sha256-adMyJNEnhGde2unHHAP79gPtlNjNqzgLB8arEOn9hLI=",
 571 |       "dependencies": [
 572 |         "prelude"
 573 |       ]
 574 |     },
 575 |     "functors": {
 576 |       "type": "registry",
 577 |       "version": "5.0.0",
 578 |       "integrity": "sha256-zfPWWYisbD84MqwpJSZFlvM6v86McM68ob8p9s27ywU=",
 579 |       "dependencies": [
 580 |         "bifunctors",
 581 |         "const",
 582 |         "contravariant",
 583 |         "control",
 584 |         "distributive",
 585 |         "either",
 586 |         "invariant",
 587 |         "maybe",
 588 |         "newtype",
 589 |         "prelude",
 590 |         "profunctor",
 591 |         "tuples",
 592 |         "unsafe-coerce"
 593 |       ]
 594 |     },
 595 |     "gen": {
 596 |       "type": "registry",
 597 |       "version": "4.0.0",
 598 |       "integrity": "sha256-f7yzAXWwr+xnaqEOcvyO3ezKdoes8+WXWdXIHDBCAPI=",
 599 |       "dependencies": [
 600 |         "either",
 601 |         "foldable-traversable",
 602 |         "identity",
 603 |         "maybe",
 604 |         "newtype",
 605 |         "nonempty",
 606 |         "prelude",
 607 |         "tailrec",
 608 |         "tuples",
 609 |         "unfoldable"
 610 |       ]
 611 |     },
 612 |     "identity": {
 613 |       "type": "registry",
 614 |       "version": "6.0.0",
 615 |       "integrity": "sha256-4wY0XZbAksjY6UAg99WkuKyJlQlWAfTi2ssadH0wVMY=",
 616 |       "dependencies": [
 617 |         "control",
 618 |         "invariant",
 619 |         "newtype",
 620 |         "prelude"
 621 |       ]
 622 |     },
 623 |     "integers": {
 624 |       "type": "registry",
 625 |       "version": "6.0.0",
 626 |       "integrity": "sha256-sf+sK26R1hzwl3NhXR7WAu9zCDjQnfoXwcyGoseX158=",
 627 |       "dependencies": [
 628 |         "maybe",
 629 |         "numbers",
 630 |         "prelude"
 631 |       ]
 632 |     },
 633 |     "invariant": {
 634 |       "type": "registry",
 635 |       "version": "6.0.0",
 636 |       "integrity": "sha256-RGWWyYrz0Hs1KjPDA+87Kia67ZFBhfJ5lMGOMCEFoLo=",
 637 |       "dependencies": [
 638 |         "control",
 639 |         "prelude"
 640 |       ]
 641 |     },
 642 |     "js-date": {
 643 |       "type": "registry",
 644 |       "version": "8.0.0",
 645 |       "integrity": "sha256-6TVF4DWg5JL+jRAsoMssYw8rgOVALMUHT1CuNZt8NRo=",
 646 |       "dependencies": [
 647 |         "datetime",
 648 |         "effect",
 649 |         "exceptions",
 650 |         "foreign",
 651 |         "integers",
 652 |         "now"
 653 |       ]
 654 |     },
 655 |     "language-cst-parser": {
 656 |       "type": "registry",
 657 |       "version": "0.14.1",
 658 |       "integrity": "sha256-LJzh1ZTaKjcrHx95ZfO2La3w6Xb/IZQT3m2Nuj4n1dM=",
 659 |       "dependencies": [
 660 |         "arrays",
 661 |         "const",
 662 |         "control",
 663 |         "effect",
 664 |         "either",
 665 |         "enums",
 666 |         "foldable-traversable",
 667 |         "free",
 668 |         "functions",
 669 |         "functors",
 670 |         "identity",
 671 |         "integers",
 672 |         "lazy",
 673 |         "lists",
 674 |         "maybe",
 675 |         "newtype",
 676 |         "numbers",
 677 |         "ordered-collections",
 678 |         "partial",
 679 |         "prelude",
 680 |         "st",
 681 |         "strings",
 682 |         "transformers",
 683 |         "tuples",
 684 |         "typelevel-prelude",
 685 |         "unfoldable",
 686 |         "unsafe-coerce"
 687 |       ]
 688 |     },
 689 |     "lazy": {
 690 |       "type": "registry",
 691 |       "version": "6.0.0",
 692 |       "integrity": "sha256-lMsfFOnlqfe4KzRRiW8ot5ge6HtcU3Eyh2XkXcP5IgU=",
 693 |       "dependencies": [
 694 |         "control",
 695 |         "foldable-traversable",
 696 |         "invariant",
 697 |         "prelude"
 698 |       ]
 699 |     },
 700 |     "lists": {
 701 |       "type": "registry",
 702 |       "version": "7.0.0",
 703 |       "integrity": "sha256-EKF15qYqucuXP2lT/xPxhqy58f0FFT6KHdIB/yBOayI=",
 704 |       "dependencies": [
 705 |         "bifunctors",
 706 |         "control",
 707 |         "foldable-traversable",
 708 |         "lazy",
 709 |         "maybe",
 710 |         "newtype",
 711 |         "nonempty",
 712 |         "partial",
 713 |         "prelude",
 714 |         "tailrec",
 715 |         "tuples",
 716 |         "unfoldable"
 717 |       ]
 718 |     },
 719 |     "maybe": {
 720 |       "type": "registry",
 721 |       "version": "6.0.0",
 722 |       "integrity": "sha256-5cCIb0wPwbat2PRkQhUeZO0jcAmf8jCt2qE0wbC3v2Q=",
 723 |       "dependencies": [
 724 |         "control",
 725 |         "invariant",
 726 |         "newtype",
 727 |         "prelude"
 728 |       ]
 729 |     },
 730 |     "newtype": {
 731 |       "type": "registry",
 732 |       "version": "5.0.0",
 733 |       "integrity": "sha256-gdrQu8oGe9eZE6L3wOI8ql/igOg+zEGB5ITh2g+uttw=",
 734 |       "dependencies": [
 735 |         "prelude",
 736 |         "safe-coerce"
 737 |       ]
 738 |     },
 739 |     "node-buffer": {
 740 |       "type": "registry",
 741 |       "version": "9.0.0",
 742 |       "integrity": "sha256-PWE2DJ5ruBLCmeA/fUiuySEFmUJ/VuRfyrnCuVZBlu4=",
 743 |       "dependencies": [
 744 |         "arraybuffer-types",
 745 |         "effect",
 746 |         "maybe",
 747 |         "nullable",
 748 |         "st",
 749 |         "unsafe-coerce"
 750 |       ]
 751 |     },
 752 |     "node-child-process": {
 753 |       "type": "registry",
 754 |       "version": "11.1.0",
 755 |       "integrity": "sha256-vioMNgk8p+CGwlb6T3I3TIir27el85Yg4satLE/I89w=",
 756 |       "dependencies": [
 757 |         "exceptions",
 758 |         "foreign",
 759 |         "foreign-object",
 760 |         "functions",
 761 |         "node-event-emitter",
 762 |         "node-fs",
 763 |         "node-os",
 764 |         "node-streams",
 765 |         "nullable",
 766 |         "posix-types",
 767 |         "unsafe-coerce"
 768 |       ]
 769 |     },
 770 |     "node-event-emitter": {
 771 |       "type": "registry",
 772 |       "version": "3.0.0",
 773 |       "integrity": "sha256-Qw0MjsT4xRH2j2i4K8JmRjcMKnH5z1Cw39t00q4LE4w=",
 774 |       "dependencies": [
 775 |         "effect",
 776 |         "either",
 777 |         "functions",
 778 |         "maybe",
 779 |         "nullable",
 780 |         "prelude",
 781 |         "unsafe-coerce"
 782 |       ]
 783 |     },
 784 |     "node-fs": {
 785 |       "type": "registry",
 786 |       "version": "9.2.0",
 787 |       "integrity": "sha256-Sg0vkXycEzkEerX6hLccz21Ygd9w1+QSk1thotRZPGI=",
 788 |       "dependencies": [
 789 |         "datetime",
 790 |         "effect",
 791 |         "either",
 792 |         "enums",
 793 |         "exceptions",
 794 |         "functions",
 795 |         "integers",
 796 |         "js-date",
 797 |         "maybe",
 798 |         "node-buffer",
 799 |         "node-path",
 800 |         "node-streams",
 801 |         "nullable",
 802 |         "partial",
 803 |         "prelude",
 804 |         "strings",
 805 |         "unsafe-coerce"
 806 |       ]
 807 |     },
 808 |     "node-os": {
 809 |       "type": "registry",
 810 |       "version": "5.1.0",
 811 |       "integrity": "sha256-K3gcu9AXanN1+qtk1900+Fi+CuO0s3/H/RMNRNgIzso=",
 812 |       "dependencies": [
 813 |         "arrays",
 814 |         "bifunctors",
 815 |         "console",
 816 |         "control",
 817 |         "datetime",
 818 |         "effect",
 819 |         "either",
 820 |         "exceptions",
 821 |         "foldable-traversable",
 822 |         "foreign",
 823 |         "foreign-object",
 824 |         "functions",
 825 |         "maybe",
 826 |         "node-buffer",
 827 |         "nullable",
 828 |         "partial",
 829 |         "posix-types",
 830 |         "prelude",
 831 |         "unsafe-coerce"
 832 |       ]
 833 |     },
 834 |     "node-path": {
 835 |       "type": "registry",
 836 |       "version": "5.0.1",
 837 |       "integrity": "sha256-ePOElFamHkffhwJcS0Ozq4A14rflnkasFU6X2B8/yXs=",
 838 |       "dependencies": [
 839 |         "effect"
 840 |       ]
 841 |     },
 842 |     "node-process": {
 843 |       "type": "registry",
 844 |       "version": "11.2.0",
 845 |       "integrity": "sha256-+2MQDYChjGbVbapCyJtuWYwD41jk+BntF/kcOTKBMVs=",
 846 |       "dependencies": [
 847 |         "effect",
 848 |         "foreign",
 849 |         "foreign-object",
 850 |         "maybe",
 851 |         "node-event-emitter",
 852 |         "node-streams",
 853 |         "posix-types",
 854 |         "prelude",
 855 |         "unsafe-coerce"
 856 |       ]
 857 |     },
 858 |     "node-streams": {
 859 |       "type": "registry",
 860 |       "version": "9.0.1",
 861 |       "integrity": "sha256-7RJ6RqjOlhW+QlDFQNUHlkCG/CuYTTLT8yary5jhhsU=",
 862 |       "dependencies": [
 863 |         "aff",
 864 |         "arrays",
 865 |         "effect",
 866 |         "either",
 867 |         "exceptions",
 868 |         "maybe",
 869 |         "node-buffer",
 870 |         "node-event-emitter",
 871 |         "nullable",
 872 |         "prelude",
 873 |         "refs",
 874 |         "st",
 875 |         "tailrec",
 876 |         "unsafe-coerce"
 877 |       ]
 878 |     },
 879 |     "nonempty": {
 880 |       "type": "registry",
 881 |       "version": "7.0.0",
 882 |       "integrity": "sha256-54ablJZUHGvvlTJzi3oXyPCuvY6zsrWJuH/dMJ/MFLs=",
 883 |       "dependencies": [
 884 |         "control",
 885 |         "foldable-traversable",
 886 |         "maybe",
 887 |         "prelude",
 888 |         "tuples",
 889 |         "unfoldable"
 890 |       ]
 891 |     },
 892 |     "now": {
 893 |       "type": "registry",
 894 |       "version": "6.0.0",
 895 |       "integrity": "sha256-xZ7x37ZMREfs6GCDw/h+FaKHV/3sPWmtqBZRGTxybQY=",
 896 |       "dependencies": [
 897 |         "datetime",
 898 |         "effect"
 899 |       ]
 900 |     },
 901 |     "nullable": {
 902 |       "type": "registry",
 903 |       "version": "6.0.0",
 904 |       "integrity": "sha256-yiGBVl3AD+Guy4kNWWeN+zl1gCiJK+oeIFtZtPCw4+o=",
 905 |       "dependencies": [
 906 |         "effect",
 907 |         "functions",
 908 |         "maybe"
 909 |       ]
 910 |     },
 911 |     "numbers": {
 912 |       "type": "registry",
 913 |       "version": "9.0.1",
 914 |       "integrity": "sha256-/9M6aeMDBdB4cwYDeJvLFprAHZ49EbtKQLIJsneXLIk=",
 915 |       "dependencies": [
 916 |         "functions",
 917 |         "maybe"
 918 |       ]
 919 |     },
 920 |     "ordered-collections": {
 921 |       "type": "registry",
 922 |       "version": "3.2.0",
 923 |       "integrity": "sha256-o9jqsj5rpJmMdoe/zyufWHFjYYFTTsJpgcuCnqCO6PM=",
 924 |       "dependencies": [
 925 |         "arrays",
 926 |         "foldable-traversable",
 927 |         "gen",
 928 |         "lists",
 929 |         "maybe",
 930 |         "partial",
 931 |         "prelude",
 932 |         "st",
 933 |         "tailrec",
 934 |         "tuples",
 935 |         "unfoldable"
 936 |       ]
 937 |     },
 938 |     "orders": {
 939 |       "type": "registry",
 940 |       "version": "6.0.0",
 941 |       "integrity": "sha256-nBA0g3/ai0euH8q9pSbGqk53W2q6agm/dECZTHcoink=",
 942 |       "dependencies": [
 943 |         "newtype",
 944 |         "prelude"
 945 |       ]
 946 |     },
 947 |     "parallel": {
 948 |       "type": "registry",
 949 |       "version": "7.0.0",
 950 |       "integrity": "sha256-gUC9i4Txnx9K9RcMLsjujbwZz6BB1bnE2MLvw4GIw5o=",
 951 |       "dependencies": [
 952 |         "control",
 953 |         "effect",
 954 |         "either",
 955 |         "foldable-traversable",
 956 |         "functors",
 957 |         "maybe",
 958 |         "newtype",
 959 |         "prelude",
 960 |         "profunctor",
 961 |         "refs",
 962 |         "transformers"
 963 |       ]
 964 |     },
 965 |     "partial": {
 966 |       "type": "registry",
 967 |       "version": "4.0.0",
 968 |       "integrity": "sha256-fwXerld6Xw1VkReh8yeQsdtLVrjfGiVuC5bA1Wyo/J4=",
 969 |       "dependencies": []
 970 |     },
 971 |     "posix-types": {
 972 |       "type": "registry",
 973 |       "version": "6.0.0",
 974 |       "integrity": "sha256-ZfFz8RR1lee/o/Prccyeut3Q+9tYd08mlR72sIh6GzA=",
 975 |       "dependencies": [
 976 |         "maybe",
 977 |         "prelude"
 978 |       ]
 979 |     },
 980 |     "prelude": {
 981 |       "type": "registry",
 982 |       "version": "6.0.2",
 983 |       "integrity": "sha256-kiAPZxihtAel8uRiTNdccf4qylp/9J3jNkEHNAD0MsE=",
 984 |       "dependencies": []
 985 |     },
 986 |     "profunctor": {
 987 |       "type": "registry",
 988 |       "version": "6.0.1",
 989 |       "integrity": "sha256-E58hSYdJvF2Qjf9dnWLPlJKh2Z2fLfFLkQoYi16vsFk=",
 990 |       "dependencies": [
 991 |         "control",
 992 |         "distributive",
 993 |         "either",
 994 |         "exists",
 995 |         "invariant",
 996 |         "newtype",
 997 |         "prelude",
 998 |         "tuples"
 999 |       ]
1000 |     },
1001 |     "record": {
1002 |       "type": "registry",
1003 |       "version": "4.0.0",
1004 |       "integrity": "sha256-Za5U85bTRJEfGK5Sk4hM41oXy84YQI0I8TL3WUn1Qzg=",
1005 |       "dependencies": [
1006 |         "functions",
1007 |         "prelude",
1008 |         "unsafe-coerce"
1009 |       ]
1010 |     },
1011 |     "refs": {
1012 |       "type": "registry",
1013 |       "version": "6.0.0",
1014 |       "integrity": "sha256-Vgwne7jIbD3ZMoLNNETLT8Litw6lIYo3MfYNdtYWj9s=",
1015 |       "dependencies": [
1016 |         "effect",
1017 |         "prelude"
1018 |       ]
1019 |     },
1020 |     "safe-coerce": {
1021 |       "type": "registry",
1022 |       "version": "2.0.0",
1023 |       "integrity": "sha256-a1ibQkiUcbODbLE/WAq7Ttbbh9ex+x33VCQ7GngKudU=",
1024 |       "dependencies": [
1025 |         "unsafe-coerce"
1026 |       ]
1027 |     },
1028 |     "st": {
1029 |       "type": "registry",
1030 |       "version": "6.2.0",
1031 |       "integrity": "sha256-z9X0WsOUlPwNx9GlCC+YccCyz8MejC8Wb0C4+9fiBRY=",
1032 |       "dependencies": [
1033 |         "partial",
1034 |         "prelude",
1035 |         "tailrec",
1036 |         "unsafe-coerce"
1037 |       ]
1038 |     },
1039 |     "strings": {
1040 |       "type": "registry",
1041 |       "version": "6.0.1",
1042 |       "integrity": "sha256-WssD3DbX4OPzxSdjvRMX0yvc9+pS7n5gyPv5I2Trb7k=",
1043 |       "dependencies": [
1044 |         "arrays",
1045 |         "control",
1046 |         "either",
1047 |         "enums",
1048 |         "foldable-traversable",
1049 |         "gen",
1050 |         "integers",
1051 |         "maybe",
1052 |         "newtype",
1053 |         "nonempty",
1054 |         "partial",
1055 |         "prelude",
1056 |         "tailrec",
1057 |         "tuples",
1058 |         "unfoldable",
1059 |         "unsafe-coerce"
1060 |       ]
1061 |     },
1062 |     "tailrec": {
1063 |       "type": "registry",
1064 |       "version": "6.1.0",
1065 |       "integrity": "sha256-Xx19ECVDRrDWpz9D2GxQHHV89vd61dnXxQm0IcYQHGk=",
1066 |       "dependencies": [
1067 |         "bifunctors",
1068 |         "effect",
1069 |         "either",
1070 |         "identity",
1071 |         "maybe",
1072 |         "partial",
1073 |         "prelude",
1074 |         "refs"
1075 |       ]
1076 |     },
1077 |     "tidy": {
1078 |       "type": "registry",
1079 |       "version": "0.11.1",
1080 |       "integrity": "sha256-SaZquYd0iGmueAFjAqrTgdfWEAKPQUsLKanClbl5m5k=",
1081 |       "dependencies": [
1082 |         "arrays",
1083 |         "control",
1084 |         "dodo-printer",
1085 |         "either",
1086 |         "foldable-traversable",
1087 |         "language-cst-parser",
1088 |         "lists",
1089 |         "maybe",
1090 |         "newtype",
1091 |         "ordered-collections",
1092 |         "partial",
1093 |         "prelude",
1094 |         "strings",
1095 |         "tuples"
1096 |       ]
1097 |     },
1098 |     "transformers": {
1099 |       "type": "registry",
1100 |       "version": "6.1.0",
1101 |       "integrity": "sha256-3Bm+Z6tsC/paG888XkywDngJ2JMos+JfOhRlkVfb7gI=",
1102 |       "dependencies": [
1103 |         "control",
1104 |         "distributive",
1105 |         "effect",
1106 |         "either",
1107 |         "exceptions",
1108 |         "foldable-traversable",
1109 |         "identity",
1110 |         "lazy",
1111 |         "maybe",
1112 |         "newtype",
1113 |         "prelude",
1114 |         "st",
1115 |         "tailrec",
1116 |         "tuples",
1117 |         "unfoldable"
1118 |       ]
1119 |     },
1120 |     "tuples": {
1121 |       "type": "registry",
1122 |       "version": "7.0.0",
1123 |       "integrity": "sha256-1rXgTomes9105BjgXqIw0FL6Fz1lqqUTLWOumhWec1M=",
1124 |       "dependencies": [
1125 |         "control",
1126 |         "invariant",
1127 |         "prelude"
1128 |       ]
1129 |     },
1130 |     "type-equality": {
1131 |       "type": "registry",
1132 |       "version": "4.0.1",
1133 |       "integrity": "sha256-Hs9D6Y71zFi/b+qu5NSbuadUQXe5iv5iWx0226vOHUw=",
1134 |       "dependencies": []
1135 |     },
1136 |     "typelevel-prelude": {
1137 |       "type": "registry",
1138 |       "version": "7.0.0",
1139 |       "integrity": "sha256-uFF2ph+vHcQpfPuPf2a3ukJDFmLhApmkpTMviHIWgJM=",
1140 |       "dependencies": [
1141 |         "prelude",
1142 |         "type-equality"
1143 |       ]
1144 |     },
1145 |     "unfoldable": {
1146 |       "type": "registry",
1147 |       "version": "6.0.0",
1148 |       "integrity": "sha256-JtikvJdktRap7vr/K4ITlxUX1QexpnqBq0G/InLr6eg=",
1149 |       "dependencies": [
1150 |         "foldable-traversable",
1151 |         "maybe",
1152 |         "partial",
1153 |         "prelude",
1154 |         "tuples"
1155 |       ]
1156 |     },
1157 |     "unicode": {
1158 |       "type": "registry",
1159 |       "version": "6.0.0",
1160 |       "integrity": "sha256-QJnTVZpmihEAUiMeYrfkusVoziJWp2hJsgi9bMQLue8=",
1161 |       "dependencies": [
1162 |         "foldable-traversable",
1163 |         "maybe",
1164 |         "strings"
1165 |       ]
1166 |     },
1167 |     "unsafe-coerce": {
1168 |       "type": "registry",
1169 |       "version": "6.0.0",
1170 |       "integrity": "sha256-IqIYW4Vkevn8sI+6aUwRGvd87tVL36BBeOr0cGAE7t0=",
1171 |       "dependencies": []
1172 |     }
1173 |   }
1174 | }
1175 | 


--------------------------------------------------------------------------------
/spago.yaml:
--------------------------------------------------------------------------------
 1 | package:
 2 |   name: tidy-codegen
 3 |   description: Convenient code-generation for PureScript using purescript-tidy.
 4 |   publish:
 5 |     version: 4.0.1
 6 |     license: MIT
 7 |     location:
 8 |       githubOwner: natefaubion
 9 |       githubRepo: purescript-tidy-codegen
10 |   build:
11 |     strict: true
12 |   dependencies:
13 |     - arrays: ">=7.3.0 <8.0.0"
14 |     - bifunctors: ">=6.0.0 <7.0.0"
15 |     - control: ">=6.0.0 <7.0.0"
16 |     - dodo-printer: ">=2.2.3 <3.0.0"
17 |     - effect: ">=4.0.0 <5.0.0"
18 |     - either: ">=6.1.0 <7.0.0"
19 |     - enums: ">=6.0.1 <7.0.0"
20 |     - foldable-traversable: ">=6.0.0 <7.0.0"
21 |     - free: ">=7.1.0 <8.0.0"
22 |     - identity: ">=6.0.0 <7.0.0"
23 |     - integers: ">=6.0.0 <7.0.0"
24 |     - language-cst-parser: ">=0.14.1 <0.15.0"
25 |     - lazy: ">=6.0.0 <7.0.0"
26 |     - lists: ">=7.0.0 <8.0.0"
27 |     - maybe: ">=6.0.0 <7.0.0"
28 |     - newtype: ">=5.0.0 <6.0.0"
29 |     - ordered-collections: ">=3.2.0 <4.0.0"
30 |     - partial: ">=4.0.0 <5.0.0"
31 |     - prelude: ">=6.0.2 <7.0.0"
32 |     - record: ">=4.0.0 <5.0.0"
33 |     - safe-coerce: ">=2.0.0 <3.0.0"
34 |     - st: ">=6.2.0 <7.0.0"
35 |     - strings: ">=6.0.1 <7.0.0"
36 |     - tidy: ">=0.11.1 <0.12.0"
37 |     - transformers: ">=6.1.0 <7.0.0"
38 |     - tuples: ">=7.0.0 <8.0.0"
39 |     - type-equality: ">=4.0.1 <5.0.0"
40 |     - unicode: ">=6.0.0 <7.0.0"
41 |   test:
42 |     main: Test.Main
43 |     dependencies:
44 |       - aff
45 |       - ansi
46 |       - avar
47 |       - console
48 |       - exceptions
49 |       - filterable
50 |       - node-buffer
51 |       - node-child-process
52 |       - node-fs
53 |       - node-os
54 |       - node-path
55 |       - node-process
56 |       - node-streams
57 |       - parallel
58 |       - posix-types
59 | workspace: {}
60 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen.purs:
--------------------------------------------------------------------------------
   1 | module Tidy.Codegen
   2 |   ( PrintOptions
   3 |   , defaultPrintOptions
   4 |   , printModule
   5 |   , printModuleWithOptions
   6 |   , class DeclInstance
   7 |   , class TypeVar
   8 |   , binaryOp
   9 |   , binderArray
  10 |   , binderBool
  11 |   , binderChar
  12 |   , binderCtor
  13 |   , binderInt
  14 |   , binderNamed
  15 |   , binderNumber
  16 |   , binderOp
  17 |   , binderParens
  18 |   , binderRecord
  19 |   , binderString
  20 |   , binderTyped
  21 |   , binderVar
  22 |   , binderWildcard
  23 |   , blockComment
  24 |   , caseBranch
  25 |   , classMember
  26 |   , dataCtor
  27 |   , declClass
  28 |   , declClassSignature
  29 |   , declData
  30 |   , declDataSignature
  31 |   , declDerive
  32 |   , declDeriveNewtype
  33 |   , declForeign
  34 |   , declForeignData
  35 |   , declImport
  36 |   , declImportAs
  37 |   , declImportHiding
  38 |   , declImportHidingAs
  39 |   , declInfix
  40 |   , declInfixType
  41 |   , declInstance
  42 |   , declInstanceChain
  43 |   , declNewtype
  44 |   , declNewtypeSignature
  45 |   , declRole
  46 |   , declSignature
  47 |   , declType
  48 |   , declTypeSignature
  49 |   , declValue
  50 |   , doBind
  51 |   , doDiscard
  52 |   , doLet
  53 |   , docComments
  54 |   , exportClass
  55 |   , exportModule
  56 |   , exportOp
  57 |   , exportType
  58 |   , exportTypeAll
  59 |   , exportTypeMembers
  60 |   , exportTypeOp
  61 |   , exportValue
  62 |   , exprAdo
  63 |   , exprApp
  64 |   , exprArray
  65 |   , exprBool
  66 |   , exprCase
  67 |   , exprChar
  68 |   , exprCtor
  69 |   , exprDo
  70 |   , exprDot
  71 |   , exprIdent
  72 |   , exprIf
  73 |   , exprInfix
  74 |   , exprInt
  75 |   , exprIntHex
  76 |   , exprLambda
  77 |   , exprLet
  78 |   , exprNegate
  79 |   , exprNumber
  80 |   , exprOp
  81 |   , exprOpName
  82 |   , exprParens
  83 |   , exprRecord
  84 |   , exprSection
  85 |   , exprString
  86 |   , exprTypeApp
  87 |   , exprTyped
  88 |   , exprUpdate
  89 |   , exprWhere
  90 |   , guardBinder
  91 |   , guardBranch
  92 |   , guardExpr
  93 |   , importClass
  94 |   , importOp
  95 |   , importType
  96 |   , importTypeAll
  97 |   , importTypeMembers
  98 |   , importTypeOp
  99 |   , importValue
 100 |   , instSignature
 101 |   , instValue
 102 |   , leading
 103 |   , letBinder
 104 |   , letSignature
 105 |   , letValue
 106 |   , lineBreaks
 107 |   , lineComments
 108 |   , module_
 109 |   , spaces
 110 |   , trailing
 111 |   , typeApp
 112 |   , typeArrow
 113 |   , typeArrowName
 114 |   , typeConstrained
 115 |   , typeCtor
 116 |   , typeForall
 117 |   , typeKinded
 118 |   , typeOp
 119 |   , typeOpName
 120 |   , typeParens
 121 |   , typeRecord
 122 |   , typeRecordEmpty
 123 |   , typeRow
 124 |   , typeRowEmpty
 125 |   , typeString
 126 |   , typeInt
 127 |   , typeVar
 128 |   , typeVarKinded
 129 |   , typeWildcard
 130 |   , update
 131 |   , updateNested
 132 |   ) where
 133 | 
 134 | import Prelude
 135 | 
 136 | import Control.Alt ((<|>))
 137 | import Data.Array as Array
 138 | import Data.Array.NonEmpty as NonEmptyArray
 139 | import Data.Bifunctor (bimap, lmap)
 140 | import Data.Int as Int
 141 | import Data.Lazy (Lazy)
 142 | import Data.Lazy as Lazy
 143 | import Data.Maybe (Maybe(..), maybe)
 144 | import Data.Newtype (unwrap)
 145 | import Data.Ord (abs)
 146 | import Data.String as String
 147 | import Data.String.CodeUnits as SCU
 148 | import Data.Tuple (Tuple(..), curry)
 149 | import Dodo (plainText)
 150 | import Dodo as Dodo
 151 | import PureScript.CST.Types (AppSpine(..), Binder(..), ClassFundep, Comment(..), DataCtor(..), DataMembers(..), Declaration(..), DoStatement(..), Export(..), Expr(..), Fixity, FixityOp(..), Foreign(..), Guarded, Ident, Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), InstanceHead, IntValue(..), Label, Labeled(..), LetBinding(..), LineFeed(..), Module(..), ModuleBody(..), ModuleHeader(..), ModuleName, Name, Operator(..), PatternGuard(..), Prefixed(..), Proper, QualifiedName(..), RecordUpdate(..), Role, Separated(..), SourceToken, Token(..), Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
 152 | import PureScript.CST.Types as CST
 153 | import Safe.Coerce (coerce)
 154 | import Tidy (ImportWrapOption(..), TypeArrowOption(..), UnicodeOption(..), defaultFormatOptions, formatModule, toDoc)
 155 | import Tidy.Codegen.Class (class OverLeadingComments, class OverTrailingComments, class ToFixityName, class ToGuarded, class ToName, class ToNonEmptyArray, class ToQualifiedName, class ToRecordLabeled, class ToWhere, ErrorPrefix(..), overLeadingComments, overTrailingComments, toFixityName, toGuarded, toName, toNonEmptyArray, toQualifiedName, toRecordLabeled, toToken, toWhere)
 156 | import Tidy.Codegen.Common (toDelimited, toDelimitedNonEmpty, toOneOrDelimited, toParenList, toSeparated, toSourceToken, toWrapped, tokAdo, tokAll, tokAs, tokAt, tokBackslash, tokCase, tokClass, tokComma, tokData, tokDerive, tokDo, tokDot, tokDoubleColon, tokElse, tokEquals, tokFalse, tokForFixity, tokForRole, tokForall, tokForeign, tokHiding, tokIf, tokImport, tokIn, tokInstance, tokLeftArrow, tokLeftBrace, tokLeftFatArrow, tokLeftParen, tokLeftSquare, tokLet, tokModule, tokNegate, tokNewtype, tokOf, tokPipe, tokRightArrow, tokRightBrace, tokRightFatArrow, tokRightParen, tokRightSquare, tokRole, tokSymbolArrow, tokThen, tokTick, tokTrue, tokType, tokUnderscore, tokWhere)
 157 | import Tidy.Codegen.Precedence (precBinder0, precBinder1, precBinder2, precExpr0, precExpr1, precExpr2, precExpr3, precExpr5, precExpr6, precExpr7, precExprApp, precExprAppLast, precExprInfix, precInitLast, precType0, precType1, precType2, precType3)
 158 | import Tidy.Codegen.String (escapeSourceString)
 159 | import Tidy.Codegen.Types (BinaryOp(..), GuardedBranch(..), SymbolName(..), ClassMember)
 160 | import Tidy.Operators (parseOperatorTable)
 161 | import Tidy.Operators.Defaults (defaultOperators)
 162 | import Tidy.Precedence (PrecedenceMap)
 163 | 
 164 | type PrintOptions =
 165 |   { importWrap :: ImportWrapOption
 166 |   , indentUnit :: String
 167 |   , indentWidth :: Int
 168 |   , operators :: Lazy PrecedenceMap
 169 |   , pageWidth :: Int
 170 |   , ribbonRatio :: Number
 171 |   , typeArrowPlacement :: TypeArrowOption
 172 |   , unicode :: UnicodeOption
 173 |   }
 174 | 
 175 | defaultPrintOptions :: PrintOptions
 176 | defaultPrintOptions =
 177 |   { importWrap: ImportWrapSource
 178 |   , indentUnit: "  "
 179 |   , indentWidth: 2
 180 |   , operators: Lazy.defer \_ -> parseOperatorTable defaultOperators
 181 |   , pageWidth: 160
 182 |   , ribbonRatio: 0.618
 183 |   , typeArrowPlacement: TypeArrowFirst
 184 |   , unicode: UnicodeSource
 185 |   }
 186 | 
 187 | -- | Pretty-prints a module using default format options.
 188 | -- |
 189 | -- |  ```purescript
 190 | -- |  exampleSource = printModule myModule
 191 | -- |  ```
 192 | printModule :: Module Void -> String
 193 | printModule = printModuleWithOptions defaultPrintOptions
 194 | 
 195 | -- | Pretty-prints a module given a set of options. Use `defaultPrintOptions`
 196 | -- | and override as necessary.
 197 | -- |
 198 | -- | ```purescript
 199 | -- | exampleSource = printModule
 200 | -- |   defaultPrintOptions
 201 | -- |     { indentUnit = "    "
 202 | -- |     , indentWidth = 4
 203 | -- |     , unicode = UnicodeAlways
 204 | -- |     }
 205 | -- |   myModule
 206 | -- | ```
 207 | printModuleWithOptions :: PrintOptions -> Module Void -> String
 208 | printModuleWithOptions options mod =
 209 |   -- Eta-expanded to defer operator parsing
 210 |   Dodo.print plainText dodoOptions
 211 |     $ toDoc
 212 |     $ formatModule formatOptions
 213 |     $ overTrailingComments addTrailingBreak mod
 214 |   where
 215 |   dodoOptions =
 216 |     { indentUnit: options.indentUnit
 217 |     , indentWidth: options.indentWidth
 218 |     , pageWidth: options.pageWidth
 219 |     , ribbonRatio: options.ribbonRatio
 220 |     }
 221 | 
 222 |   formatOptions = defaultFormatOptions
 223 |     { importWrap = options.importWrap
 224 |     , operators = Lazy.force options.operators
 225 |     , typeArrowPlacement = options.typeArrowPlacement
 226 |     , unicode = options.unicode
 227 |     }
 228 | 
 229 |   addTrailingBreak comments = case Array.last comments of
 230 |     Just (Line _ n) | n > 0 ->
 231 |       comments
 232 |     _ ->
 233 |       comments <> lineBreaks 1
 234 | 
 235 | -- | An overloaded binary operator constructor. Use with `exprOp`, `typeOp`,
 236 | -- | or `binderOp`.
 237 | -- |
 238 | -- | ```purescript
 239 | -- | exampleExpr =
 240 | -- |   exprOp (exprInt 4)
 241 | -- |     [ binaryOp "+" (exprIdent "a")
 242 | -- |     , binaryOp "/" (exprIdent "b")
 243 | -- |     ]
 244 | -- | ```
 245 | binaryOp :: forall name b. ToQualifiedName name Operator => name -> b -> BinaryOp b
 246 | binaryOp a b = BinaryOp (Tuple (toQualifiedName a) b)
 247 | 
 248 | -- | Overloaded constructors for type variables. This can be used to construct
 249 | -- | not only `CST.Type`, but also type variable bindings in `typeForall` and
 250 | -- | data, newtype, type, and class declarations.
 251 | -- |
 252 | -- | ```purescript
 253 | -- | exampleDecl =
 254 | -- |   declType "Id" [ typeVarKinded "a" (typeCtor "Type") ]
 255 | -- |     (typeVar "a")
 256 | -- | ```
 257 | class TypeVar a e | a -> e where
 258 |   -- | An overloaded constructor for type variables.
 259 |   typeVar :: forall name. ToName name Ident => name -> a
 260 |   -- | An overloaded constructor for kinded type variables.
 261 |   typeVarKinded :: forall name. ToName name Ident => name -> CST.Type e -> a
 262 | 
 263 | instance TypeVar (TypeVarBinding (Name Ident) e) e where
 264 |   typeVar = TypeVarName <<< toName
 265 |   typeVarKinded name value =
 266 |     TypeVarKinded
 267 |       $ toWrapped tokLeftParen tokRightParen
 268 |       $ Labeled { label: toName name, separator: tokDoubleColon, value }
 269 | 
 270 | instance TypeVar (TypeVarBinding (Prefixed (Name Ident)) e) e where
 271 |   typeVar = TypeVarName <<< Prefixed <<< { prefix: Nothing, value: _ } <<< toName
 272 |   typeVarKinded name value =
 273 |     TypeVarKinded
 274 |       $ toWrapped tokLeftParen tokRightParen
 275 |       $ Labeled { label: Prefixed { prefix: Nothing, value: toName name }, separator: tokDoubleColon, value }
 276 | 
 277 | instance TypeVar (CST.Type e) e where
 278 |   typeVar = TypeVar <<< toName
 279 |   typeVarKinded name = typeParens <<< typeKinded (typeParens (TypeVar (toName name)))
 280 | 
 281 | -- | An overloaded constructor for a proper type name.
 282 | -- |
 283 | -- | ```purescript
 284 | -- | exampleType = typeApp (typeCtor "Maybe") [ typeCtor "Int" ]
 285 | -- | ```
 286 | typeCtor :: forall e name. ToQualifiedName name Proper => name -> CST.Type e
 287 | typeCtor = TypeConstructor <<< toQualifiedName
 288 | 
 289 | -- | A type wildcard (`_`).
 290 | typeWildcard :: forall e. CST.Type e
 291 | typeWildcard = TypeWildcard tokUnderscore
 292 | 
 293 | -- | An overloaded constructor for a row type.
 294 | -- |
 295 | -- | ```purescript
 296 | -- | exampleType = typeRow
 297 | -- |   [ Tuple "id" (typeCtor "UserId")
 298 | -- |   , Tuple "name" (typeCtor "String")
 299 | -- |   , Tuple "age" (typeCtor "Int")
 300 | -- |   ]
 301 | -- |   (Just (typeVar "r"))
 302 | -- | ```
 303 | typeRow :: forall e label. ToName label Label => Array (Tuple label (CST.Type e)) -> Maybe (CST.Type e) -> CST.Type e
 304 | typeRow lbls ty = TypeRow $ toWrapped tokLeftParen tokRightParen $ CST.Row
 305 |   { labels: toSeparated tokComma <<< map (toLabeled tokDoubleColon) <$> NonEmptyArray.fromArray lbls
 306 |   , tail: Tuple tokPipe <$> ty
 307 |   }
 308 | 
 309 | -- | The empty row type.
 310 | typeRowEmpty :: forall e. CST.Type e
 311 | typeRowEmpty = typeRow ([] :: Array (Tuple Label _)) Nothing
 312 | 
 313 | -- | An overloaded constructor for a record type.
 314 | -- |
 315 | -- | ```purescript
 316 | -- | exampleType = typeRecord
 317 | -- |   [ Tuple "id" (typeCtor "UserId")
 318 | -- |   , Tuple "name" (typeCtor "String")
 319 | -- |   , Tuple "age" (typeCtor "Int")
 320 | -- |   ]
 321 | -- |   (Just (typeVar "r"))
 322 | -- | ```
 323 | typeRecord :: forall e label. ToName label Label => Array (Tuple label (CST.Type e)) -> Maybe (CST.Type e) -> CST.Type e
 324 | typeRecord lbls ty = TypeRecord $ toWrapped tokLeftBrace tokRightBrace $ CST.Row
 325 |   { labels: toSeparated tokComma <<< map (toLabeled tokDoubleColon) <$> NonEmptyArray.fromArray lbls
 326 |   , tail: Tuple tokPipe <$> ty
 327 |   }
 328 | 
 329 | -- | The empty record type.
 330 | typeRecordEmpty :: forall e. CST.Type e
 331 | typeRecordEmpty = typeRecord ([] :: Array (Tuple Label _)) Nothing
 332 | 
 333 | -- | Constructs a type-level string while handling escaping.
 334 | -- |
 335 | -- | ```
 336 | -- | exampleType = typeString "string"
 337 | -- | ```
 338 | typeString :: forall e. String -> CST.Type e
 339 | typeString str = TypeString (toSourceToken (TokString (unwrap (escapeSourceString str)) str)) str
 340 | 
 341 | -- | Constructs a type-level int
 342 | -- |
 343 | -- | ```
 344 | -- | exampleType = typeInt (-1)
 345 | -- | ```
 346 | typeInt :: forall e. Int -> CST.Type e
 347 | typeInt n = TypeInt neg (toSourceToken (TokInt (show val) (SmallInt val))) (SmallInt val)
 348 |   where
 349 |   val = abs n
 350 |   neg = if n < 0 then Just tokNegate else Nothing
 351 | 
 352 | -- | Constructs a type with a kind annotation.
 353 | -- |
 354 | -- | ```purescript
 355 | -- | exampleType =
 356 | -- |   typeKinded (typeCtor "Maybe")
 357 | -- |     (typeArrow [ typeCtor "Type" ] (typeCtor "Type"))
 358 | -- | ```
 359 | typeKinded :: forall e. CST.Type e -> CST.Type e -> CST.Type e
 360 | typeKinded a b = TypeKinded (precType0 a) tokDoubleColon b
 361 | 
 362 | -- | Constructs left-associated applications.
 363 | -- |
 364 | -- | ```purescript
 365 | -- | exampleType =
 366 | -- |   typeApp (typeCtor "Map")
 367 | -- |     [ typeCtor "UserId"
 368 | -- |     , typeCtor "User"
 369 | -- |     ]
 370 | -- | ```
 371 | typeApp :: forall e. CST.Type e -> Array (CST.Type e) -> CST.Type e
 372 | typeApp ty = maybe ty (TypeApp (precType3 ty)) <<< NonEmptyArray.fromArray <<< map precType3
 373 | 
 374 | -- | Constructs binary operator applications. These may be grouped by the
 375 | -- | pretty-printer based on precedence.
 376 | -- |
 377 | -- | ```purescript
 378 | -- | exampleType =
 379 | -- |   typeOp (typeCtor "String")
 380 | -- |     [ binaryOp "/\\" (typeCtor "Int")
 381 | -- |     , binaryOp "/\\" (typeCtor "Boolean")
 382 | -- |     ]
 383 | -- | ```
 384 | typeOp :: forall e. CST.Type e -> Array (BinaryOp (CST.Type e)) -> CST.Type e
 385 | typeOp ty = maybe ty (TypeOp (precType2 ty) <<< coerce) <<< NonEmptyArray.fromArray <<< map (map precType2)
 386 | 
 387 | -- | Overloaded constructor for a type operator's symbolic identifier (wrapping
 388 | -- | it in parens), which may be qualified.
 389 | -- |
 390 | -- | ```purescript
 391 | -- | exampleType = typeOpName "(~>)"
 392 | -- | ```
 393 | typeOpName :: forall e name. ToQualifiedName name SymbolName => name -> CST.Type e
 394 | typeOpName = TypeOpName <<< (coerce :: QualifiedName SymbolName -> _) <<< toQualifiedName
 395 | 
 396 | -- | Constructs a `forall` given type variable bindings.
 397 | -- |
 398 | -- | ```purescript
 399 | -- | exampleType =
 400 | -- |   typeForall [ typeVar "a" ]
 401 | -- |     (typeArrow [ typeVar "a" ] (typeVar "a"))
 402 | -- | ```
 403 | typeForall :: forall e. Array (TypeVarBinding (Prefixed (Name Ident)) e) -> CST.Type e -> CST.Type e
 404 | typeForall vars ty =
 405 |   vars # NonEmptyArray.fromArray # maybe ty \vars' ->
 406 |     TypeForall tokForall vars' tokDot (precType0 ty)
 407 | 
 408 | -- | Constructs right-associated constraint arrows.
 409 | -- |
 410 | -- | ```purescript
 411 | -- | exampleType =
 412 | -- |   typeForall [ typeVar "f", typeVar "a" ]
 413 | -- |     ( typeConstrained
 414 | -- |         [ typeApp (typeCtor "Functor") [ typeVar "f" ]
 415 | -- |         , typeApp (typeCtor "Show") [ typeVar "a" ]
 416 | -- |         ]
 417 | -- |         ( typeArrow
 418 | -- |             [ typeApp (typeVar "f")
 419 | -- |                 [ typeVar "a" ]
 420 | -- |             ]
 421 | -- |             ( typeApp (typeVar "f")
 422 | -- |                 [ typeCtor "String" ]
 423 | -- |             )
 424 | -- |         )
 425 | -- |     )
 426 | -- | ```
 427 | typeConstrained :: forall e. Array (CST.Type e) -> CST.Type e -> CST.Type e
 428 | typeConstrained = flip $ Array.foldr \a b -> TypeConstrained (precType1 a) tokRightFatArrow (precType0 b)
 429 | 
 430 | -- | Constructs right-associated function arrows.
 431 | -- |
 432 | -- | ```purescript
 433 | -- | exampleType =
 434 | -- |   typeArrow
 435 | -- |     [ typeCtor "UserId"
 436 | -- |     , typeCtor "String"
 437 | -- |     , typeCtor "Int"
 438 | -- |     ]
 439 | -- |     (typeCtor "User")
 440 | -- | ```
 441 | typeArrow :: forall e. Array (CST.Type e) -> CST.Type e -> CST.Type e
 442 | typeArrow = flip $ Array.foldr \a b -> TypeArrow (precType1 a) tokRightArrow (precType0 b)
 443 | 
 444 | -- | The function arrow's symbolic identifier (`(->)`).
 445 | typeArrowName :: forall e. CST.Type e
 446 | typeArrowName = TypeArrowName tokSymbolArrow
 447 | 
 448 | -- | Wraps a type in parens.
 449 | typeParens :: forall e. CST.Type e -> CST.Type e
 450 | typeParens = case _ of
 451 |   a@(TypeParens _) -> a
 452 |   a -> wrap a
 453 |   where
 454 |   wrap = TypeParens <<< toWrapped tokLeftParen tokRightParen
 455 | 
 456 | -- | An overloaded constructor for a value identifier, which may be qualified.
 457 | -- |
 458 | -- | ```purescript
 459 | -- | exampleExpr =
 460 | -- |   exprApp (exprIdent "Map.lookup")
 461 | -- |     [ exprIdent "userId"
 462 | -- |     , exprIdent "users"
 463 | -- |     ]
 464 | -- | ```
 465 | exprIdent :: forall e name. ToQualifiedName name Ident => name -> Expr e
 466 | exprIdent = ExprIdent <<< toQualifiedName
 467 | 
 468 | -- | An overloaded constructor for a value constructor, which may be qualified.
 469 | -- |
 470 | -- | ```purescript
 471 | -- | exampleExpr =
 472 | -- |   exprApp (exprCtor "List.Cons")
 473 | -- |     [ exprIdent "a"
 474 | -- |     , exprCtor "List.Nil"
 475 | -- |     ]
 476 | -- | ```
 477 | exprCtor :: forall e name. ToQualifiedName name Proper => name -> Expr e
 478 | exprCtor = ExprConstructor <<< toQualifiedName
 479 | 
 480 | -- | Constructs a `Boolean` literal.
 481 | -- |
 482 | -- | ```purescript
 483 | -- | exampleExpr = exprBool true
 484 | -- | ```
 485 | exprBool :: forall e. Boolean -> Expr e
 486 | exprBool bool = ExprBoolean (if bool then tokTrue else tokFalse) bool
 487 | 
 488 | -- | Constructs a `Char` literal while handling escaping.
 489 | -- |
 490 | -- | ```purescript
 491 | -- | exampleExpr = exprChar 'A'
 492 | -- | ```
 493 | exprChar :: forall e. Char -> Expr e
 494 | exprChar ch = ExprChar (toSourceToken (TokChar (unwrap (escapeSourceString (SCU.singleton ch))) ch)) ch
 495 | 
 496 | -- | Constructs a `String` literal while handling escaping.
 497 | -- |
 498 | -- | ```purescript
 499 | -- | exampleExpr = exprString "string"
 500 | -- | ```
 501 | exprString :: forall e. String -> Expr e
 502 | exprString str = ExprString (toSourceToken (TokString (unwrap (escapeSourceString str)) str)) str
 503 | 
 504 | -- | Constructs an `Int` literal.
 505 | -- |
 506 | -- | ```purescript
 507 | -- | exampleExpr = exprInt 42
 508 | -- | ```
 509 | exprInt :: forall e. Int -> Expr e
 510 | exprInt n = ExprInt (toSourceToken (TokInt (show n) (SmallInt n))) (SmallInt n)
 511 | 
 512 | -- | Constructs an `Int` literal using hex notation.
 513 | -- |
 514 | -- | ```purescript
 515 | -- | exampleExpr = exprIntHex 0xFF0000
 516 | -- | ```
 517 | exprIntHex :: forall e. Int -> Expr e
 518 | exprIntHex n = ExprInt (toSourceToken (TokInt ("0x" <> Int.toStringAs Int.hexadecimal n) (SmallInt n))) (SmallInt n)
 519 | 
 520 | -- | Constructs a `Number` literal.
 521 | -- |
 522 | -- | ```purescript
 523 | -- | exampleExpr = exprNumber 1.618
 524 | -- | ```
 525 | exprNumber :: forall e. Number -> Expr e
 526 | exprNumber n = ExprNumber (toSourceToken (TokNumber (show n) n)) n
 527 | 
 528 | -- | Constructs an `Array` literal.
 529 | -- |
 530 | -- | ```purescript
 531 | -- | exampleExpr = exprArray
 532 | -- |   [ exprInt 1
 533 | -- |   , exprInt 2
 534 | -- |   , exprInt 3
 535 | -- |   ]
 536 | -- | ```
 537 | exprArray :: forall e. Array (Expr e) -> Expr e
 538 | exprArray = ExprArray <<< toDelimited tokLeftSquare tokRightSquare tokComma
 539 | 
 540 | -- | Constructs a `Record` literal.
 541 | -- |
 542 | -- | ```purescript
 543 | -- | exampleExpr = exprRecord
 544 | -- |   [ Tuple "id" (exprIdent "userId")
 545 | -- |   , Tuple "name" (exprIdent "userName")
 546 | -- |   , Tuple "age" (exprIdent "userAge")
 547 | -- |   ]
 548 | -- | ```
 549 | exprRecord :: forall e field. ToRecordLabeled field (Expr e) => Array field -> Expr e
 550 | exprRecord = ExprRecord <<< toDelimited tokLeftBrace tokRightBrace tokComma <<< map toRecordLabeled
 551 | 
 552 | -- | Wraps an expression in parens.
 553 | exprParens :: forall e. Expr e -> Expr e
 554 | exprParens = case _ of
 555 |   a@(ExprParens _) -> a
 556 |   a -> wrap a
 557 |   where
 558 |   wrap = ExprParens <<< toWrapped tokLeftParen tokRightParen
 559 | 
 560 | -- | Constructs an expression with a type annotation.
 561 | -- |
 562 | -- | ```purescript
 563 | -- | exampleExpr = exprTyped (exprInt 42) (typeCtor "Int")
 564 | -- | ```
 565 | exprTyped :: forall e. Expr e -> CST.Type e -> Expr e
 566 | exprTyped a b = ExprTyped (precExpr0 a) tokDoubleColon b
 567 | 
 568 | -- | Constructs left-associative infix expression applications.
 569 | -- |
 570 | -- | ```purescript
 571 | -- | exampleExpr =
 572 | -- |   exprInfix (exprIdent "a")
 573 | -- |     [ Tuple (exprIdent "append") (exprIdent "b")
 574 | -- |     , Tuple (exprIdent "append") (exprIdent "c")
 575 | -- |     ]
 576 | -- | ```
 577 | exprInfix :: forall e. Expr e -> Array (Tuple (Expr e) (Expr e)) -> Expr e
 578 | exprInfix expr =
 579 |   maybe expr (ExprInfix (precExpr2 expr))
 580 |     <<< precInitLast (bimap wrapInfix precExpr3) (bimap wrapInfix precExprInfix)
 581 |   where
 582 |   wrapInfix =
 583 |     toWrapped tokTick tokTick <<< precExprInfix
 584 | 
 585 | -- | Constructors binary operator applications. These may be grouped by the
 586 | -- | pretty-printer based on precedence.
 587 | -- |
 588 | -- | ```purescript
 589 | -- | exampleExpr =
 590 | -- |   exprOp (exprString "string")
 591 | -- |     [ binaryOp "/\\" (exprInt 42)
 592 | -- |     , binaryOp "/\\" (exprBool false)
 593 | -- |     ]
 594 | -- | ```
 595 | exprOp :: forall e. Expr e -> Array (BinaryOp (Expr e)) -> Expr e
 596 | exprOp expr =
 597 |   maybe expr (ExprOp (precExpr2 expr) <<< coerce)
 598 |     <<< precInitLast (map precExpr2) (map precExpr1)
 599 | 
 600 | -- | Overloaded constructor for an expression operator's symbolic identifier (wrapping
 601 | -- | it in parens).
 602 | -- |
 603 | -- | ```purescript
 604 | -- | exampleExpr = exprOpName "(<>)"
 605 | -- | ```
 606 | exprOpName :: forall e name. ToQualifiedName name SymbolName => name -> Expr e
 607 | exprOpName = ExprOpName <<< (coerce :: QualifiedName SymbolName -> _) <<< toQualifiedName
 608 | 
 609 | -- | Constructs unary negation.
 610 | exprNegate :: forall e. Expr e -> Expr e
 611 | exprNegate = ExprNegate tokNegate <<< precExpr5
 612 | 
 613 | -- | Constructs a record dot-accessor.
 614 | -- |
 615 | -- | ```purescript
 616 | -- | exampleExpr = exprDot (exprIdent "response") [ "body", "users" ]
 617 | -- | ```
 618 | exprDot :: forall e label. ToName label Label => Expr e -> Array label -> Expr e
 619 | exprDot expr = NonEmptyArray.fromArray >>> maybe expr \path ->
 620 |   ExprRecordAccessor
 621 |     { expr: precExpr7 expr
 622 |     , dot: tokDot
 623 |     , path: toSeparated tokDot $ toName <$> path
 624 |     }
 625 | 
 626 | -- | Constructs a record update.
 627 | -- |
 628 | -- | ```purescript
 629 | -- | exampleExpr =
 630 | -- |   exprUpdate (exprIdent "user")
 631 | -- |     [ update "age" (exprInt 42)
 632 | -- |     , updateNested "phone"
 633 | -- |         [ update "countryCode" (exprInt 1)
 634 | -- |         ]
 635 | -- |     ]
 636 | -- | ```
 637 | exprUpdate :: forall e. Expr e -> Array (RecordUpdate e) -> Expr e
 638 | exprUpdate expr = NonEmptyArray.fromArray >>> maybe expr \value ->
 639 |   ExprRecordUpdate (precExpr6 expr) $ toDelimitedNonEmpty tokLeftBrace tokRightBrace tokComma value
 640 | 
 641 | -- | Constructs an update for a field.
 642 | update :: forall e a. ToName a Label => a -> Expr e -> RecordUpdate e
 643 | update a b = RecordUpdateLeaf (toName a) tokEquals b
 644 | 
 645 | -- | Constructs a nested update for a field.
 646 | updateNested :: forall f e label. ToNonEmptyArray f => ToName label Label => label -> f (RecordUpdate e) -> RecordUpdate e
 647 | updateNested a = RecordUpdateBranch (toName a) <<< toDelimitedNonEmpty tokLeftBrace tokRightBrace tokComma <<< toNonEmptyArray (ErrorPrefix "updateNested")
 648 | 
 649 | -- | Constructs left-associated applications.
 650 | -- |
 651 | -- | ```purescript
 652 | -- | exampleExpr =
 653 | -- |   exprApp (exprIdent "Map.lookup")
 654 | -- |     [ exprIdent "userId"
 655 | -- |     , exprIdent "users"
 656 | -- |     ]
 657 | -- | ```
 658 | exprApp :: forall e. Expr e -> Array (Expr e) -> Expr e
 659 | exprApp head =
 660 |   maybe head (ExprApp (precExprApp head))
 661 |     <<< precInitLast (AppTerm <<< precExprApp) (AppTerm <<< precExprAppLast)
 662 | 
 663 | -- | Constructs left-associated applications, with optional type applications.
 664 | -- |
 665 | -- | ```purescript
 666 | -- |   exampleExpr =
 667 | -- |     exprTypeApp (exprIdent "Map.lookup")
 668 | -- |       [ typeCtor "String"
 669 | -- |       , typeApp (typeCtor "Maybe") [ typeCtor "User" ]
 670 | -- |       ]
 671 | -- |       [ exprIdent "userId"
 672 | -- |       , exprIdent "users"
 673 | -- |       ]
 674 | -- | ```
 675 | exprTypeApp :: forall e. Expr e -> Array (CST.Type e) -> Array (Expr e) -> Expr e
 676 | exprTypeApp head tys exprs =
 677 |   maybe head (ExprApp (precExprApp head)) args
 678 |   where
 679 |   args =
 680 |     append <$> mbTys <*> mbExprs
 681 |       <|> mbTys
 682 |       <|> mbExprs
 683 | 
 684 |   mbTys =
 685 |     precInitLast (AppType tokAt <<< precType3) (AppType tokAt <<< precType3) tys
 686 | 
 687 |   mbExprs =
 688 |     precInitLast (AppTerm <<< precExprApp) (AppTerm <<< precExprAppLast) exprs
 689 | 
 690 | -- | Constructs a lambda expression.
 691 | -- |
 692 | -- | ```purescript
 693 | -- | exampleExpr =
 694 | -- |   exprLambda [ binderVar "a", binderVar "b" ]
 695 | -- |     ( exprOp (exprIdent "a")
 696 | -- |         [ binaryOp "<>" (exprIdent "b") ]
 697 | -- |     )
 698 | -- | ```
 699 | exprLambda :: forall e. Array (Binder e) -> Expr e -> Expr e
 700 | exprLambda bnds body = bnds # NonEmptyArray.fromArray # maybe body \bnds' ->
 701 |   ExprLambda { symbol: tokBackslash, binders: map precBinder2 bnds', arrow: tokRightArrow, body }
 702 | 
 703 | -- | Constructs an if-then-else expression.
 704 | -- |
 705 | -- | ```purescript
 706 | -- | exampleExpr =
 707 | -- |   exprIf (exprApp (exprIdent "isLoggedIn") [ exprIdent "user" ])
 708 | -- |     (exprIdent "renderPage")
 709 | -- |     (exprApp (exprIdent "httpError") [ exprInt 400 ])
 710 | -- | ```
 711 | exprIf :: forall e. Expr e -> Expr e -> Expr e -> Expr e
 712 | exprIf a b c = ExprIf { keyword: tokIf, cond: a, then: tokThen, true: b, else: tokElse, false: c }
 713 | 
 714 | -- | Constructs a case expression.
 715 | -- |
 716 | -- | ```purescript
 717 | -- | exampleExpr =
 718 | -- |   exprCase [ exprIdent "xs" ]
 719 | -- |     [ caseBranch [ binderCtor "List.Cons" [ binderVar "x", binderWildcard ] ]
 720 | -- |         ( exprApp (exprCtor "Just")
 721 | -- |             [ exprIdent "x"
 722 | -- |             ]
 723 | -- |         )
 724 | -- |     , caseBranch [ binderCtor "Nothing" [] ]
 725 | -- |         (exprCtor "Nothing")
 726 | -- |     ]
 727 | -- | ```
 728 | exprCase
 729 |   :: forall e f g
 730 |    . ToNonEmptyArray f
 731 |   => ToNonEmptyArray g
 732 |   => f (Expr e)
 733 |   -> g (Tuple (Separated (Binder e)) (Guarded e))
 734 |   -> Expr e
 735 | exprCase head branches = ExprCase
 736 |   { keyword: tokCase
 737 |   , head: toSeparated tokComma (toNonEmptyArray (ErrorPrefix "exprCase head") head)
 738 |   , of: tokOf
 739 |   , branches: toNonEmptyArray (ErrorPrefix "exprCase branches") branches
 740 |   }
 741 | 
 742 | -- | Constructs a let expression.
 743 | -- |
 744 | -- | ```purescript
 745 | -- | exampleExpr =
 746 | -- |   exprLet
 747 | -- |     [ letSignature "countDown" (typeArrow [ typeCtor "Int" ] (typeCtor "Int"))
 748 | -- |     , letValue "countDown" [ binderVar "n" ]
 749 | -- |         [ guardBranch [ guardExpr (exprOp (exprIdent "n") [ binaryOp ">" (exprInt 0) ]) ]
 750 | -- |             ( exprApp (exprIdent "countDown")
 751 | -- |                 [ exprOp (exprIdent "n") [ binaryOp "-" (exprInt 1) ] ]
 752 | -- |             )
 753 | -- |         , guardBranch [ guardExpr (exprIdent "otherwise") ]
 754 | -- |             (exprIdent "n")
 755 | -- |         ]
 756 | -- |     ]
 757 | -- |     (exprApp (exprIdent "countDown") [ exprInt 100 ])
 758 | -- | ```
 759 | exprLet :: forall e. Array (LetBinding e) -> Expr e -> Expr e
 760 | exprLet binds body = binds # NonEmptyArray.fromArray # maybe body \bindings ->
 761 |   ExprLet { keyword: tokLet, bindings, in: tokIn, body }
 762 | 
 763 | -- | Constructs a do expression.
 764 | -- |
 765 | -- | ```purescript
 766 | -- | exampleExpr =
 767 | -- |   exprDo
 768 | -- |     [ doBind (binderVar "followers")
 769 | -- |         (exprApp (exprIdent "getFollowers") [ exprIdent "user" ])
 770 | -- |     , doBind (binderVar "favorites")
 771 | -- |         (exprApp (exprIdent "getFavorites") [ exprIdent "user" ])
 772 | -- |     ]
 773 | -- |     ( exprApp (exprIdent "pure")
 774 | -- |         [ exprRecord [ "followers", "favorites" ] ]
 775 | -- |     )
 776 | -- | ```
 777 | exprDo :: forall e. Array (DoStatement e) -> Expr e -> Expr e
 778 | exprDo stmts expr = ExprDo
 779 |   { keyword: tokDo
 780 |   , statements: NonEmptyArray.snoc' stmts (DoDiscard expr)
 781 |   }
 782 | 
 783 | -- | Constructs an ado expression. Works just like `exprDo`.
 784 | exprAdo :: forall e. Array (DoStatement e) -> Expr e -> Expr e
 785 | exprAdo statements result = ExprAdo { keyword: tokAdo, statements, in: tokIn, result }
 786 | 
 787 | -- | Constructs a type signature in a let binding context. See `exprLet`.
 788 | letSignature :: forall e name. ToName name Ident => name -> CST.Type e -> LetBinding e
 789 | letSignature name value = LetBindingSignature $ Labeled
 790 |   { label: toName name
 791 |   , separator: tokDoubleColon
 792 |   , value
 793 |   }
 794 | 
 795 | -- | Constructs a value binding in a let binding context. See `exprLet`.
 796 | letValue
 797 |   :: forall e name rhs
 798 |    . ToName name Ident
 799 |   => ToGuarded rhs e
 800 |   => name
 801 |   -> Array (Binder e)
 802 |   -> rhs
 803 |   -> LetBinding e
 804 | letValue name binders grd = LetBindingName
 805 |   { name: toName name
 806 |   , binders
 807 |   , guarded: toGuarded tokEquals grd
 808 |   }
 809 | 
 810 | -- | Constructs a value binding with a left-hand-side pattern binder.
 811 | -- |
 812 | -- | ```purescript
 813 | -- | exampleExpr =
 814 | -- |   exprLet
 815 | -- |     [ letBinder (binderRecord [ "name" ])
 816 | -- |         (exprIdent "user")
 817 | -- |     ]
 818 | -- |     (exprIdent "name")
 819 | -- | ```
 820 | letBinder :: forall e rhs. ToWhere rhs e => Binder e -> rhs -> LetBinding e
 821 | letBinder binder = LetBindingPattern binder tokEquals <<< toWhere
 822 | 
 823 | -- | Constructs a let binding context within a do expression.
 824 | -- |
 825 | -- | ```purescript
 826 | -- | exampleExpr =
 827 | -- |   exprDo
 828 | -- |     [ doLet
 829 | -- |         [ letBinder (binderRecord [ "age" ])
 830 | -- |             (exprIdent "user")
 831 | -- |         ]
 832 | -- |     ]
 833 | -- |     (exprIdent "age")
 834 | -- | ```
 835 | doLet :: forall e f. ToNonEmptyArray f => f (LetBinding e) -> DoStatement e
 836 | doLet = DoLet tokLet <<< toNonEmptyArray (ErrorPrefix "doLet")
 837 | 
 838 | -- | Constructs a do statement which has no binder.
 839 | -- |
 840 | -- | ```purescript
 841 | -- | exampleExpr =
 842 | -- |   exprDo
 843 | -- |     [ doDiscard
 844 | -- |         ( exprApp (exprIdent "logoutUser")
 845 | -- |             [ exprIdent "user" ]
 846 | -- |         )
 847 | -- |     ]
 848 | -- |     ( exprApp (exprIdent "pure")
 849 | -- |         [ exprApp (exprIdent "httpStatus")
 850 | -- |             [ exprInt 200 ]
 851 | -- |         ]
 852 | -- |     )
 853 | -- | ```
 854 | doDiscard :: forall e. Expr e -> DoStatement e
 855 | doDiscard = DoDiscard
 856 | 
 857 | -- | Constructs a do statement which binds it's return value.
 858 | -- |
 859 | -- | ```purescript
 860 | -- | exampleExpr =
 861 | -- |   exprDo
 862 | -- |     [ doBind (binderRecord [ "followers" ])
 863 | -- |         (exprApp (exprIdent "getUser") [ exprIdent "user" ])
 864 | -- |     ]
 865 | -- |     ( exprApp (exprIdent "pure")
 866 | -- |         [ exprIdent "followers" ]
 867 | -- |     )
 868 | -- | ```
 869 | doBind :: forall e. Binder e -> Expr e -> DoStatement e
 870 | doBind = flip DoBind tokLeftArrow
 871 | 
 872 | -- | Constructs a where let binding context. This can be used anywhere that
 873 | -- | takes a `ToWhere` or `ToGuarded` constraint, such as in value bindings,
 874 | -- | case branches, and guards.
 875 | -- |
 876 | -- | ```purescript
 877 | -- | exampleDecl =
 878 | -- |   declValue "getName" [ binderVar "user" ]
 879 | -- |     ( exprWhere (exprIdent "name")
 880 | -- |         [ letBinder (binderRecord [ "name" ])
 881 | -- |             (exprIdent "user")
 882 | -- |         ]
 883 | -- |     )
 884 | -- | ```
 885 | exprWhere :: forall e. Expr e -> Array (LetBinding e) -> Where e
 886 | exprWhere expr binds = Where { expr, bindings: Tuple tokWhere <$> NonEmptyArray.fromArray binds }
 887 | 
 888 | -- | Constructs a guarded branch in a value binding or case expressions.
 889 | -- | This can be used anwhere that takes a `ToGuarded` constraint.
 890 | -- |
 891 | -- | ```purescript
 892 | -- | exampleDecl =
 893 | -- |   declValue "countDown" [ binderVar "n" ]
 894 | -- |     [ guardBranch [ guardExpr (exprOp (exprIdent "n") [ binaryOp ">" (exprInt 0) ]) ]
 895 | -- |         ( exprApp (exprIdent "countDown")
 896 | -- |             [ exprOp (exprIdent "n") [ binaryOp "-" (exprInt 1) ] ]
 897 | -- |         )
 898 | -- |     , guardBranch [ guardExpr (exprIdent "otherwise") ]
 899 | -- |         (exprIdent "n")
 900 | -- |     ]
 901 | -- | ```
 902 | guardBranch :: forall e f expr. ToNonEmptyArray f => ToWhere expr e => f (PatternGuard e) -> expr -> GuardedBranch e
 903 | guardBranch pats = GuardedBranch (toNonEmptyArray (ErrorPrefix "guardBranch") pats) <<< toWhere
 904 | 
 905 | -- | Constructs a guard expression that does not bind anything.
 906 | guardExpr :: forall e. Expr e -> PatternGuard e
 907 | guardExpr = PatternGuard <<< { binder: Nothing, expr: _ }
 908 | 
 909 | -- | Constructs a guard expression that binds a value.
 910 | guardBinder :: forall e. Binder e -> Expr e -> PatternGuard e
 911 | guardBinder bnd = PatternGuard <<< { binder: Just (Tuple bnd tokLeftArrow), expr: _ }
 912 | 
 913 | -- | Constructs a case branch for use with exprCase. See exprCase.
 914 | caseBranch
 915 |   :: forall e f branch
 916 |    . ToNonEmptyArray f
 917 |   => ToGuarded branch e
 918 |   => f (Binder e)
 919 |   -> branch
 920 |   -> Tuple (Separated (Binder e)) (Guarded e)
 921 | caseBranch lhs rhs =
 922 |   Tuple (toSeparated tokComma $ map precBinder0 $ (toNonEmptyArray (ErrorPrefix "caseBranch") lhs))
 923 |     (toGuarded tokRightArrow rhs)
 924 | 
 925 | -- | Constructs an expression section (`_`). This is meaningless and will
 926 | -- | produce invalid syntax when used arbitrarily. Pair with appropriate
 927 | -- | constructors like `exprCase` or `exprDot`.
 928 | exprSection :: forall e. Expr e
 929 | exprSection = ExprSection tokUnderscore
 930 | 
 931 | -- | Constructs a wildcard (`_`) binding pattern.
 932 | -- |
 933 | -- | ```purescript
 934 | -- | exampleExpr =
 935 | -- |   exprLambda [ binderWildcard ]
 936 | -- |     (exprApp (exprIdent "countDown") [ exprInt 100 ])
 937 | -- | ```
 938 | binderWildcard :: forall e. Binder e
 939 | binderWildcard = BinderWildcard tokUnderscore
 940 | 
 941 | -- | Constructs a variable binding pattern.
 942 | binderVar :: forall e name. ToName name Ident => name -> Binder e
 943 | binderVar = BinderVar <<< toName
 944 | 
 945 | -- | Constructs a named binding pattern (`@`).
 946 | binderNamed :: forall e name. ToName name Ident => name -> Binder e -> Binder e
 947 | binderNamed n = BinderNamed (toName n) tokAt <<< precBinder2
 948 | 
 949 | -- | Constructs a constructor binding pattern.
 950 | binderCtor :: forall e name. ToQualifiedName name Proper => name -> Array (Binder e) -> Binder e
 951 | binderCtor n = BinderConstructor (toQualifiedName n) <<< map precBinder2
 952 | 
 953 | -- | Constructs a boolean literal binding pattern.
 954 | binderBool :: forall e. Boolean -> Binder e
 955 | binderBool bool = BinderBoolean (if bool then tokTrue else tokFalse) bool
 956 | 
 957 | -- | Constructs a char literal binding pattern.
 958 | binderChar :: forall e. Char -> Binder e
 959 | binderChar ch = BinderChar (toSourceToken (TokChar (unwrap (escapeSourceString (SCU.singleton ch))) ch)) ch
 960 | 
 961 | -- | Constructs a string literal binding pattern.
 962 | binderString :: forall e. String -> Binder e
 963 | binderString str = BinderString (toSourceToken (TokString (unwrap (escapeSourceString str)) str)) str
 964 | 
 965 | -- | Constructs an int literal binding pattern.
 966 | binderInt :: forall e. Int -> Binder e
 967 | binderInt n = BinderInt neg (toSourceToken (TokInt (show val) (SmallInt val))) (SmallInt val)
 968 |   where
 969 |   val = abs n
 970 |   neg = if n < 0 then Just tokNegate else Nothing
 971 | 
 972 | -- | Constructs a number literal binding pattern.
 973 | binderNumber :: forall e. Number -> Binder e
 974 | binderNumber n = BinderNumber neg (toSourceToken (TokNumber (show val) val)) val
 975 |   where
 976 |   val = abs n
 977 |   neg = if n < 0.0 then Just tokNegate else Nothing
 978 | 
 979 | -- | Constructs an array literal binding pattern.
 980 | binderArray :: forall e. Array (Binder e) -> Binder e
 981 | binderArray arr = BinderArray $ Wrapped
 982 |   { close: tokRightSquare
 983 |   , open: tokLeftSquare
 984 |   , value: toSeparated tokComma <$> NonEmptyArray.fromArray arr
 985 |   }
 986 | 
 987 | -- | Constructs a record literal binding pattern.
 988 | binderRecord :: forall e field. ToRecordLabeled field (Binder e) => Array field -> Binder e
 989 | binderRecord arr = BinderRecord $ Wrapped
 990 |   { close: tokRightBrace
 991 |   , open: tokLeftBrace
 992 |   , value: toSeparated tokComma <<< map toRecordLabeled <$> NonEmptyArray.fromArray arr
 993 |   }
 994 | 
 995 | -- | Wraps a binding pattern in parens.
 996 | binderParens :: forall e. Binder e -> Binder e
 997 | binderParens = BinderParens <<< toWrapped tokLeftParen tokRightParen
 998 | 
 999 | -- | Constructs a typed binding pattern.
1000 | binderTyped :: forall e. Binder e -> CST.Type e -> Binder e
1001 | binderTyped = flip BinderTyped tokDoubleColon <<< precBinder0
1002 | 
1003 | -- | Constructs an operator binding pattern.
1004 | binderOp :: forall e. Binder e -> Array (BinaryOp (Binder e)) -> Binder e
1005 | binderOp bnd = maybe bnd (BinderOp bnd <<< coerce) <<< NonEmptyArray.fromArray <<< map (map precBinder1)
1006 | 
1007 | -- | Constructs a data declaration.
1008 | -- |
1009 | -- | ```purescript
1010 | -- | exampleDecl =
1011 | -- |   declData "Either" [ typeVar "a", typeVar "b" ]
1012 | -- |     [ dataCtor "Left" [ typeVar "a" ]
1013 | -- |     , dataCtor "Right" [ typeVar "b" ]
1014 | -- |     ]
1015 | -- | ```
1016 | declData
1017 |   :: forall e name
1018 |    . ToName name Proper
1019 |   => name
1020 |   -> Array (TypeVarBinding (Name Ident) e)
1021 |   -> Array (DataCtor e)
1022 |   -> Declaration e
1023 | declData name vars ctors =
1024 |   DeclData { keyword: tokData, name: toName name, vars } $
1025 |     Tuple tokEquals <<< toSeparated tokPipe <$> NonEmptyArray.fromArray ctors
1026 | 
1027 | -- | Constructs a data constructor variant. See declData.
1028 | dataCtor :: forall e name. ToName name Proper => name -> Array (CST.Type e) -> DataCtor e
1029 | dataCtor name fields = DataCtor { name: toName name, fields }
1030 | 
1031 | -- | Constructs a type synonym declaration.
1032 | -- |
1033 | -- | ```purescript
1034 | -- | exampleDecl =
1035 | -- |   declType "UserFields" [ typeVar "r" ]
1036 | -- |     ( typeRow
1037 | -- |         [ Tuple "id" (typeCtor "UserId")
1038 | -- |         , Tuple "name" (typeCtor "String")
1039 | -- |         , Tuple "age" (typeCtor "Int")
1040 | -- |         ]
1041 | -- |         (Just (typeVar "r"))
1042 | -- |     )
1043 | -- | ```
1044 | declType
1045 |   :: forall e name
1046 |    . ToName name Proper
1047 |   => name
1048 |   -> Array (TypeVarBinding (Name Ident) e)
1049 |   -> CST.Type e
1050 |   -> Declaration e
1051 | declType name vars =
1052 |   DeclType { keyword: tokType, name: toName name, vars } tokEquals
1053 | 
1054 | -- | Constructs a newtype declaration.
1055 | -- |
1056 | -- | ```purescript
1057 | -- | exampleDecl =
1058 | -- |   declNewtype "UserId" [] "UserId" (typeCtor "String")
1059 | -- | ```
1060 | declNewtype
1061 |   :: forall e name ctor
1062 |    . ToName name Proper
1063 |   => ToName ctor Proper
1064 |   => name
1065 |   -> Array (TypeVarBinding (Name Ident) e)
1066 |   -> ctor
1067 |   -> CST.Type e
1068 |   -> Declaration e
1069 | declNewtype name vars ctor =
1070 |   DeclNewtype { keyword: tokNewtype, name: toName name, vars } tokEquals (toName ctor)
1071 | 
1072 | -- | Constructs a class declaration.
1073 | -- |
1074 | -- | ```purescript
1075 | -- | exampleDecl =
1076 | -- |   declClass [ typeApp (typeCtor "Eq") [ typeVar "a" ] ] "Ord" [ typeVar "a" ] []
1077 | -- |     [ classMember "compare"
1078 | -- |         (typeArrow [ typeVar "a", typeVar "a" ] (typeCtor "Ordering"))
1079 | -- |     ]
1080 | -- | ```
1081 | declClass
1082 |   :: forall e name
1083 |    . ToName name Proper
1084 |   => Array (CST.Type e)
1085 |   -> name
1086 |   -> Array (TypeVarBinding (Name Ident) e)
1087 |   -> Array ClassFundep
1088 |   -> Array (ClassMember e)
1089 |   -> Declaration e
1090 | declClass super name vars fundeps members =
1091 |   DeclClass
1092 |     { keyword: tokClass
1093 |     , super: flip Tuple tokLeftFatArrow <<< toOneOrDelimited <$> NonEmptyArray.fromArray super
1094 |     , name: toName name
1095 |     , vars
1096 |     , fundeps: Tuple tokPipe <<< toSeparated tokComma <$> NonEmptyArray.fromArray fundeps
1097 |     }
1098 |     (Tuple tokWhere <$> NonEmptyArray.fromArray members)
1099 | 
1100 | -- | Constructs a class member signature. See declClass.
1101 | classMember :: forall e name. ToName name Ident => name -> CST.Type e -> ClassMember e
1102 | classMember = curry (toLabeled tokDoubleColon)
1103 | 
1104 | class DeclInstance a e | a -> e where
1105 |   -- | An overloaded constructor for instances. Can be used to construct a
1106 |   -- | declaration directly, or within an instance chain.
1107 |   -- |
1108 |   -- | ```purescript
1109 |   -- | exampleDecl =
1110 |   -- |   declInstance Nothing [] "Functor" [ typeApp (typeCtor "Maybe") [ typeVar "a" ] ]
1111 |   -- |     [ instValue "map" [ binderVar "f" ]
1112 |   -- |         ( exprCase [ exprSection ]
1113 |   -- |             [ caseBranch [ binderCtor "Just" [ binderVar "a" ] ]
1114 |   -- |                 (exprApp (exprCtor "Just") [ exprApp (exprIdent "f") [ exprIdent "a" ] ])
1115 |   -- |             , caseBranch [ binderCtor "Nothing" [] ]
1116 |   -- |                 (exprCtor "Nothing")
1117 |   -- |             ]
1118 |   -- |         )
1119 |   -- |     ]
1120 |   -- | ```
1121 |   declInstance
1122 |     :: forall className
1123 |      . ToQualifiedName className Proper
1124 |     => Maybe (Name Ident)
1125 |     -> Array (CST.Type e)
1126 |     -> className
1127 |     -> Array (CST.Type e)
1128 |     -> Array (InstanceBinding e)
1129 |     -> a
1130 | 
1131 | instance DeclInstance (Instance e) e where
1132 |   declInstance name constraints className types bindings = Instance
1133 |     { head: instHead name constraints className types
1134 |     , body: Tuple tokWhere <$> NonEmptyArray.fromArray bindings
1135 |     }
1136 | 
1137 | instance DeclInstance (Declaration e) e where
1138 |   declInstance name constraints className types bindings =
1139 |     DeclInstanceChain $ Separated
1140 |       { head: declInstance name constraints className types bindings
1141 |       , tail: []
1142 |       }
1143 | 
1144 | -- | Constructs an instance chain.
1145 | -- |
1146 | -- | ```purescript
1147 | -- | exampleDecl =
1148 | -- |   declInstanceChain
1149 | -- |     [ declInstance Nothing [] "IsTypeEqual"
1150 | -- |         [ typeVar "a", typeVar "a", typeCtor "True" ]
1151 | -- |         []
1152 | -- |     , declInstance Nothing [] "IsTypeEqual"
1153 | -- |         [ typeVar "a", typeVar "b", typeCtor "False" ]
1154 | -- |         []
1155 | -- |     ]
1156 | -- | ```
1157 | declInstanceChain :: forall e f. ToNonEmptyArray f => f (Instance e) -> Declaration e
1158 | declInstanceChain = DeclInstanceChain <<< toSeparated tokElse <<< toNonEmptyArray (ErrorPrefix "declInstanceChain")
1159 | 
1160 | -- | Constructs an signature for an instance binding.
1161 | instSignature :: forall e a. ToName a Ident => a -> CST.Type e -> InstanceBinding e
1162 | instSignature = curry $ InstanceBindingSignature <<< toLabeled tokDoubleColon
1163 | 
1164 | -- | Constructs an instance value binding. See declInstance.
1165 | instValue :: forall e a b. ToName a Ident => ToGuarded b e => a -> Array (Binder e) -> b -> InstanceBinding e
1166 | instValue name binders grd = InstanceBindingName
1167 |   { name: toName name
1168 |   , binders
1169 |   , guarded: toGuarded tokEquals grd
1170 |   }
1171 | 
1172 | instHead
1173 |   :: forall e className
1174 |    . ToQualifiedName className Proper
1175 |   => Maybe (Name Ident)
1176 |   -> Array (CST.Type e)
1177 |   -> className
1178 |   -> Array (CST.Type e)
1179 |   -> InstanceHead e
1180 | instHead name constraints className types =
1181 |   { keyword: tokInstance
1182 |   , name: flip Tuple tokDoubleColon <$> name
1183 |   , constraints: flip Tuple tokRightFatArrow <<< toOneOrDelimited <$> NonEmptyArray.fromArray constraints
1184 |   , className: toQualifiedName className
1185 |   , types: map precType3 types
1186 |   }
1187 | 
1188 | -- | Constructs an instance deriving declaration.
1189 | -- |
1190 | -- | ```purescript
1191 | -- | exampleDecl =
1192 | -- |   declDerive Nothing [] "Eq" [ typeCtor "UserId" ]
1193 | -- | ```
1194 | declDerive
1195 |   :: forall e className
1196 |    . ToQualifiedName className Proper
1197 |   => Maybe (Name Ident)
1198 |   -> Array (CST.Type e)
1199 |   -> className
1200 |   -> Array (CST.Type e)
1201 |   -> Declaration e
1202 | declDerive name constraints className types =
1203 |   DeclDerive tokDerive Nothing (instHead name constraints className types)
1204 | 
1205 | -- | Constructs a newtype instance deriving declaration.
1206 | -- |
1207 | -- | ```purescript
1208 | -- | exampleDecl =
1209 | -- |   declDeriveNewtype Nothing [] "Eq" [ typeCtor "UserId" ]
1210 | -- | ```
1211 | declDeriveNewtype
1212 |   :: forall e className
1213 |    . ToQualifiedName className Proper
1214 |   => Maybe (Name Ident)
1215 |   -> Array (CST.Type e)
1216 |   -> className
1217 |   -> Array (CST.Type e)
1218 |   -> Declaration e
1219 | declDeriveNewtype name constraints className types =
1220 |   DeclDerive tokDerive (Just tokNewtype) (instHead name constraints className types)
1221 | 
1222 | -- | Constructs a kind signature for a data declaration.
1223 | declDataSignature :: forall e a. ToName a Proper => a -> CST.Type e -> Declaration e
1224 | declDataSignature = curry $ DeclKindSignature tokData <<< toLabeled tokDoubleColon
1225 | 
1226 | -- | Constructs a kind signature for a newtype declaration.
1227 | declNewtypeSignature :: forall e a. ToName a Proper => a -> CST.Type e -> Declaration e
1228 | declNewtypeSignature = curry $ DeclKindSignature tokNewtype <<< toLabeled tokDoubleColon
1229 | 
1230 | -- | Constructs a kind signature for a type synonym declaration.
1231 | declTypeSignature :: forall e a. ToName a Proper => a -> CST.Type e -> Declaration e
1232 | declTypeSignature = curry $ DeclKindSignature tokType <<< toLabeled tokDoubleColon
1233 | 
1234 | -- | Constructs a kind signature for a class declaration.
1235 | declClassSignature :: forall e a. ToName a Proper => a -> CST.Type e -> Declaration e
1236 | declClassSignature = curry $ DeclKindSignature tokClass <<< toLabeled tokDoubleColon
1237 | 
1238 | -- | Constructs a type signature for a value declaration.
1239 | declSignature :: forall e a. ToName a Ident => a -> CST.Type e -> Declaration e
1240 | declSignature = curry $ DeclSignature <<< toLabeled tokDoubleColon
1241 | 
1242 | -- | Constructs a value declaration.
1243 | -- |
1244 | -- | ```purescript
1245 | -- | exampleDecl =
1246 | -- |   declValue "countDown" [ binderVar "n" ]
1247 | -- |     [ guardBranch [ guardExpr (exprOp (exprIdent "n") [ binaryOp ">" (exprInt 0) ]) ]
1248 | -- |         ( exprApp (exprIdent "countDown")
1249 | -- |             [ exprOp (exprIdent "n") [ binaryOp "-" (exprInt 1) ] ]
1250 | -- |         )
1251 | -- |     , guardBranch [ guardExpr (exprIdent "otherwise") ]
1252 | -- |         (exprIdent "n")
1253 | -- |     ]
1254 | -- | ```
1255 | declValue
1256 |   :: forall e name guards
1257 |    . ToName name Ident
1258 |   => ToGuarded guards e
1259 |   => name
1260 |   -> Array (Binder e)
1261 |   -> guards
1262 |   -> Declaration e
1263 | declValue name binders grd = DeclValue
1264 |   { name: toName name
1265 |   , binders
1266 |   , guarded: toGuarded tokEquals grd
1267 |   }
1268 | 
1269 | -- | Constructs an fixity declaration for a value operator.
1270 | -- |
1271 | -- | ```purescript
1272 | -- | exampleDecl =
1273 | -- |   declInfix Infixl 4 "map" "<$>"
1274 | -- | ```
1275 | declInfix
1276 |   :: forall e name op
1277 |    . ToFixityName name
1278 |   => ToName op Operator
1279 |   => Fixity
1280 |   -> Int
1281 |   -> name
1282 |   -> op
1283 |   -> Declaration e
1284 | declInfix fixity prec name op = DeclFixity
1285 |   { keyword: Tuple (tokForFixity fixity) fixity
1286 |   , prec: lmap toSourceToken $ toToken prec
1287 |   , operator: FixityValue (toFixityName name) tokAs (toName op)
1288 |   }
1289 | 
1290 | -- | Constructs an fixity declaration for a type operator.
1291 | -- |
1292 | -- | ```purescript
1293 | -- | exampleDecl =
1294 | -- |   declInfix Infixr 0 "RowApply" "+"
1295 | -- | ```
1296 | declInfixType
1297 |   :: forall e name op
1298 |    . ToQualifiedName name Proper
1299 |   => ToName op Operator
1300 |   => Fixity
1301 |   -> Int
1302 |   -> name
1303 |   -> op
1304 |   -> Declaration e
1305 | declInfixType fixity prec name op = DeclFixity
1306 |   { keyword: Tuple (tokForFixity fixity) fixity
1307 |   , prec: lmap toSourceToken $ toToken prec
1308 |   , operator: FixityType tokType (toQualifiedName name) tokAs (toName op)
1309 |   }
1310 | 
1311 | -- | Constructs a foreign import declaration.
1312 | declForeign :: forall e name. ToName name Ident => name -> CST.Type e -> Declaration e
1313 | declForeign = curry $ DeclForeign tokForeign tokImport <<< ForeignValue <<< toLabeled tokDoubleColon
1314 | 
1315 | -- | Constructs a foreign data import declaration.
1316 | declForeignData :: forall e name. ToName name Proper => name -> CST.Type e -> Declaration e
1317 | declForeignData = curry $ DeclForeign tokForeign tokImport <<< ForeignData tokData <<< toLabeled tokDoubleColon
1318 | 
1319 | -- | Constructs a role declaration.
1320 | declRole :: forall e f name. ToName name Proper => ToNonEmptyArray f => name -> f Role -> Declaration e
1321 | declRole name roles = DeclRole tokType tokRole (toName name) ((Tuple =<< tokForRole) <$> toNonEmptyArray (ErrorPrefix "declRole") roles)
1322 | 
1323 | -- | Constructs an import declaration with selective imports. Providing no named
1324 | -- | imports results in an open import.
1325 | declImport :: forall e name. ToName name ModuleName => name -> Array (Import e) -> ImportDecl e
1326 | declImport name imports = ImportDecl
1327 |   { keyword: tokImport
1328 |   , module: toName name
1329 |   , names: Tuple Nothing <<< toParenList <$> NonEmptyArray.fromArray imports
1330 |   , qualified: Nothing
1331 |   }
1332 | 
1333 | -- | Constructs a qualified import declaration.
1334 | declImportAs :: forall e as name. ToName name ModuleName => ToName as ModuleName => name -> Array (Import e) -> as -> ImportDecl e
1335 | declImportAs name imports as = ImportDecl
1336 |   { keyword: tokImport
1337 |   , module: toName name
1338 |   , names: Tuple Nothing <<< toParenList <$> NonEmptyArray.fromArray imports
1339 |   , qualified: Just (Tuple tokAs (toName as))
1340 |   }
1341 | 
1342 | -- | Constructs a hiding import declaration.
1343 | declImportHiding :: forall e name. ToName name ModuleName => name -> Array (Import e) -> ImportDecl e
1344 | declImportHiding name imports = ImportDecl
1345 |   { keyword: tokImport
1346 |   , module: toName name
1347 |   , names: Tuple (Just tokHiding) <<< toParenList <$> NonEmptyArray.fromArray imports
1348 |   , qualified: Nothing
1349 |   }
1350 | 
1351 | -- | Constructs a qualified hiding import declaration.
1352 | declImportHidingAs :: forall e as name. ToName name ModuleName => ToName as ModuleName => name -> Array (Import e) -> as -> ImportDecl e
1353 | declImportHidingAs name imports as = ImportDecl
1354 |   { keyword: tokImport
1355 |   , module: toName name
1356 |   , names: Tuple (Just tokHiding) <<< toParenList <$> NonEmptyArray.fromArray imports
1357 |   , qualified: Just (Tuple tokAs (toName as))
1358 |   }
1359 | 
1360 | -- | Constructs a value import.
1361 | importValue :: forall e name. ToName name Ident => name -> Import e
1362 | importValue = ImportValue <<< toName
1363 | 
1364 | -- | Constructs a value operator import.
1365 | importOp :: forall e name. ToName name SymbolName => name -> Import e
1366 | importOp = ImportOp <<< (coerce :: Name SymbolName -> Name Operator) <<< toName
1367 | 
1368 | -- | Constructs a type import.
1369 | importType :: forall e name. ToName name Proper => name -> Import e
1370 | importType = flip ImportType Nothing <<< toName
1371 | 
1372 | -- | Constructs a type import with all data members.
1373 | importTypeAll :: forall e name. ToName name Proper => name -> Import e
1374 | importTypeAll = flip ImportType (Just (DataAll tokAll)) <<< toName
1375 | 
1376 | -- | Constructs a type import with selective data members.
1377 | importTypeMembers :: forall e name member. ToName name Proper => ToName member Proper => name -> Array member -> Import e
1378 | importTypeMembers name members = ImportType (toName name) $ Just $ DataEnumerated $ Wrapped
1379 |   { close: tokRightParen
1380 |   , open: tokLeftParen
1381 |   , value: toSeparated tokComma <<< map toName <$> NonEmptyArray.fromArray members
1382 |   }
1383 | 
1384 | -- | Constructs a type operator import.
1385 | importTypeOp :: forall e name. ToName name SymbolName => name -> Import e
1386 | importTypeOp = ImportTypeOp tokType <<< (coerce :: Name SymbolName -> Name Operator) <<< toName
1387 | 
1388 | -- | Constructs a class import.
1389 | importClass :: forall e name. ToName name Proper => name -> Import e
1390 | importClass = ImportClass tokClass <<< toName
1391 | 
1392 | -- | Constructs a value export.
1393 | exportValue :: forall e name. ToName name Ident => name -> Export e
1394 | exportValue = ExportValue <<< toName
1395 | 
1396 | -- | Constructs a value operator export.
1397 | exportOp :: forall e name. ToName name SymbolName => name -> Export e
1398 | exportOp = ExportOp <<< (coerce :: Name SymbolName -> Name Operator) <<< toName
1399 | 
1400 | -- | Constructs a type export.
1401 | exportType :: forall e name. ToName name Proper => name -> Export e
1402 | exportType = flip ExportType Nothing <<< toName
1403 | 
1404 | -- | Constructs a type export with all data members.
1405 | exportTypeAll :: forall e name. ToName name Proper => name -> Export e
1406 | exportTypeAll = flip ExportType (Just (DataAll tokAll)) <<< toName
1407 | 
1408 | -- | Constructs a type export with selective data members.
1409 | exportTypeMembers :: forall e name member. ToName name Proper => ToName member Proper => name -> Array member -> Export e
1410 | exportTypeMembers name members = ExportType (toName name) $ Just $ DataEnumerated $ Wrapped
1411 |   { close: tokRightParen
1412 |   , open: tokLeftParen
1413 |   , value: toSeparated tokComma <<< map toName <$> NonEmptyArray.fromArray members
1414 |   }
1415 | 
1416 | -- | Constructs a type operator export.
1417 | exportTypeOp :: forall e name. ToName name SymbolName => name -> Export e
1418 | exportTypeOp = ExportTypeOp tokType <<< (coerce :: Name SymbolName -> Name Operator) <<< toName
1419 | 
1420 | -- | Constructs a class export.
1421 | exportClass :: forall e name. ToName name Proper => name -> Export e
1422 | exportClass = ExportClass tokClass <<< toName
1423 | 
1424 | -- | Constructs a module re-export.
1425 | exportModule :: forall e name. ToName name ModuleName => name -> Export e
1426 | exportModule = ExportModule tokModule <<< toName
1427 | 
1428 | -- | Constructs a module.
1429 | module_
1430 |   :: forall e name
1431 |    . ToName name ModuleName
1432 |   => name
1433 |   -> Array (Export e)
1434 |   -> Array (ImportDecl e)
1435 |   -> Array (Declaration e)
1436 |   -> Module e
1437 | module_ name exports imports decls = Module
1438 |   { header: ModuleHeader
1439 |       { keyword: tokModule
1440 |       , name: toName name
1441 |       , exports: toParenList <$> NonEmptyArray.fromArray exports
1442 |       , where: tokWhere
1443 |       , imports
1444 |       }
1445 |   , body: ModuleBody
1446 |       { decls
1447 |       , trailingComments: []
1448 |       , end: zero
1449 |       }
1450 |   }
1451 | 
1452 | -- | Constructs line comments (`--`).
1453 | lineComments :: String -> Array (Comment LineFeed)
1454 | lineComments = map (Comment <<< append "-- ") <<< String.split (String.Pattern "\n")
1455 | 
1456 | -- | Constructs documentation line comments (`-- |`).
1457 | docComments :: String -> Array (Comment LineFeed)
1458 | docComments = map (Comment <<< append "-- | ") <<< String.split (String.Pattern "\n")
1459 | 
1460 | -- | Constructs a block comment.
1461 | blockComment :: forall a. String -> Array (Comment a)
1462 | blockComment = pure <<< Comment <<< append "{- " <<< flip append " -}"
1463 | 
1464 | -- | Constructs line break annotations.
1465 | lineBreaks :: Int -> Array (Comment LineFeed)
1466 | lineBreaks = pure <<< Line LF
1467 | 
1468 | -- | Constructs space annotations.
1469 | spaces :: forall a. Int -> Array (Comment a)
1470 | spaces = pure <<< Space
1471 | 
1472 | -- | Attaches leading comments to a CST node.
1473 | leading :: forall a. OverLeadingComments a => Array (Comment LineFeed) -> a -> a
1474 | leading c = overLeadingComments (append c)
1475 | 
1476 | -- | Attaches trailing comments to a CST node.
1477 | trailing :: forall a trl. OverTrailingComments a trl => a -> Array (Comment trl) -> a
1478 | trailing a c = overTrailingComments (flip append c) a
1479 | 
1480 | toLabeled :: forall a b c. ToName a b => SourceToken -> Tuple a c -> Labeled (Name b) c
1481 | toLabeled tok (Tuple lbl value) = Labeled
1482 |   { label: toName lbl
1483 |   , separator: tok
1484 |   , value
1485 |   }
1486 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen/Class.purs:
--------------------------------------------------------------------------------
  1 | module Tidy.Codegen.Class where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Data.Array.NonEmpty (NonEmptyArray)
  6 | import Data.Array.NonEmpty as NonEmptyArray
  7 | import Data.Bifunctor (lmap)
  8 | import Data.Either (Either(..))
  9 | import Data.Maybe (Maybe(..), fromMaybe)
 10 | import Data.Newtype (over, unwrap)
 11 | import Data.String as String
 12 | import Data.Tuple (Tuple(..), snd)
 13 | import Partial (crashWith)
 14 | import PureScript.CST.Lexer (lexToken)
 15 | import PureScript.CST.Types (Binder(..), Comment, Declaration(..), Expr(..), Fixity(..), Guarded(..), GuardedExpr(..), Ident(..), ImportDecl(..), Instance(..), IntValue(..), Label(..), Labeled(..), LineFeed, Module(..), ModuleBody(..), ModuleHeader(..), ModuleName(..), Name(..), Operator(..), Proper(..), QualifiedName(..), RecordLabeled(..), Role(..), Separated(..), SourceToken, Token(..), Type(..), Where(..), Wrapped(..))
 16 | import PureScript.CST.Types as CST
 17 | import Safe.Coerce (coerce)
 18 | import Tidy.Codegen.Common (toSeparated, toSourceToken, tokColon, tokComma, tokForFixity, tokForRole, tokPipe)
 19 | import Tidy.Codegen.String (escapeSourceString)
 20 | import Tidy.Codegen.Types (GuardedBranch(..), Qualified(..), SymbolName(..))
 21 | import Type.Equality (class TypeEquals, proof)
 22 | import Type.Equality as TypeEquals
 23 | 
 24 | newtype ErrorPrefix = ErrorPrefix String
 25 | 
 26 | class ToNonEmptyArray f where
 27 |   toNonEmptyArray :: forall a. ErrorPrefix -> f a -> NonEmptyArray a
 28 | 
 29 | instance Partial => ToNonEmptyArray Array where
 30 |   toNonEmptyArray (ErrorPrefix errPrefix) a = case NonEmptyArray.fromArray a of
 31 |     Just b -> b
 32 |     Nothing -> crashWith $ errPrefix <> ": Array is empty"
 33 | 
 34 | instance ToNonEmptyArray NonEmptyArray where
 35 |   toNonEmptyArray = const identity
 36 | 
 37 | toTokenFromString :: forall a. Partial => FromToken a => ErrorPrefix -> String -> Tuple Token a
 38 | toTokenFromString (ErrorPrefix errPrefix) str =
 39 |   case lexToken str of
 40 |     Right tok | Just val <- fromToken tok ->
 41 |       Tuple tok val
 42 |     _ ->
 43 |       crashWith $ errPrefix <> ": " <> str
 44 | 
 45 | class ToToken a b where
 46 |   toToken :: a -> Tuple Token b
 47 | 
 48 | instance Partial => ToToken String Ident where
 49 |   toToken = toTokenFromString (ErrorPrefix "Not an Ident")
 50 | 
 51 | instance ToToken (Name Ident) Ident where
 52 |   toToken (Name { name, token }) = Tuple token.value name
 53 | 
 54 | instance ToToken Ident Ident where
 55 |   toToken str = Tuple (TokLowerName Nothing (unwrap str)) str
 56 | 
 57 | instance Partial => ToToken String Proper where
 58 |   toToken = toTokenFromString (ErrorPrefix "Not a Proper")
 59 | 
 60 | instance ToToken (Name Proper) Proper where
 61 |   toToken (Name { name, token }) = Tuple token.value name
 62 | 
 63 | instance ToToken Proper Proper where
 64 |   toToken str = Tuple (TokUpperName Nothing (unwrap str)) str
 65 | 
 66 | instance Partial => ToToken String Operator where
 67 |   toToken = toTokenFromString (ErrorPrefix "Not an Operator")
 68 | 
 69 | instance ToToken (Name Operator) Operator where
 70 |   toToken (Name { name, token }) = Tuple token.value name
 71 | 
 72 | instance ToToken Operator Operator where
 73 |   toToken str = Tuple (TokOperator Nothing (unwrap str)) str
 74 | 
 75 | instance Partial => ToToken String SymbolName where
 76 |   toToken str = case lexToken str of
 77 |     Right tok@(TokSymbolName Nothing sym) -> Tuple tok (SymbolName sym)
 78 |     Right (TokOperator Nothing sym) -> Tuple (TokSymbolName Nothing sym) (SymbolName str)
 79 |     _ -> crashWith $ "Not a SymbolName: " <> str
 80 | 
 81 | instance ToToken (Name SymbolName) SymbolName where
 82 |   toToken (Name { name, token }) = Tuple token.value name
 83 | 
 84 | instance ToToken SymbolName SymbolName where
 85 |   toToken str = Tuple (TokSymbolName Nothing (unwrap str)) str
 86 | 
 87 | instance ToToken SymbolName Operator where
 88 |   toToken str = Tuple (TokSymbolName Nothing (unwrap str)) (Operator (unwrap str))
 89 | 
 90 | instance Partial => ToToken String ModuleName where
 91 |   toToken = toTokenFromString (ErrorPrefix "Not a ModuleName")
 92 | 
 93 | instance ToToken (Name ModuleName) ModuleName where
 94 |   toToken (Name { name, token }) = Tuple token.value name
 95 | 
 96 | instance ToToken ModuleName ModuleName where
 97 |   toToken (ModuleName name) = Tuple token (ModuleName name)
 98 |     where
 99 |     token = fromMaybe (TokUpperName Nothing name) do
100 |       ix <- String.lastIndexOf (String.Pattern ".") name
101 |       let qual = String.take ix name
102 |       let mod = String.drop (ix + 1) name
103 |       pure $ TokUpperName (Just (ModuleName qual)) mod
104 | 
105 | instance ToToken String Label where
106 |   toToken str = case lexToken str of
107 |     Right tok@(TokLowerName Nothing lbl) -> Tuple tok (Label lbl)
108 |     _ -> toToken (Label str)
109 | 
110 | instance ToToken (Name Label) Label where
111 |   toToken (Name { name, token }) = Tuple token.value name
112 | 
113 | instance ToToken Label Label where
114 |   toToken (Label lbl) = Tuple (TokString (unwrap (escapeSourceString lbl)) lbl) (Label lbl)
115 | 
116 | instance ToToken Int IntValue where
117 |   toToken n = Tuple (TokInt (show n) (SmallInt n)) (SmallInt n)
118 | 
119 | instance ToToken Int Int where
120 |   toToken n = Tuple (TokInt (show n) (SmallInt n)) n
121 | 
122 | instance ToToken Number Number where
123 |   toToken n = Tuple (TokNumber (show n) n) n
124 | 
125 | instance ToToken String String where
126 |   toToken str = Tuple (TokString (unwrap (escapeSourceString str)) str) str
127 | 
128 | instance ToToken Boolean Boolean where
129 |   toToken b = Tuple (TokLowerName Nothing (if b then "true" else "false")) b
130 | 
131 | instance ToToken Fixity Fixity where
132 |   toToken fixity = Tuple (tokForFixity fixity).value fixity
133 | 
134 | instance ToToken Role Role where
135 |   toToken role = Tuple (tokForRole role).value role
136 | 
137 | instance Partial => ToToken String (Qualified Ident) where
138 |   toToken = toTokenFromString (ErrorPrefix "Not a Qualified dIdent")
139 | 
140 | instance ToToken (Name Ident) (Qualified Ident) where
141 |   toToken (Name { name, token }) = Tuple token.value (Qualified Nothing name)
142 | 
143 | instance ToToken (Qualified Ident) (Qualified Ident) where
144 |   toToken qual@(Qualified mn str) = Tuple (TokLowerName mn (unwrap str)) qual
145 | 
146 | instance Partial => ToToken String (Qualified Proper) where
147 |   toToken = toTokenFromString (ErrorPrefix "Not a Qualified Proper")
148 | 
149 | instance ToToken (Name Proper) (Qualified Proper) where
150 |   toToken (Name { name, token }) = Tuple token.value (Qualified Nothing name)
151 | 
152 | instance ToToken (Qualified Proper) (Qualified Proper) where
153 |   toToken qual@(Qualified mn str) = Tuple (TokUpperName mn (unwrap str)) qual
154 | 
155 | instance Partial => ToToken String (Qualified Operator) where
156 |   toToken = toTokenFromString (ErrorPrefix "Not a Qualified Operator")
157 | 
158 | instance ToToken (Name Operator) (Qualified Operator) where
159 |   toToken (Name { name, token }) = Tuple token.value (Qualified Nothing name)
160 | 
161 | instance ToToken (Qualified Operator) (Qualified Operator) where
162 |   toToken qual@(Qualified mn str) = Tuple (TokOperator mn (unwrap str)) qual
163 | 
164 | instance Partial => ToToken String (Qualified SymbolName) where
165 |   toToken = toTokenFromString (ErrorPrefix "Not a Qualified SymbolName")
166 | 
167 | instance ToToken (Name SymbolName) (Qualified SymbolName) where
168 |   toToken (Name { name, token }) = Tuple token.value (Qualified Nothing name)
169 | 
170 | instance ToToken (Qualified SymbolName) (Qualified SymbolName) where
171 |   toToken qual@(Qualified mn str) = Tuple (TokSymbolName mn (unwrap str)) qual
172 | 
173 | instance ToToken (QualifiedName a) (Qualified a) where
174 |   toToken (QualifiedName qual) = Tuple qual.token.value (Qualified qual.module qual.name)
175 | 
176 | class ToName a b where
177 |   toName :: a -> Name b
178 | 
179 | defaultToName :: forall a b. ToToken a b => a -> Name b
180 | defaultToName val = do
181 |   let (Tuple tok name) = toToken val
182 |   Name { name, token: toSourceToken tok }
183 | 
184 | instance Partial => ToName String Ident where
185 |   toName = defaultToName
186 | 
187 | instance ToName Ident Ident where
188 |   toName = defaultToName
189 | 
190 | instance ToName (Name Ident) Ident where
191 |   toName = identity
192 | 
193 | instance Partial => ToName String Proper where
194 |   toName = defaultToName
195 | 
196 | instance ToName Proper Proper where
197 |   toName = defaultToName
198 | 
199 | instance ToName (Name Proper) Proper where
200 |   toName = identity
201 | 
202 | instance Partial => ToName String Operator where
203 |   toName = defaultToName
204 | 
205 | instance ToName Operator Operator where
206 |   toName = defaultToName
207 | 
208 | instance ToName (Name Operator) Operator where
209 |   toName = identity
210 | 
211 | instance Partial => ToName String SymbolName where
212 |   toName = defaultToName
213 | 
214 | instance ToName SymbolName SymbolName where
215 |   toName = defaultToName
216 | 
217 | instance ToName Operator SymbolName where
218 |   toName str = Name { name: coerce str, token: toSourceToken (TokSymbolName Nothing (unwrap str)) }
219 | 
220 | instance ToName (Name Operator) SymbolName where
221 |   toName (Name { name, token }) = Name
222 |     { name: coerce name
223 |     , token:
224 |         case token.value of
225 |           TokOperator mn op ->
226 |             token { value = TokSymbolName mn op }
227 |           _ -> token
228 |     }
229 | 
230 | instance ToName String Label where
231 |   toName = defaultToName
232 | 
233 | instance ToName Label Label where
234 |   toName = defaultToName
235 | 
236 | instance Partial => ToName String ModuleName where
237 |   toName = defaultToName
238 | 
239 | instance ToName ModuleName ModuleName where
240 |   toName = defaultToName
241 | 
242 | instance ToName (QualifiedName a) a where
243 |   toName (QualifiedName { name, token }) = Name { name, token }
244 | 
245 | class FromToken b where
246 |   fromToken :: Token -> Maybe b
247 | 
248 | instance FromToken Ident where
249 |   fromToken = case _ of
250 |     TokLowerName Nothing str -> Just (Ident str)
251 |     _ -> Nothing
252 | 
253 | instance FromToken (Qualified Ident) where
254 |   fromToken = case _ of
255 |     TokLowerName qual str -> Just (Qualified qual (Ident str))
256 |     _ -> Nothing
257 | 
258 | instance FromToken Proper where
259 |   fromToken = case _ of
260 |     TokUpperName Nothing str -> Just (Proper str)
261 |     _ -> Nothing
262 | 
263 | instance FromToken (Qualified Proper) where
264 |   fromToken = case _ of
265 |     TokUpperName qual str -> Just (Qualified qual (Proper str))
266 |     _ -> Nothing
267 | 
268 | instance FromToken Operator where
269 |   fromToken = case _ of
270 |     TokOperator Nothing str -> Just (Operator str)
271 |     _ -> Nothing
272 | 
273 | instance FromToken (Qualified Operator) where
274 |   fromToken = case _ of
275 |     TokOperator qual str -> Just (Qualified qual (Operator str))
276 |     _ -> Nothing
277 | 
278 | instance FromToken SymbolName where
279 |   fromToken = case _ of
280 |     TokSymbolName Nothing str -> Just (SymbolName str)
281 |     TokOperator Nothing str -> Just (SymbolName str)
282 |     _ -> Nothing
283 | 
284 | instance FromToken (Qualified SymbolName) where
285 |   fromToken = case _ of
286 |     TokSymbolName qual str -> Just (Qualified qual (SymbolName str))
287 |     TokOperator qual str -> Just (Qualified qual (SymbolName str))
288 |     _ -> Nothing
289 | 
290 | instance FromToken ModuleName where
291 |   fromToken = case _ of
292 |     TokUpperName (Just qual) str -> Just (ModuleName ((unwrap qual) <> "." <> str))
293 |     TokUpperName Nothing str -> Just (ModuleName str)
294 |     _ -> Nothing
295 | 
296 | instance FromToken Label where
297 |   fromToken = case _ of
298 |     TokLowerName Nothing str -> Just (Label str)
299 |     TokString _ str -> Just (Label str)
300 |     TokRawString str -> Just (Label str)
301 |     _ -> Nothing
302 | 
303 | instance FromToken IntValue where
304 |   fromToken = case _ of
305 |     TokInt _ int -> Just int
306 |     _ -> Nothing
307 | 
308 | instance FromToken Number where
309 |   fromToken = case _ of
310 |     TokNumber _ num -> Just num
311 |     _ -> Nothing
312 | 
313 | instance FromToken Boolean where
314 |   fromToken = case _ of
315 |     TokLowerName Nothing "true" -> Just true
316 |     TokLowerName Nothing "false" -> Just false
317 |     _ -> Nothing
318 | 
319 | instance FromToken Fixity where
320 |   fromToken = case _ of
321 |     TokLowerName Nothing "infix" -> Just Infix
322 |     TokLowerName Nothing "infixl" -> Just Infixr
323 |     TokLowerName Nothing "infixr" -> Just Infixr
324 |     _ -> Nothing
325 | 
326 | instance FromToken Role where
327 |   fromToken = case _ of
328 |     TokLowerName Nothing "nominal" -> Just Nominal
329 |     TokLowerName Nothing "representational" -> Just Representational
330 |     TokLowerName Nothing "phantom" -> Just Phantom
331 |     _ -> Nothing
332 | 
333 | toQualified :: forall a. Partial => FromToken (Qualified a) => String -> Qualified a
334 | toQualified = snd <<< toTokenFromString (ErrorPrefix "Not Qualified")
335 | 
336 | class ToQualifiedName a b where
337 |   toQualifiedName :: a -> QualifiedName b
338 | 
339 | defaultToQualifiedName :: forall a b. ToToken a b => Qualified a -> QualifiedName b
340 | defaultToQualifiedName (Qualified mn a) = do
341 |   let (Tuple tok (name :: b)) = toToken a
342 |   QualifiedName { module: mn, name, token: toSourceToken tok }
343 | 
344 | instance (Partial, FromToken (Qualified a)) => ToQualifiedName String a where
345 |   toQualifiedName str = case lexToken str of
346 |     Right tok | Just (Qualified mn a) <- fromToken tok ->
347 |       QualifiedName { module: mn, name: a, token: toSourceToken tok }
348 |     _ -> crashWith $ "Not a QualifiedName: " <> str
349 | 
350 | instance ToToken a b => ToQualifiedName (Qualified a) b where
351 |   toQualifiedName = defaultToQualifiedName
352 | 
353 | instance ToQualifiedName Ident Ident where
354 |   toQualifiedName = toQualifiedName <<< Qualified Nothing
355 | 
356 | instance ToQualifiedName Proper Proper where
357 |   toQualifiedName = toQualifiedName <<< Qualified Nothing
358 | 
359 | instance ToQualifiedName Operator Operator where
360 |   toQualifiedName = toQualifiedName <<< Qualified Nothing
361 | 
362 | instance ToQualifiedName SymbolName Operator where
363 |   toQualifiedName = toQualifiedName <<< Qualified Nothing
364 | 
365 | instance ToQualifiedName (Name a) a where
366 |   toQualifiedName (Name { name, token }) = QualifiedName { module: Nothing, name, token }
367 | 
368 | instance ToQualifiedName (QualifiedName SymbolName) Operator where
369 |   toQualifiedName (QualifiedName r) = case r.token.value of
370 |     TokSymbolName qual op ->
371 |       QualifiedName
372 |         { module: qual
373 |         , token: toSourceToken (TokOperator qual op)
374 |         , name: Operator op
375 |         }
376 |     _ ->
377 |       QualifiedName r { name = coerce r.name }
378 | 
379 | else instance ToQualifiedName (QualifiedName Operator) SymbolName where
380 |   toQualifiedName (QualifiedName r) = case r.token.value of
381 |     TokOperator qual op ->
382 |       QualifiedName
383 |         { module: qual
384 |         , token: toSourceToken (TokSymbolName qual op)
385 |         , name: SymbolName op
386 |         }
387 |     _ ->
388 |       QualifiedName r { name = coerce r.name }
389 | 
390 | else instance ToQualifiedName (QualifiedName a) a where
391 |   toQualifiedName = identity
392 | 
393 | class ToModuleName a where
394 |   toModuleName :: a -> ModuleName
395 | 
396 | instance Partial => ToModuleName String where
397 |   toModuleName = snd <<< toToken
398 | 
399 | instance ToModuleName ModuleName where
400 |   toModuleName = identity
401 | 
402 | class ToRecordLabeled a b where
403 |   toRecordLabeled :: a -> RecordLabeled b
404 | 
405 | instance Partial => ToRecordLabeled String b where
406 |   toRecordLabeled = RecordPun <<< toName
407 | 
408 | instance ToRecordLabeled Ident b where
409 |   toRecordLabeled = RecordPun <<< toName
410 | 
411 | instance ToRecordLabeled (Name Ident) b where
412 |   toRecordLabeled = RecordPun
413 | 
414 | instance (ToName a Label, TypeEquals b c) => ToRecordLabeled (Tuple a b) c where
415 |   toRecordLabeled (Tuple field value) =
416 |     RecordField (toName field) tokColon (TypeEquals.to value)
417 | 
418 | instance TypeEquals a b => ToRecordLabeled (RecordLabeled a) b where
419 |   toRecordLabeled = proof
420 | 
421 | class ToWhere a e | a -> e where
422 |   toWhere :: a -> Where e
423 | 
424 | instance ToWhere (Expr e) e where
425 |   toWhere = Where <<< { bindings: Nothing, expr: _ }
426 | 
427 | instance ToWhere (Where e) e where
428 |   toWhere = identity
429 | 
430 | class ToGuarded a e | a -> e where
431 |   toGuarded :: SourceToken -> a -> Guarded e
432 | 
433 | instance ToGuarded (Expr e) e where
434 |   toGuarded tok = Unconditional tok <<< toWhere
435 | 
436 | instance ToGuarded (Where e) e where
437 |   toGuarded = Unconditional
438 | 
439 | instance ToGuarded (GuardedBranch e) e where
440 |   toGuarded tok = toGuarded tok <<< NonEmptyArray.singleton
441 | 
442 | instance TypeEquals a (GuardedBranch e) => ToGuarded (NonEmptyArray a) e where
443 |   toGuarded tok = Guarded <<< map (go <<< TypeEquals.to)
444 |     where
445 |     go (GuardedBranch pats wh) = GuardedExpr
446 |       { bar: tokPipe
447 |       , patterns: toSeparated tokComma pats
448 |       , separator: tok
449 |       , where: wh
450 |       }
451 | 
452 | instance (Partial, TypeEquals a (GuardedBranch e)) => ToGuarded (Array a) e where
453 |   toGuarded tok = toGuarded tok <<< toNonEmptyArray (ErrorPrefix "ToGuarded")
454 | 
455 | class ToFixityName a where
456 |   toFixityName :: a -> QualifiedName (Either Ident Proper)
457 | 
458 | instance Partial => ToFixityName String where
459 |   toFixityName str = case lexToken str of
460 |     Right tok@(TokLowerName mn name) ->
461 |       QualifiedName { module: mn, name: Left (Ident name), token: toSourceToken tok }
462 |     Right tok@(TokUpperName mn name) ->
463 |       QualifiedName { module: mn, name: Right (Proper name), token: toSourceToken tok }
464 |     _ ->
465 |       crashWith $ "Not a fixity name: " <> str
466 | 
467 | instance ToFixityName Ident where
468 |   toFixityName = over QualifiedName (\a -> a { name = Left a.name }) <<< toQualifiedName
469 | 
470 | instance ToFixityName Proper where
471 |   toFixityName = over QualifiedName (\a -> a { name = Right a.name }) <<< toQualifiedName
472 | 
473 | type LeadingComments r = (leadingComments :: Array (Comment LineFeed) | r)
474 | 
475 | type TrailingComments trl r = (trailingComments :: Array (Comment trl) | r)
476 | 
477 | class OverLeadingComments a where
478 |   overLeadingComments :: (Array (Comment LineFeed) -> Array (Comment LineFeed)) -> a -> a
479 | 
480 | class OverTrailingComments a trl | a -> trl where
481 |   overTrailingComments :: (Array (Comment trl) -> Array (Comment trl)) -> a -> a
482 | 
483 | instance OverLeadingComments Void where
484 |   overLeadingComments _ = absurd
485 | 
486 | instance OverTrailingComments Void LineFeed where
487 |   overTrailingComments _ = absurd
488 | 
489 | instance TypeEquals r (LeadingComments r') => OverLeadingComments (Record r) where
490 |   overLeadingComments k r = do
491 |     let r' = coerce r :: Record (LeadingComments r')
492 |     coerce r' { leadingComments = k r'.leadingComments } :: Record r
493 | 
494 | instance TypeEquals r (TrailingComments trl r') => OverTrailingComments (Record r) trl where
495 |   overTrailingComments k r = do
496 |     let r' = coerce r :: Record (TrailingComments trl r')
497 |     coerce r' { trailingComments = k r'.trailingComments } :: Record r
498 | 
499 | instance OverLeadingComments (ModuleHeader e) where
500 |   overLeadingComments k (ModuleHeader m) =
501 |     ModuleHeader m { keyword = overLeadingComments k m.keyword }
502 | 
503 | instance OverTrailingComments (ModuleBody e) LineFeed where
504 |   overTrailingComments k (ModuleBody m) =
505 |     ModuleBody m { trailingComments = k m.trailingComments }
506 | 
507 | instance OverLeadingComments (Module e) where
508 |   overLeadingComments k (Module m) =
509 |     Module m { header = overLeadingComments k m.header }
510 | 
511 | instance OverTrailingComments (Module e) LineFeed where
512 |   overTrailingComments k (Module m) =
513 |     Module m { body = overTrailingComments k m.body }
514 | 
515 | instance OverLeadingComments (ImportDecl e) where
516 |   overLeadingComments k (ImportDecl a) = ImportDecl $ a { keyword = overLeadingComments k a.keyword }
517 | 
518 | instance OverLeadingComments e => OverLeadingComments (Declaration e) where
519 |   overLeadingComments k = case _ of
520 |     DeclData a b -> DeclData (a { keyword = overLeadingComments k a.keyword }) b
521 |     DeclType a b c -> DeclType (a { keyword = overLeadingComments k a.keyword }) b c
522 |     DeclNewtype a b c d -> DeclNewtype (a { keyword = overLeadingComments k a.keyword }) b c d
523 |     DeclClass a b -> DeclClass (a { keyword = overLeadingComments k a.keyword }) b
524 |     DeclInstanceChain a -> DeclInstanceChain (overLeadingComments k a)
525 |     DeclDerive a b c -> DeclDerive (overLeadingComments k a) b c
526 |     DeclKindSignature a b -> DeclKindSignature (overLeadingComments k a) b
527 |     DeclSignature a -> DeclSignature (overLeadingComments k a)
528 |     DeclValue a -> DeclValue $ a { name = overLeadingComments k a.name }
529 |     DeclFixity a -> DeclFixity $ a { keyword = lmap (overLeadingComments k) a.keyword }
530 |     DeclForeign a b c -> DeclForeign (overLeadingComments k a) b c
531 |     DeclRole a b c d -> DeclRole (overLeadingComments k a) b c d
532 |     DeclError e -> DeclError (overLeadingComments k e)
533 | 
534 | instance OverLeadingComments (Instance e) where
535 |   overLeadingComments k (Instance a) = Instance $ a { head { keyword = overLeadingComments k a.head.keyword } }
536 | 
537 | instance OverLeadingComments e => OverLeadingComments (CST.Type e) where
538 |   overLeadingComments k = case _ of
539 |     TypeVar a -> TypeVar (overLeadingComments k a)
540 |     TypeConstructor a -> TypeConstructor (overLeadingComments k a)
541 |     TypeWildcard a -> TypeWildcard (overLeadingComments k a)
542 |     TypeHole a -> TypeHole (overLeadingComments k a)
543 |     TypeString a b -> TypeString (overLeadingComments k a) b
544 |     TypeInt (Just a) b c -> TypeInt (Just (overLeadingComments k a)) b c
545 |     TypeInt _ b c -> TypeInt Nothing (overLeadingComments k b) c
546 |     TypeRow a -> TypeRow (overLeadingComments k a)
547 |     TypeRecord a -> TypeRecord (overLeadingComments k a)
548 |     TypeForall a b c d -> TypeForall (overLeadingComments k a) b c d
549 |     TypeKinded a b c -> TypeKinded (overLeadingComments k a) b c
550 |     TypeApp a b -> TypeApp (overLeadingComments k a) b
551 |     TypeOp a b -> TypeOp (overLeadingComments k a) b
552 |     TypeOpName a -> TypeOpName (overLeadingComments k a)
553 |     TypeArrow a b c -> TypeArrow (overLeadingComments k a) b c
554 |     TypeArrowName a -> TypeArrowName (overLeadingComments k a)
555 |     TypeConstrained a b c -> TypeConstrained (overLeadingComments k a) b c
556 |     TypeParens a -> TypeParens (overLeadingComments k a)
557 |     TypeError e -> TypeError (overLeadingComments k e)
558 | 
559 | instance OverLeadingComments e => OverLeadingComments (Expr e) where
560 |   overLeadingComments k = case _ of
561 |     ExprHole a -> ExprHole (overLeadingComments k a)
562 |     ExprSection a -> ExprSection (overLeadingComments k a)
563 |     ExprIdent a -> ExprIdent (overLeadingComments k a)
564 |     ExprConstructor a -> ExprConstructor (overLeadingComments k a)
565 |     ExprBoolean a b -> ExprBoolean (overLeadingComments k a) b
566 |     ExprChar a b -> ExprChar (overLeadingComments k a) b
567 |     ExprString a b -> ExprString (overLeadingComments k a) b
568 |     ExprInt a b -> ExprInt (overLeadingComments k a) b
569 |     ExprNumber a b -> ExprNumber (overLeadingComments k a) b
570 |     ExprArray a -> ExprArray (overLeadingComments k a)
571 |     ExprRecord a -> ExprRecord (overLeadingComments k a)
572 |     ExprParens a -> ExprParens (overLeadingComments k a)
573 |     ExprTyped a b c -> ExprTyped (overLeadingComments k a) b c
574 |     ExprInfix a b -> ExprInfix (overLeadingComments k a) b
575 |     ExprOp a b -> ExprOp (overLeadingComments k a) b
576 |     ExprOpName a -> ExprOpName (overLeadingComments k a)
577 |     ExprNegate a b -> ExprNegate (overLeadingComments k a) b
578 |     ExprRecordAccessor a -> ExprRecordAccessor a { expr = overLeadingComments k a.expr }
579 |     ExprRecordUpdate a b -> ExprRecordUpdate (overLeadingComments k a) b
580 |     ExprApp a b -> ExprApp (overLeadingComments k a) b
581 |     ExprLambda a -> ExprLambda a { symbol = overLeadingComments k a.symbol }
582 |     ExprIf a -> ExprIf a { keyword = overLeadingComments k a.keyword }
583 |     ExprCase a -> ExprCase a { keyword = overLeadingComments k a.keyword }
584 |     ExprLet a -> ExprLet a { keyword = overLeadingComments k a.keyword }
585 |     ExprDo a -> ExprDo a { keyword = overLeadingComments k a.keyword }
586 |     ExprAdo a -> ExprAdo a { keyword = overLeadingComments k a.keyword }
587 |     ExprError e -> ExprError (overLeadingComments k e)
588 | 
589 | instance OverLeadingComments e => OverLeadingComments (Binder e) where
590 |   overLeadingComments k = case _ of
591 |     BinderWildcard a -> BinderWildcard (overLeadingComments k a)
592 |     BinderVar a -> BinderVar (overLeadingComments k a)
593 |     BinderNamed a b c -> BinderNamed (overLeadingComments k a) b c
594 |     BinderConstructor a b -> BinderConstructor (overLeadingComments k a) b
595 |     BinderBoolean a b -> BinderBoolean (overLeadingComments k a) b
596 |     BinderChar a b -> BinderChar (overLeadingComments k a) b
597 |     BinderString a b -> BinderString (overLeadingComments k a) b
598 |     BinderInt (Just a) b c -> BinderInt (Just (overLeadingComments k a)) b c
599 |     BinderInt _ b c -> BinderInt Nothing (overLeadingComments k b) c
600 |     BinderNumber (Just a) b c -> BinderNumber (Just (overLeadingComments k a)) b c
601 |     BinderNumber _ b c -> BinderNumber Nothing (overLeadingComments k b) c
602 |     BinderArray a -> BinderArray (overLeadingComments k a)
603 |     BinderRecord a -> BinderRecord (overLeadingComments k a)
604 |     BinderParens a -> BinderParens (overLeadingComments k a)
605 |     BinderTyped a b c -> BinderTyped (overLeadingComments k a) b c
606 |     BinderOp a b -> BinderOp (overLeadingComments k a) b
607 |     BinderError e -> BinderError (overLeadingComments k e)
608 | 
609 | instance OverLeadingComments (Name a) where
610 |   overLeadingComments k (Name a) = Name $ a { token = overLeadingComments k a.token }
611 | 
612 | instance OverLeadingComments (QualifiedName a) where
613 |   overLeadingComments k (QualifiedName a) = QualifiedName $ a { token = overLeadingComments k a.token }
614 | 
615 | instance OverLeadingComments a => OverLeadingComments (Labeled a b) where
616 |   overLeadingComments k (Labeled a) = Labeled $ a { label = overLeadingComments k a.label }
617 | 
618 | instance OverLeadingComments a => OverLeadingComments (Separated a) where
619 |   overLeadingComments k (Separated { head, tail }) = Separated { head: overLeadingComments k head, tail }
620 | 
621 | instance OverLeadingComments (Wrapped a) where
622 |   overLeadingComments k (Wrapped a) = Wrapped $ a { open = overLeadingComments k a.open }
623 | 
624 | instance OverLeadingComments a => OverLeadingComments (Tuple a b) where
625 |   overLeadingComments k (Tuple a b) = Tuple (overLeadingComments k a) b
626 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen/Common.purs:
--------------------------------------------------------------------------------
  1 | module Tidy.Codegen.Common where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Data.Array.NonEmpty as NonEmptyArray
  6 | import Data.Array.NonEmpty.Internal (NonEmptyArray)
  7 | import Data.Maybe (Maybe(..))
  8 | import Data.Tuple (Tuple(..))
  9 | import PureScript.CST.Types (Delimited, DelimitedNonEmpty, Fixity(..), OneOrDelimited(..), Role(..), Separated(..), SourceRange, SourceStyle(..), SourceToken, Token(..), Wrapped(..))
 10 | 
 11 | zeroRange :: SourceRange
 12 | zeroRange = zero
 13 | 
 14 | toSourceToken :: Token -> SourceToken
 15 | toSourceToken =
 16 |   { range: zeroRange
 17 |   , leadingComments: []
 18 |   , trailingComments: []
 19 |   , value: _
 20 |   }
 21 | 
 22 | tokUnderscore :: SourceToken
 23 | tokUnderscore = toSourceToken TokUnderscore
 24 | 
 25 | tokPipe :: SourceToken
 26 | tokPipe = toSourceToken TokPipe
 27 | 
 28 | tokColon :: SourceToken
 29 | tokColon = toSourceToken (TokOperator Nothing ":")
 30 | 
 31 | tokDoubleColon :: SourceToken
 32 | tokDoubleColon = toSourceToken (TokDoubleColon ASCII)
 33 | 
 34 | tokForall :: SourceToken
 35 | tokForall = toSourceToken (TokForall ASCII)
 36 | 
 37 | tokSymbolArrow :: SourceToken
 38 | tokSymbolArrow = toSourceToken (TokSymbolArrow ASCII)
 39 | 
 40 | tokRightParen :: SourceToken
 41 | tokRightParen = toSourceToken TokRightParen
 42 | 
 43 | tokLeftParen :: SourceToken
 44 | tokLeftParen = toSourceToken TokLeftParen
 45 | 
 46 | tokRightBrace :: SourceToken
 47 | tokRightBrace = toSourceToken TokRightBrace
 48 | 
 49 | tokLeftBrace :: SourceToken
 50 | tokLeftBrace = toSourceToken TokLeftBrace
 51 | 
 52 | tokRightSquare :: SourceToken
 53 | tokRightSquare = toSourceToken TokRightSquare
 54 | 
 55 | tokLeftSquare :: SourceToken
 56 | tokLeftSquare = toSourceToken TokLeftSquare
 57 | 
 58 | tokTick :: SourceToken
 59 | tokTick = toSourceToken TokTick
 60 | 
 61 | tokNegate :: SourceToken
 62 | tokNegate = toSourceToken (TokOperator Nothing "-")
 63 | 
 64 | tokDot :: SourceToken
 65 | tokDot = toSourceToken TokDot
 66 | 
 67 | tokComma :: SourceToken
 68 | tokComma = toSourceToken TokComma
 69 | 
 70 | tokEquals :: SourceToken
 71 | tokEquals = toSourceToken TokEquals
 72 | 
 73 | tokBackslash :: SourceToken
 74 | tokBackslash = toSourceToken TokBackslash
 75 | 
 76 | tokRightArrow :: SourceToken
 77 | tokRightArrow = toSourceToken (TokRightArrow ASCII)
 78 | 
 79 | tokRightFatArrow :: SourceToken
 80 | tokRightFatArrow = toSourceToken (TokRightFatArrow ASCII)
 81 | 
 82 | tokLeftArrow :: SourceToken
 83 | tokLeftArrow = toSourceToken (TokLeftArrow ASCII)
 84 | 
 85 | tokLeftFatArrow :: SourceToken
 86 | tokLeftFatArrow = toSourceToken (TokOperator Nothing "<=")
 87 | 
 88 | tokAt :: SourceToken
 89 | tokAt = toSourceToken TokAt
 90 | 
 91 | tokAll :: SourceToken
 92 | tokAll = toSourceToken (TokSymbolName Nothing "..")
 93 | 
 94 | tokIf :: SourceToken
 95 | tokIf = tokKeyword "if"
 96 | 
 97 | tokThen :: SourceToken
 98 | tokThen = tokKeyword "then"
 99 | 
100 | tokElse :: SourceToken
101 | tokElse = tokKeyword "else"
102 | 
103 | tokCase :: SourceToken
104 | tokCase = tokKeyword "case"
105 | 
106 | tokOf :: SourceToken
107 | tokOf = tokKeyword "of"
108 | 
109 | tokWhere :: SourceToken
110 | tokWhere = tokKeyword "where"
111 | 
112 | tokData :: SourceToken
113 | tokData = tokKeyword "data"
114 | 
115 | tokClass :: SourceToken
116 | tokClass = tokKeyword "class"
117 | 
118 | tokNewtype :: SourceToken
119 | tokNewtype = tokKeyword "newtype"
120 | 
121 | tokType :: SourceToken
122 | tokType = tokKeyword "type"
123 | 
124 | tokInstance :: SourceToken
125 | tokInstance = tokKeyword "instance"
126 | 
127 | tokDerive :: SourceToken
128 | tokDerive = tokKeyword "derive"
129 | 
130 | tokInfix :: SourceToken
131 | tokInfix = tokKeyword "infix"
132 | 
133 | tokInfixl :: SourceToken
134 | tokInfixl = tokKeyword "infixl"
135 | 
136 | tokInfixr :: SourceToken
137 | tokInfixr = tokKeyword "infixr"
138 | 
139 | tokRole :: SourceToken
140 | tokRole = tokKeyword "role"
141 | 
142 | tokRepresentational :: SourceToken
143 | tokRepresentational = tokKeyword "representational"
144 | 
145 | tokPhantom :: SourceToken
146 | tokPhantom = tokKeyword "phantom"
147 | 
148 | tokNominal :: SourceToken
149 | tokNominal = tokKeyword "nominal"
150 | 
151 | tokImport :: SourceToken
152 | tokImport = tokKeyword "import"
153 | 
154 | tokAs :: SourceToken
155 | tokAs = tokKeyword "as"
156 | 
157 | tokDo :: SourceToken
158 | tokDo = tokKeyword "do"
159 | 
160 | tokAdo :: SourceToken
161 | tokAdo = tokKeyword "ado"
162 | 
163 | tokLet :: SourceToken
164 | tokLet = tokKeyword "let"
165 | 
166 | tokIn :: SourceToken
167 | tokIn = tokKeyword "in"
168 | 
169 | tokModule :: SourceToken
170 | tokModule = tokKeyword "module"
171 | 
172 | tokTrue :: SourceToken
173 | tokTrue = tokKeyword "true"
174 | 
175 | tokFalse :: SourceToken
176 | tokFalse = tokKeyword "false"
177 | 
178 | tokForeign :: SourceToken
179 | tokForeign = tokKeyword "foreign"
180 | 
181 | tokHiding :: SourceToken
182 | tokHiding = tokKeyword "hiding"
183 | 
184 | tokKeyword :: String -> SourceToken
185 | tokKeyword = toSourceToken <<< TokLowerName Nothing
186 | 
187 | tokForFixity :: Fixity -> SourceToken
188 | tokForFixity = case _ of
189 |   Infix -> tokInfix
190 |   Infixl -> tokInfixl
191 |   Infixr -> tokInfixr
192 | 
193 | tokForRole :: Role -> SourceToken
194 | tokForRole = case _ of
195 |   Nominal -> tokNominal
196 |   Representational -> tokRepresentational
197 |   Phantom -> tokPhantom
198 | 
199 | toSeparated :: forall a. SourceToken -> NonEmptyArray a -> Separated a
200 | toSeparated tok arr = Separated
201 |   { head: NonEmptyArray.head arr
202 |   , tail: Tuple tok <$> NonEmptyArray.tail arr
203 |   }
204 | 
205 | toOneOrDelimited :: forall a. NonEmptyArray a -> OneOrDelimited a
206 | toOneOrDelimited arr =
207 |   if NonEmptyArray.length arr == 1 then
208 |     One (NonEmptyArray.head arr)
209 |   else
210 |     Many $ Wrapped
211 |       { close: tokRightParen
212 |       , open: tokLeftParen
213 |       , value: toSeparated tokComma arr
214 |       }
215 | 
216 | toDelimitedNonEmpty :: forall a. SourceToken -> SourceToken -> SourceToken -> NonEmptyArray a -> DelimitedNonEmpty a
217 | toDelimitedNonEmpty open close sep value = toWrapped open close (toSeparated sep value)
218 | 
219 | toDelimited :: forall a. SourceToken -> SourceToken -> SourceToken -> Array a -> Delimited a
220 | toDelimited open close sep value = toWrapped open close $ toSeparated sep <$> NonEmptyArray.fromArray value
221 | 
222 | toWrapped :: forall a. SourceToken -> SourceToken -> a -> Wrapped a
223 | toWrapped open close = Wrapped <<< { open, close, value: _ }
224 | 
225 | toParenList :: forall a. NonEmptyArray a -> DelimitedNonEmpty a
226 | toParenList = toDelimitedNonEmpty tokLeftParen tokRightParen tokComma
227 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen/Monad.purs:
--------------------------------------------------------------------------------
  1 | module Tidy.Codegen.Monad
  2 |   ( CodegenState
  3 |   , CodegenT(..)
  4 |   , Codegen
  5 |   , CodegenExport(..)
  6 |   , CodegenImport(..)
  7 |   , ImportName(..)
  8 |   , write
  9 |   , writeAndExport
 10 |   , exportValue
 11 |   , exportOp
 12 |   , exportType
 13 |   , exportTypeAll
 14 |   , exportTypeOp
 15 |   , exportClass
 16 |   , exportModule
 17 |   , exporting
 18 |   , importFrom
 19 |   , importOpen
 20 |   , importValue
 21 |   , importOp
 22 |   , importType
 23 |   , importTypeAll
 24 |   , importTypeOp
 25 |   , importClass
 26 |   , importCtor
 27 |   , codegenModule
 28 |   , runCodegenT
 29 |   , runCodegenTModule
 30 |   , moduleFromCodegenState
 31 |   , class ToImportFrom
 32 |   , toImportFrom
 33 |   , class ToImportFromRecord
 34 |   , toImportFromRecord
 35 |   ) where
 36 | 
 37 | import Prelude
 38 | 
 39 | import Control.Monad.Free (Free, runFree)
 40 | import Control.Monad.ST.Class (class MonadST, liftST)
 41 | import Control.Monad.State (class MonadTrans, StateT, modify_, runStateT, state)
 42 | import Control.Monad.Trans.Class (lift)
 43 | import Control.Monad.Writer (class MonadTell)
 44 | import Data.Array as Array
 45 | import Data.Either (Either(..), either)
 46 | import Data.Foldable (fold, for_, traverse_)
 47 | import Data.Identity (Identity(..))
 48 | import Data.List (List)
 49 | import Data.List as List
 50 | import Data.Map (Map)
 51 | import Data.Map as Map
 52 | import Data.Maybe (Maybe(..))
 53 | import Data.Set (Set)
 54 | import Data.Set as Set
 55 | import Data.Symbol (class IsSymbol)
 56 | import Data.Tuple (Tuple(..), fst, snd)
 57 | import Effect.Class (class MonadEffect, liftEffect)
 58 | import Prim.Row as Row
 59 | import Prim.RowList (class RowToList, RowList)
 60 | import Prim.RowList as RowList
 61 | import PureScript.CST.Types (Declaration(..), Export, Foreign(..), Ident, Import, Labeled(..), Module, ModuleName, Name(..), Operator, Proper, QualifiedName(..))
 62 | import Record as Record
 63 | import Record.Builder (Builder)
 64 | import Record.Builder as Builder
 65 | import Safe.Coerce (coerce)
 66 | import Tidy.Codegen (module_)
 67 | import Tidy.Codegen as Codegen
 68 | import Tidy.Codegen.Class (class ToModuleName, class ToName, class ToToken, toModuleName, toQualifiedName, toToken)
 69 | import Tidy.Codegen.Common (toSourceToken)
 70 | import Tidy.Codegen.Types (Qualified(..), SymbolName)
 71 | import Type.Proxy (Proxy(..))
 72 | 
 73 | data CodegenExport
 74 |   = CodegenExportType Boolean Proper
 75 |   | CodegenExportTypeOp SymbolName
 76 |   | CodegenExportClass Proper
 77 |   | CodegenExportValue Ident
 78 |   | CodegenExportOp SymbolName
 79 |   | CodegenExportModule ModuleName
 80 | 
 81 | derive instance Eq CodegenExport
 82 | derive instance Ord CodegenExport
 83 | 
 84 | data CodegenImport
 85 |   = CodegenImportType Boolean Proper
 86 |   | CodegenImportTypeOp SymbolName
 87 |   | CodegenImportClass Proper
 88 |   | CodegenImportValue Ident
 89 |   | CodegenImportOp SymbolName
 90 | 
 91 | derive instance Eq CodegenImport
 92 | derive instance Ord CodegenImport
 93 | 
 94 | type CodegenState e =
 95 |   { exports :: Set CodegenExport
 96 |   , importsOpen :: Set ModuleName
 97 |   , importsFrom :: Map ModuleName (Set (CodegenImport))
 98 |   , importsQualified :: Map ModuleName (Set ModuleName)
 99 |   , declarations :: List (Declaration e)
100 |   }
101 | 
102 | -- | A Monad transformer which tracks module imports/exports. With this, you
103 | -- | can define codegen procedures in a modular way without having to manually
104 | -- | calculate imports or do post-traversals.
105 | newtype CodegenT e m a = CodegenT (StateT (CodegenState e) m a)
106 | 
107 | derive newtype instance Functor m => Functor (CodegenT e m)
108 | derive newtype instance Monad m => Apply (CodegenT e m)
109 | derive newtype instance Monad m => Applicative (CodegenT e m)
110 | derive newtype instance Monad m => Bind (CodegenT e m)
111 | derive newtype instance Monad m => Monad (CodegenT e m)
112 | derive newtype instance MonadTrans (CodegenT e)
113 | 
114 | instance Monad m => MonadTell (Array (Declaration e)) (CodegenT e m) where
115 |   tell = traverse_ write
116 | 
117 | instance MonadEffect m => MonadEffect (CodegenT e m) where
118 |   liftEffect = lift <<< liftEffect
119 | 
120 | instance (Monad m, MonadST h m) => MonadST h (CodegenT e m) where
121 |   liftST = lift <<< liftST
122 | 
123 | type Codegen e = CodegenT e (Free Identity)
124 | 
125 | -- | Exports a specific reference.
126 | export :: forall e m. Monad m => CodegenExport -> CodegenT e m Unit
127 | export exp = CodegenT $ modify_ \st -> st
128 |   { exports = case exp of
129 |       CodegenExportType false n | Set.member (CodegenExportType true n) st.exports ->
130 |         st.exports
131 |       CodegenExportType true n ->
132 |         Set.insert exp $ Set.delete (CodegenExportType false n) st.exports
133 |       _ ->
134 |         Set.insert exp st.exports
135 |   }
136 | 
137 | -- | Exports a value.
138 | exportValue :: forall e m name. Monad m => ToToken name Ident => name -> CodegenT e m Unit
139 | exportValue = export <<< CodegenExportValue <<< snd <<< toToken
140 | 
141 | -- | Exports an operator.
142 | exportOp :: forall e m name. Monad m => ToToken name SymbolName => name -> CodegenT e m Unit
143 | exportOp = export <<< CodegenExportOp <<< snd <<< toToken
144 | 
145 | -- | Exports a type.
146 | exportType :: forall e m name. Monad m => ToToken name Proper => name -> CodegenT e m Unit
147 | exportType = export <<< CodegenExportType false <<< snd <<< toToken
148 | 
149 | -- | Exports a type with all data members.
150 | exportTypeAll :: forall e m name. Monad m => ToToken name Proper => name -> CodegenT e m Unit
151 | exportTypeAll = export <<< CodegenExportType true <<< snd <<< toToken
152 | 
153 | -- | Exports a type operator.
154 | exportTypeOp :: forall e m name. Monad m => ToToken name SymbolName => name -> CodegenT e m Unit
155 | exportTypeOp = export <<< CodegenExportTypeOp <<< snd <<< toToken
156 | 
157 | -- | Exports a class.
158 | exportClass :: forall e m name. Monad m => ToToken name Proper => name -> CodegenT e m Unit
159 | exportClass = export <<< CodegenExportClass <<< snd <<< toToken
160 | 
161 | -- | Exports a module re-export.
162 | exportModule :: forall e m name. Monad m => ToToken name ModuleName => name -> CodegenT e m Unit
163 | exportModule = export <<< CodegenExportModule <<< snd <<< toToken
164 | 
165 | -- | Writes a declaration to the module.
166 | write :: forall m e. Monad m => Declaration e -> CodegenT e m Unit
167 | write decl = CodegenT $ modify_ \st -> st { declarations = List.Cons decl st.declarations }
168 | 
169 | -- | Writes a declaration and exports it.
170 | writeAndExport :: forall m e. Monad m => Declaration e -> CodegenT e m Unit
171 | writeAndExport decl = do
172 |   write decl
173 |   case decl of
174 |     DeclData { name: Name { name } } Nothing ->
175 |       exportType name
176 |     DeclData { name: Name { name } } (Just _) ->
177 |       exportTypeAll name
178 |     DeclType { name: Name { name } } _ _ ->
179 |       exportType name
180 |     DeclNewtype { name: Name { name } } _ _ _ ->
181 |       exportTypeAll name
182 |     DeclClass { name: Name { name } } members -> do
183 |       exportClass name
184 |       for_ members \(Tuple _ ms) ->
185 |         for_ ms \(Labeled { label: Name { name: label } }) ->
186 |           exportValue label
187 |     DeclKindSignature _ (Labeled { label: Name { name } }) ->
188 |       exportType name
189 |     DeclSignature (Labeled { label: Name { name } }) ->
190 |       exportValue name
191 |     DeclValue { name: Name { name } } ->
192 |       exportValue name
193 |     DeclForeign _ _ (ForeignData _ (Labeled { label: Name { name } })) ->
194 |       exportType name
195 |     DeclForeign _ _ (ForeignValue (Labeled { label: Name { name } })) ->
196 |       exportValue name
197 |     _ ->
198 |       pure unit
199 | 
200 | -- | Exports all declarations written within the provided block.
201 | exporting :: forall e m a. Monad m => CodegenT e m a -> CodegenT e m a
202 | exporting m = do
203 |   old <- CodegenT $ state \st ->
204 |     Tuple st.declarations st { declarations = List.Nil }
205 |   res <- m
206 |   new <- CodegenT $ state \st ->
207 |     Tuple st.declarations st { declarations = old }
208 |   for_ (List.reverse new) writeAndExport
209 |   pure res
210 | 
211 | data ImportName name = ImportName CodegenImport (QualifiedName name)
212 | 
213 | -- | Imports from a particular module, yielding a `QualifiedName` which can be
214 | -- | used with the `Tidy.Codegen` constructors. If the requested import is
215 | -- | qualified, an appropriate qualified import will be generated.
216 | -- |
217 | -- | ```purescript
218 | -- | example = do
219 | -- |   -- Generates a `import Effect.Class.Console as Console` import
220 | -- |   consoleLog <- importFrom "Effect.Class.Console" (importValue "Console.log")
221 | -- |   -- Generates a `import Data.Map (Map)` import
222 | -- |   mapType <- importFrom "Data.Map" (importType "Map")
223 | -- |   -- Group multiple imports with a record
224 | -- |   dataMap <- importFrom "Data.Map"
225 | -- |     { type: importType "Map"
226 | -- |     , lookup: importValue "Map.lookup"
227 | -- |     }
228 | -- |   ...
229 | -- | ```
230 | importFrom
231 |   :: forall e m mod name imp
232 |    . Monad m
233 |   => ToModuleName mod
234 |   => ToImportFrom name imp
235 |   => mod
236 |   -> name
237 |   -> CodegenT e m imp
238 | importFrom mod = toImportFrom \(ImportName imp qn@(QualifiedName { module: mbMod })) ->
239 |   CodegenT $ state \st -> do
240 |     Tuple qn $ case mbMod of
241 |       Nothing -> st
242 |         { importsFrom = Map.alter
243 |             case imp, _ of
244 |               CodegenImportType true n, Just is ->
245 |                 Just $ Set.insert imp $ Set.delete (CodegenImportType false n) is
246 |               CodegenImportType false n, Just is | Set.member (CodegenImportType true n) is ->
247 |                 Just is
248 |               _, Just is ->
249 |                 Just $ Set.insert imp is
250 |               _, Nothing ->
251 |                 Just $ Set.singleton imp
252 |             (toModuleName mod)
253 |             st.importsFrom
254 |         }
255 |       Just qualMod -> st
256 |         { importsQualified = Map.alter
257 |             case _ of
258 |               Nothing -> Just $ Set.singleton qualMod
259 |               Just ms -> Just $ Set.insert qualMod ms
260 |             (toModuleName mod)
261 |             st.importsQualified
262 |         }
263 | 
264 | -- | Imports a module with an open import.
265 | -- |
266 | -- | ```purescript
267 | -- | example = do
268 | -- |   importOpen "Prelude"
269 | -- |   ...
270 | -- | ```
271 | importOpen :: forall e m mod. Monad m => ToModuleName mod => mod -> CodegenT e m Unit
272 | importOpen mod = CodegenT $ modify_ \st ->
273 |   st { importsOpen = Set.insert (toModuleName mod) st.importsOpen }
274 | 
275 | withQualifiedName :: forall from to r. ToToken from (Qualified to) => (to -> QualifiedName to -> r) -> from -> r
276 | withQualifiedName k from = do
277 |   let (Tuple token (Qualified mn name)) = toToken from
278 |   k name (QualifiedName { module: mn, name, token: toSourceToken token })
279 | 
280 | -- | Imports a value. Use with `importFrom`.
281 | importValue :: forall name. ToToken name (Qualified Ident) => name -> ImportName Ident
282 | importValue = withQualifiedName (ImportName <<< CodegenImportValue)
283 | 
284 | -- | Imports a value operator, yield. Use with `importFrom`.
285 | importOp :: forall name. ToToken name (Qualified SymbolName) => name -> ImportName Operator
286 | importOp = withQualifiedName \a b -> ImportName (CodegenImportOp a) (toQualifiedName b)
287 | 
288 | -- | Imports a type operator. Use with `importFrom`.
289 | importTypeOp :: forall name. ToToken name (Qualified SymbolName) => name -> ImportName Operator
290 | importTypeOp = withQualifiedName \a b -> ImportName (CodegenImportTypeOp a) (toQualifiedName b)
291 | 
292 | -- | Imports a class. Use with `importFrom`.
293 | importClass :: forall name. ToToken name (Qualified Proper) => name -> ImportName Proper
294 | importClass = withQualifiedName (ImportName <<< CodegenImportClass)
295 | 
296 | -- | Imports a type. Use with `importFrom`.
297 | importType :: forall name. ToToken name (Qualified Proper) => name -> ImportName Proper
298 | importType = withQualifiedName (ImportName <<< CodegenImportType false)
299 | 
300 | -- | Imports a type. Use with `importFrom`.
301 | importTypeAll :: forall name. ToToken name (Qualified Proper) => name -> ImportName Proper
302 | importTypeAll = withQualifiedName (ImportName <<< CodegenImportType true)
303 | 
304 | -- | Imports a data constructor for a type. Use with `importFrom`.
305 | -- |
306 | -- | ```purescript
307 | -- | example = do
308 | -- |   just <- importFrom "Data.Maybe" (importCtor "Maybe" "Just")
309 | -- | ```
310 | importCtor :: forall ty ctor. ToToken ty Proper => ToToken ctor (Qualified Proper) => ty -> ctor -> ImportName Proper
311 | importCtor = withQualifiedName <<< const <<< ImportName <<< CodegenImportType true <<< snd <<< toToken
312 | 
313 | -- | Extracts codegen state and the produced value.
314 | runCodegenT :: forall m e a. CodegenT e m a -> m (Tuple a (CodegenState e))
315 | runCodegenT (CodegenT m) = runStateT m
316 |   { exports: Set.empty
317 |   , importsOpen: Set.empty
318 |   , importsFrom: Map.empty
319 |   , importsQualified: Map.empty
320 |   , declarations: List.Nil
321 |   }
322 | 
323 | -- | Extracts a CST Module and the produced value.
324 | runCodegenTModule :: forall e m a name. Functor m => ToName name ModuleName => name -> CodegenT e m a -> m (Tuple a (Module e))
325 | runCodegenTModule name = map (map (moduleFromCodegenState name)) <<< runCodegenT
326 | 
327 | -- | Extracts a CST Module.
328 | codegenModule :: forall e name. ToName name ModuleName => name -> Codegen e Unit -> Module e
329 | codegenModule name = snd <<< runFree coerce <<< runCodegenTModule name
330 | 
331 | -- | Constructs a CST Module from codegen state.
332 | moduleFromCodegenState :: forall e name. ToName name ModuleName => name -> CodegenState e -> Module e
333 | moduleFromCodegenState name st = module_ name exports (importsOpen <> importsNamed) decls
334 |   where
335 |   decls =
336 |     st.declarations
337 |       # List.reverse
338 |       # Array.fromFoldable
339 | 
340 |   exports =
341 |     st.exports
342 |       # Array.fromFoldable
343 |       # map codegenExportToCST
344 | 
345 |   importsOpen =
346 |     st.importsOpen
347 |       # Array.fromFoldable
348 |       # map (flip Codegen.declImport [])
349 |       # withLeadingBreaks
350 | 
351 |   importsFrom = do
352 |     Tuple mn imps <- Map.toUnfoldable st.importsFrom
353 |     pure $ Tuple mn $ Codegen.declImport mn $ codegenImportToCST <$> Set.toUnfoldable imps
354 | 
355 |   importsQualified = do
356 |     Tuple mn quals <- Map.toUnfoldable st.importsQualified
357 |     qual <- Set.toUnfoldable quals
358 |     pure $ Tuple mn $ Codegen.declImportAs mn [] qual
359 | 
360 |   importsNamed = withLeadingBreaks do
361 |     (map (map Left) importsFrom <> map (map Right) importsQualified)
362 |       # Array.sortBy (comparing fst)
363 |       # map (either identity identity <<< snd)
364 | 
365 |   withLeadingBreaks =
366 |     fold <<< Array.modifyAt 0 (Codegen.leading (Codegen.lineBreaks 2))
367 | 
368 | codegenExportToCST :: forall e. CodegenExport -> Export e
369 | codegenExportToCST = case _ of
370 |   CodegenExportType all name ->
371 |     if all then Codegen.exportTypeAll name
372 |     else Codegen.exportType name
373 |   CodegenExportTypeOp name -> Codegen.exportTypeOp name
374 |   CodegenExportClass name -> Codegen.exportClass name
375 |   CodegenExportValue name -> Codegen.exportValue name
376 |   CodegenExportOp name -> Codegen.exportOp name
377 |   CodegenExportModule name -> Codegen.exportModule name
378 | 
379 | codegenImportToCST :: forall e. CodegenImport -> Import e
380 | codegenImportToCST = case _ of
381 |   CodegenImportType all name ->
382 |     if all then Codegen.importTypeAll name
383 |     else Codegen.importType name
384 |   CodegenImportTypeOp name -> Codegen.importTypeOp name
385 |   CodegenImportClass name -> Codegen.importClass name
386 |   CodegenImportValue name -> Codegen.importValue name
387 |   CodegenImportOp name -> Codegen.importOp name
388 | 
389 | type ImportResolver f = forall n. ImportName n -> f (QualifiedName n)
390 | 
391 | class ToImportFrom name imp | name -> imp where
392 |   toImportFrom :: forall f. Applicative f => ImportResolver f -> name -> f imp
393 | 
394 | instance ToImportFrom (ImportName name) (QualifiedName name) where
395 |   toImportFrom = ($)
396 | 
397 | instance
398 |   ( RowToList rin rl
399 |   , ToImportFromRecord rl (Record rin) (Record rout)
400 |   ) =>
401 |   ToImportFrom (Record rin) (Record rout) where
402 |   toImportFrom k = map Builder.buildFromScratch <<< toImportFromRecord k (Proxy :: _ rl)
403 | 
404 | class ToImportFromRecord (rl :: RowList Type) rin rout | rl rin -> rout where
405 |   toImportFromRecord :: forall f. Applicative f => ImportResolver f -> Proxy rl -> rin -> f (Builder {} rout)
406 | 
407 | instance
408 |   ( ToImportFrom val imp
409 |   , ToImportFromRecord rest (Record rin) (Record rout')
410 |   , IsSymbol sym
411 |   , Row.Cons sym val rx rin
412 |   , Row.Cons sym imp rout' rout
413 |   , Row.Lacks sym rout'
414 |   ) =>
415 |   ToImportFromRecord (RowList.Cons sym val rest) (Record rin) (Record rout) where
416 |   toImportFromRecord k _ r =
417 |     (\imp builder -> Builder.insert (Proxy :: _ sym) imp <<< builder)
418 |       <$> toImportFrom k (Record.get (Proxy :: _ sym) r)
419 |       <*> toImportFromRecord k (Proxy :: _ rest) r
420 | 
421 | instance ToImportFromRecord (RowList.Nil) (Record rin) {} where
422 |   toImportFromRecord _ _ _ = pure identity
423 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen/Precedence.purs:
--------------------------------------------------------------------------------
  1 | module Tidy.Codegen.Precedence where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Data.Array as Array
  6 | import Data.Array.NonEmpty (NonEmptyArray)
  7 | import Data.Array.NonEmpty as NonEmptyArray
  8 | import Data.Maybe (Maybe(..))
  9 | import PureScript.CST.Types (Binder(..), Expr(..), Type(..))
 10 | import PureScript.CST.Types as CST
 11 | import Tidy.Codegen.Common (toWrapped, tokLeftParen, tokRightParen)
 12 | 
 13 | typeParens :: forall e. CST.Type e -> CST.Type e
 14 | typeParens = TypeParens <<< toWrapped tokLeftParen tokRightParen
 15 | 
 16 | precType0 :: forall e. CST.Type e -> CST.Type e
 17 | precType0 a = case a of
 18 |   TypeKinded _ _ _ -> typeParens a
 19 |   _ -> a
 20 | 
 21 | precType1 :: forall e. CST.Type e -> CST.Type e
 22 | precType1 a = case a of
 23 |   TypeKinded _ _ _ -> typeParens a
 24 |   TypeForall _ _ _ _ -> typeParens a
 25 |   TypeArrow _ _ _ -> typeParens a
 26 |   TypeConstrained _ _ _ -> typeParens a
 27 |   _ -> a
 28 | 
 29 | precType2 :: forall e. CST.Type e -> CST.Type e
 30 | precType2 a = case a of
 31 |   TypeConstrained _ _ _ -> typeParens a
 32 |   TypeForall _ _ _ _ -> typeParens a
 33 |   TypeArrow _ _ _ -> typeParens a
 34 |   TypeKinded _ _ _ -> typeParens a
 35 |   TypeOp _ _ -> typeParens a
 36 |   _ -> a
 37 | 
 38 | precType3 :: forall e. CST.Type e -> CST.Type e
 39 | precType3 a = case a of
 40 |   TypeConstrained _ _ _ -> typeParens a
 41 |   TypeForall _ _ _ _ -> typeParens a
 42 |   TypeArrow _ _ _ -> typeParens a
 43 |   TypeKinded _ _ _ -> typeParens a
 44 |   TypeOp _ _ -> typeParens a
 45 |   TypeApp _ _ -> typeParens a
 46 |   _ -> a
 47 | 
 48 | exprParens :: forall e. Expr e -> Expr e
 49 | exprParens = ExprParens <<< toWrapped tokLeftParen tokRightParen
 50 | 
 51 | precExpr0 :: forall e. Expr e -> Expr e
 52 | precExpr0 a = case a of
 53 |   ExprTyped _ _ _ -> exprParens a
 54 |   _ -> a
 55 | 
 56 | precExpr1 :: forall e. Expr e -> Expr e
 57 | precExpr1 a = case a of
 58 |   ExprTyped _ _ _ -> exprParens a
 59 |   ExprOp _ _ -> exprParens a
 60 |   _ -> a
 61 | 
 62 | precExprInfix :: forall e. Expr e -> Expr e
 63 | precExprInfix a = case a of
 64 |   ExprTyped _ _ _ -> exprParens a
 65 |   ExprOp _ _ -> exprParens a
 66 |   ExprInfix _ _ -> exprParens a
 67 |   _ -> a
 68 | 
 69 | precExpr2 :: forall e. Expr e -> Expr e
 70 | precExpr2 a = case a of
 71 |   ExprTyped _ _ _ -> exprParens a
 72 |   ExprOp _ _ -> exprParens a
 73 |   ExprLambda _ -> exprParens a
 74 |   ExprIf _ -> exprParens a
 75 |   ExprLet _ -> exprParens a
 76 |   ExprAdo _ -> exprParens a
 77 |   _ -> a
 78 | 
 79 | precExpr3 :: forall e. Expr e -> Expr e
 80 | precExpr3 a = case a of
 81 |   ExprTyped _ _ _ -> exprParens a
 82 |   ExprOp _ _ -> exprParens a
 83 |   ExprLambda _ -> exprParens a
 84 |   ExprIf _ -> exprParens a
 85 |   ExprLet _ -> exprParens a
 86 |   ExprAdo _ -> exprParens a
 87 |   ExprInfix _ _ -> exprParens a
 88 |   _ -> a
 89 | 
 90 | precExprApp :: forall e. Expr e -> Expr e
 91 | precExprApp a = case a of
 92 |   ExprTyped _ _ _ -> exprParens a
 93 |   ExprOp _ _ -> exprParens a
 94 |   ExprLambda _ -> exprParens a
 95 |   ExprIf _ -> exprParens a
 96 |   ExprLet _ -> exprParens a
 97 |   ExprAdo _ -> exprParens a
 98 |   ExprInfix _ _ -> exprParens a
 99 |   ExprApp _ _ -> exprParens a
100 |   _ -> a
101 | 
102 | precExprAppLast :: forall e. Expr e -> Expr e
103 | precExprAppLast a = case a of
104 |   ExprTyped _ _ _ -> exprParens a
105 |   ExprOp _ _ -> exprParens a
106 |   ExprInfix _ _ -> exprParens a
107 |   ExprApp _ _ -> exprParens a
108 |   _ -> a
109 | 
110 | precExpr4 :: forall e. Expr e -> Expr e
111 | precExpr4 a = case a of
112 |   ExprTyped _ _ _ -> exprParens a
113 |   ExprOp _ _ -> exprParens a
114 |   ExprLambda _ -> exprParens a
115 |   ExprIf _ -> exprParens a
116 |   ExprLet _ -> exprParens a
117 |   ExprAdo _ -> exprParens a
118 |   ExprInfix _ _ -> exprParens a
119 |   ExprCase _ -> exprParens a
120 |   ExprDo _ -> exprParens a
121 |   _ -> a
122 | 
123 | precExpr5 :: forall e. Expr e -> Expr e
124 | precExpr5 a = case a of
125 |   ExprTyped _ _ _ -> exprParens a
126 |   ExprOp _ _ -> exprParens a
127 |   ExprInfix _ _ -> exprParens a
128 |   ExprNegate _ _ -> exprParens a
129 |   ExprApp _ _ -> exprParens a
130 |   _ -> a
131 | 
132 | precExpr6 :: forall e. Expr e -> Expr e
133 | precExpr6 a = case a of
134 |   ExprTyped _ _ _ -> exprParens a
135 |   ExprOp _ _ -> exprParens a
136 |   ExprInfix _ _ -> exprParens a
137 |   ExprNegate _ _ -> exprParens a
138 |   ExprApp _ _ -> exprParens a
139 |   ExprLambda _ -> exprParens a
140 |   ExprIf _ -> exprParens a
141 |   ExprCase _ -> exprParens a
142 |   ExprLet _ -> exprParens a
143 |   ExprDo _ -> exprParens a
144 |   ExprAdo _ -> exprParens a
145 |   _ -> a
146 | 
147 | precExpr7 :: forall e. Expr e -> Expr e
148 | precExpr7 a = case a of
149 |   ExprTyped _ _ _ -> exprParens a
150 |   ExprOp _ _ -> exprParens a
151 |   ExprInfix _ _ -> exprParens a
152 |   ExprNegate _ _ -> exprParens a
153 |   ExprApp _ _ -> exprParens a
154 |   ExprLambda _ -> exprParens a
155 |   ExprIf _ -> exprParens a
156 |   ExprCase _ -> exprParens a
157 |   ExprLet _ -> exprParens a
158 |   ExprDo _ -> exprParens a
159 |   ExprAdo _ -> exprParens a
160 |   ExprRecordAccessor _ -> exprParens a
161 |   ExprRecordUpdate _ _ -> exprParens a
162 |   _ -> a
163 | 
164 | binderParens :: forall e. Binder e -> Binder e
165 | binderParens = BinderParens <<< toWrapped tokLeftParen tokRightParen
166 | 
167 | precBinder0 :: forall e. Binder e -> Binder e
168 | precBinder0 a = case a of
169 |   BinderTyped _ _ _ -> binderParens a
170 |   _ -> a
171 | 
172 | precBinder1 :: forall e. Binder e -> Binder e
173 | precBinder1 a = case a of
174 |   BinderTyped _ _ _ -> binderParens a
175 |   BinderOp _ _ -> binderParens a
176 |   _ -> a
177 | 
178 | precBinder2 :: forall e. Binder e -> Binder e
179 | precBinder2 a = case a of
180 |   BinderTyped _ _ _ -> binderParens a
181 |   BinderOp _ _ -> binderParens a
182 |   BinderInt (Just _) _ _ -> binderParens a
183 |   BinderNumber (Just _) _ _ -> binderParens a
184 |   BinderConstructor _ args | not $ Array.null args -> binderParens a
185 |   _ -> a
186 | 
187 | precInitLast :: forall a b. (a -> b) -> (a -> b) -> Array a -> Maybe (NonEmptyArray b)
188 | precInitLast p1 p2 = Array.unsnoc >>> map \{ init, last } ->
189 |   NonEmptyArray.snoc' (p1 <$> init) (p2 last)
190 | 
191 | precInitLast1 :: forall a b. (a -> b) -> (a -> b) -> NonEmptyArray a -> NonEmptyArray b
192 | precInitLast1 p1 p2 arr = do
193 |   let { init, last } = NonEmptyArray.unsnoc arr
194 |   NonEmptyArray.snoc' (p1 <$> init) (p2 last)
195 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen/String.purs:
--------------------------------------------------------------------------------
 1 | module Tidy.Codegen.String where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Data.Array as Array
 6 | import Data.CodePoint.Unicode (GeneralCategory(..), generalCategory)
 7 | import Data.Enum (fromEnum)
 8 | import Data.Int as Int
 9 | import Data.Maybe (maybe)
10 | import Data.Monoid (power)
11 | import Data.Set (Set)
12 | import Data.Set as Set
13 | import Data.String (CodePoint, codePointFromChar)
14 | import Data.String as String
15 | import Data.String.CodeUnits as SCU
16 | import Tidy.Codegen.Types (SourceString(..))
17 | 
18 | escapeSourceString :: String -> SourceString
19 | escapeSourceString = SourceString <<< Array.foldMap escape <<< String.toCodePointArray
20 |   where
21 |   escape :: CodePoint -> String
22 |   escape cp
23 |     | cp == codePointFromChar '\n' = "\\n"
24 |     | cp == codePointFromChar '\r' = "\\r"
25 |     | cp == codePointFromChar '\t' = "\\t"
26 |     | cp == codePointFromChar '\\' = "\\\\"
27 |     | cp == codePointFromChar '"' = "\\\""
28 |     | shouldPrint cp = String.singleton cp
29 |     | otherwise = "\\x" <> toHex cp
30 | 
31 |   toHex :: CodePoint -> String
32 |   toHex cp = do
33 |     let hex = Int.toStringAs Int.hexadecimal (fromEnum cp)
34 |     power "0" (6 - SCU.length hex) <> hex
35 | 
36 |   shouldPrint :: CodePoint -> Boolean
37 |   shouldPrint = maybe false (flip Set.member categories) <<< generalCategory
38 | 
39 |   categories :: Set GeneralCategory
40 |   categories = Set.fromFoldable
41 |     [ UppercaseLetter
42 |     , LowercaseLetter
43 |     , TitlecaseLetter
44 |     , OtherLetter
45 |     , DecimalNumber
46 |     , LetterNumber
47 |     , OtherNumber
48 |     , ConnectorPunctuation
49 |     , DashPunctuation
50 |     , OpenPunctuation
51 |     , ClosePunctuation
52 |     , InitialQuote
53 |     , FinalQuote
54 |     , OtherPunctuation
55 |     , MathSymbol
56 |     , CurrencySymbol
57 |     , ModifierSymbol
58 |     , OtherSymbol
59 |     , Space
60 |     ]
61 | 
62 | 


--------------------------------------------------------------------------------
/src/Tidy/Codegen/Types.purs:
--------------------------------------------------------------------------------
 1 | module Tidy.Codegen.Types where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Data.Array.NonEmpty (NonEmptyArray)
 6 | import Data.Maybe (Maybe)
 7 | import Data.Newtype (class Newtype)
 8 | import Data.Tuple (Tuple)
 9 | import PureScript.CST.Types (Ident, Labeled, ModuleName, Name, Operator, PatternGuard, QualifiedName, Where)
10 | import PureScript.CST.Types as CST
11 | 
12 | newtype SymbolName = SymbolName String
13 | 
14 | derive instance Newtype SymbolName _
15 | derive newtype instance Eq SymbolName
16 | derive newtype instance Ord SymbolName
17 | 
18 | data Qualified a = Qualified (Maybe ModuleName) a
19 | 
20 | derive instance Functor Qualified
21 | 
22 | unQualified :: forall a. Qualified a -> a
23 | unQualified (Qualified _ a) = a
24 | 
25 | newtype BinaryOp a = BinaryOp (Tuple (QualifiedName Operator) a)
26 | 
27 | derive newtype instance Functor BinaryOp
28 | 
29 | data GuardedBranch e = GuardedBranch (NonEmptyArray (PatternGuard e)) (Where e)
30 | 
31 | type ClassMember e = Labeled (Name Ident) (CST.Type e)
32 | 
33 | newtype SourceString = SourceString String
34 | 
35 | derive instance Newtype SourceString _
36 | derive newtype instance Eq SourceString
37 | derive newtype instance Ord SourceString
38 | 


--------------------------------------------------------------------------------
/test/GenerateExamples.purs:
--------------------------------------------------------------------------------
  1 | module Test.GenerateExamples where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Data.Array as Array
  6 | import Data.Array.NonEmpty (NonEmptyArray)
  7 | import Data.Array.NonEmpty as NonEmptyArray
  8 | import Data.Either (Either(..))
  9 | import Data.Filterable (partitionMap)
 10 | import Data.Foldable (foldMap, sequence_)
 11 | import Data.Maybe (Maybe(..), isJust)
 12 | import Data.Newtype (unwrap)
 13 | import Data.String as String
 14 | import Data.Traversable (for, sequence)
 15 | import Data.Tuple (Tuple(..))
 16 | import Partial.Unsafe (unsafePartial)
 17 | import PureScript.CST (RecoveredParserResult(..), parseDecl, parseModule)
 18 | import PureScript.CST.Parser.Monad (PositionedError)
 19 | import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapExpr)
 20 | import PureScript.CST.Types (Comment(..), Declaration(..), Expr(..), Guarded(..), Ident(..), Labeled(..), Module(..), ModuleBody(..), ModuleName, Name(..), Where(..))
 21 | import Tidy.Codegen (declSignature, declValue, exprApp, exprArray, exprIdent, exprString, leading, printModule, typeApp, typeCtor)
 22 | import Tidy.Codegen.Monad (codegenModule, importCtor, importFrom, importOpen, importType, importTypeAll, importValue, write)
 23 | 
 24 | data GenerateError = ExampleParseError String PositionedError
 25 | 
 26 | data ExampleType = ExampleDecl | ExampleType | ExampleExpr
 27 | 
 28 | generateExamplesModule :: ModuleName -> String -> Either (NonEmptyArray GenerateError) String
 29 | generateExamplesModule modName src = case parseModule src of
 30 |   ParseSucceededWithErrors _ errors ->
 31 |     Left $ map (ExampleParseError "<file>") errors
 32 |   ParseFailed error ->
 33 |     Left $ pure $ ExampleParseError "<file>" error
 34 |   ParseSucceeded (Module { body: ModuleBody { decls } }) -> do
 35 |     let { left, right } = partitionMap sequence declExamples
 36 |     case NonEmptyArray.fromArray left of
 37 |       Just errors ->
 38 |         Left $ NonEmptyArray.fold1 errors
 39 |       Nothing -> do
 40 |         let
 41 |           codegenHeader = map Comment
 42 |             [ "------------------------------------"
 43 |             , "-- This module is code generated. --"
 44 |             , "--          DO NOT EDIT!          --"
 45 |             , "------------------------------------"
 46 |             ]
 47 | 
 48 |         Right $ printModule $ leading codegenHeader $ unsafePartial $ codegenModule modName do
 49 |           _ <- importOpen "Prelude"
 50 |           _ <- importFrom "Data.Tuple" (importCtor "Tuple" "Tuple")
 51 |           _ <- importFrom "Data.Maybe" (importCtor "Maybe" "Just")
 52 |           typeEffect <- importFrom "Effect" (importType "Effect")
 53 |           exprLog <- importFrom "Test.Util" (importValue "log")
 54 |           exprUnsafePartial <- importFrom "Partial.Unsafe" (importValue "unsafePartial")
 55 |           typeModule <- importFrom "PureScript.CST.Types" (importType "Module")
 56 |           _ <- importFrom "PureScript.CST.Types" (importTypeAll "Fixity")
 57 |           exprPrintModule <- importFrom "Tidy.Codegen" (importValue "printModule")
 58 |           exprModule <- importFrom "Tidy.Codegen" (importValue "module_")
 59 |           examples <- for right \(Tuple (Ident ident) (Tuple exampleType expr)) -> do
 60 |             let
 61 |               imports :: Array _
 62 |               imports = expr # foldMapExpr defaultMonoidalVisitor
 63 |                 { onExpr = case _ of
 64 |                     ExprIdent qual ->
 65 |                       pure $ importFrom "Tidy.Codegen" (importValue qual)
 66 |                     _ ->
 67 |                       mempty
 68 |                 }
 69 |             sequence_ imports
 70 |             case exampleType of
 71 |               ExampleDecl ->
 72 |                 pure expr
 73 |               ExampleType -> do
 74 |                 exprDeclType <- importFrom "Tidy.Codegen" (importValue "declType")
 75 |                 pure $ exprApp (exprIdent exprDeclType)
 76 |                   [ exprString (String.toUpper (String.take 1 ident) <> String.drop 1 ident <> "Example")
 77 |                   , exprArray []
 78 |                   , expr
 79 |                   ]
 80 |               ExampleExpr -> do
 81 |                 exprDeclValue <- importFrom "Tidy.Codegen" (importValue "declValue")
 82 |                 pure $ exprApp (exprIdent exprDeclValue)
 83 |                   [ exprString (ident <> "Example")
 84 |                   , exprArray []
 85 |                   , expr
 86 |                   ]
 87 | 
 88 |           write $ declSignature "test" (typeApp (typeCtor typeModule) [ typeCtor "Void" ])
 89 |           write $ declValue "test" [] do
 90 |             exprApp (exprIdent exprUnsafePartial)
 91 |               [ exprApp (exprIdent exprModule)
 92 |                   [ exprString (unwrap modName)
 93 |                   , exprArray []
 94 |                   , exprArray []
 95 |                   , exprArray examples
 96 |                   ]
 97 |               ]
 98 | 
 99 |           write $ declSignature "main" (typeApp (typeCtor typeEffect) [ typeCtor "Unit" ])
100 |           write $ declValue "main" [] do
101 |             exprApp (exprIdent exprLog)
102 |               [ exprApp (exprIdent exprPrintModule)
103 |                   [ exprIdent "test"
104 |                   ]
105 |               ]
106 |     where
107 |     declExamples :: Array _
108 |     declExamples = decls # foldMap case _ of
109 |       DeclSignature (Labeled { label: Name { name, token: { leadingComments } } }) ->
110 |         foldMap pure do
111 |           ix1 <- Array.findIndex isExampleStart leadingComments
112 |           ix2 <- Array.findLastIndex isExampleEnd leadingComments
113 |           let
114 |             exampleSrc =
115 |               leadingComments
116 |                 # Array.slice (ix1 + 1) ix2
117 |                 # Array.mapMaybe lineComment
118 |                 # String.joinWith "\n"
119 | 
120 |           Tuple name <$> case parseDecl exampleSrc of
121 |             ParseSucceededWithErrors _ errors ->
122 |               pure $ Left $ map (ExampleParseError (unwrap name)) errors
123 |             ParseFailed error ->
124 |               pure $ Left $ pure $ ExampleParseError (unwrap name) error
125 |             ParseSucceeded
126 |               ( DeclValue
127 |                   { name: Name { name: Ident exampleName }
128 |                   , binders: []
129 |                   , guarded: Unconditional _ (Where { bindings: Nothing, expr })
130 |                   }
131 |               )
132 |               | Just exampleType <- exampleTypeFromString exampleName ->
133 |                   pure $ Right $ Tuple exampleType expr
134 |             _ ->
135 |               Nothing
136 |       _ ->
137 |         mempty
138 | 
139 |     isExampleStart = case _ of
140 |       Comment str ->
141 |         startsWith (String.Pattern "-- | ```purescript") str
142 |       _ -> false
143 | 
144 |     isExampleEnd = case _ of
145 |       Comment str ->
146 |         startsWith (String.Pattern "-- | ```") str
147 |       _ -> false
148 | 
149 |     lineComment = case _ of
150 |       Comment str ->
151 |         String.stripPrefix (String.Pattern "-- | ") str
152 |       _ -> Nothing
153 | 
154 |     startsWith p =
155 |       isJust <<< String.stripPrefix p
156 | 
157 |     exampleTypeFromString = case _ of
158 |       "exampleDecl" -> Just ExampleDecl
159 |       "exampleType" -> Just ExampleType
160 |       "exampleExpr" -> Just ExampleExpr
161 |       _ -> Nothing
162 | 


--------------------------------------------------------------------------------
/test/Main.purs:
--------------------------------------------------------------------------------
 1 | module Test.Main where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Ansi.Output (foreground, withGraphics)
 6 | import Data.Either (Either(..))
 7 | import Data.Foldable (any, findMap, for_)
 8 | import Data.Maybe (Maybe(..))
 9 | import Data.String (Pattern(..))
10 | import Data.String as String
11 | import Dodo.Ansi (Color(..))
12 | import Effect (Effect)
13 | import Effect.Aff (launchAff_)
14 | import Effect.Class (liftEffect)
15 | import Effect.Class.Console as Console
16 | import Effect.Exception as Error
17 | import Node.Encoding (Encoding(..))
18 | import Node.FS.Aff as FS
19 | import Node.Path as Path
20 | import Node.Process as Process
21 | import PureScript.CST.Errors (printParseError)
22 | import PureScript.CST.Types (ModuleName(..))
23 | import Test.GenerateExamples (GenerateError(..), generateExamplesModule)
24 | import Test.Snapshot (SnapshotResult(..), isBad, snapshotMainOutput)
25 | 
26 | main :: Effect Unit
27 | main = do
28 |   args <- Process.argv
29 |   let accept = any (eq "--accept" || eq "-a") args
30 |   let printOutput = any (eq "--print-output" || eq "-p") args
31 |   let filter = Pattern <$> findMap (String.stripPrefix (Pattern "--filter=")) args
32 |   let gen = findMap (String.stripPrefix (Pattern "--generate=")) args
33 |   launchAff_ case gen of
34 |     Just arg ->
35 |       case String.split (Pattern ":") arg of
36 |         [ path, name ] -> do
37 |           currentDir <- liftEffect Process.cwd
38 |           fullPath <- liftEffect $ Path.resolve [ currentDir ] path
39 |           contents <- FS.readTextFile UTF8 fullPath
40 |           case generateExamplesModule (ModuleName name) contents of
41 |             Right exampleContents -> do
42 |               FS.writeTextFile UTF8 (Path.concat [ ".", "test", "snapshots", name <> ".purs" ]) exampleContents
43 |             Left errs -> do
44 |               for_ errs \(ExampleParseError field err) ->
45 |                 Console.error $ field <> ":" <> printParseError err.error
46 |               liftEffect $ Process.setExitCode 1
47 |         _ -> do
48 |           Console.error $ "Invalid generate argument: " <> arg
49 |           liftEffect $ Process.setExitCode 1
50 |     Nothing -> do
51 |       results <- snapshotMainOutput "./test/snapshots" accept filter
52 |       for_ results \{ name, output, result } -> case result of
53 |         Passed -> do
54 |           Console.log $ withGraphics (foreground Green) "✓" <> " " <> name <> " passed."
55 |           when printOutput $ Console.log output
56 |         Saved -> do
57 |           Console.log $ withGraphics (foreground Yellow) "✓" <> " " <> name <> " saved."
58 |           when printOutput $ Console.log output
59 |         Accepted -> do
60 |           Console.log $ withGraphics (foreground Yellow) "✓" <> " " <> name <> " accepted."
61 |           when printOutput $ Console.log output
62 |         Failed diff -> do
63 |           Console.log $ withGraphics (foreground Red) "✗" <> " " <> name <> " failed."
64 |           Console.log diff
65 |           when printOutput $ Console.log output
66 |         ErrorRunningTest err -> do
67 |           Console.log $ withGraphics (foreground Red) "✗" <> " " <> name <> " failed due to an error."
68 |           Console.log $ Error.message err
69 |       when (any (isBad <<< _.result) results) do
70 |         liftEffect $ Process.setExitCode 1
71 | 


--------------------------------------------------------------------------------
/test/Snapshot.purs:
--------------------------------------------------------------------------------
  1 | module Test.Snapshot where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Control.Alternative (guard)
  6 | import Control.Parallel (parTraverse)
  7 | import Data.Array (mapMaybe)
  8 | import Data.Array as Array
  9 | import Data.Either (Either(..))
 10 | import Data.Foldable (for_)
 11 | import Data.Maybe (Maybe(..))
 12 | import Data.Posix.Signal (Signal(..))
 13 | import Data.String (Pattern(..))
 14 | import Data.String as String
 15 | import Data.String.CodeUnits (stripSuffix)
 16 | import Effect (Effect)
 17 | import Effect.AVar as EffectAVar
 18 | import Effect.Aff (Aff, Error, catchError, effectCanceler, makeAff, throwError, try)
 19 | import Effect.Aff.AVar as AVar
 20 | import Effect.Class (liftEffect)
 21 | import Node.Buffer (Buffer, freeze)
 22 | import Node.Buffer as Buffer
 23 | import Node.Buffer.Immutable as ImmutableBuffer
 24 | import Node.ChildProcess (ExecResult)
 25 | import Node.ChildProcess as ChildProcess
 26 | import Node.Encoding (Encoding(..))
 27 | import Node.Errors.SystemError as SystemError
 28 | import Node.FS.Aff (readFile, readdir, writeFile)
 29 | import Node.Path (basename)
 30 | import Node.Path as Path
 31 | import Node.Stream as Stream
 32 | 
 33 | data SnapshotResult
 34 |   = Passed
 35 |   | Saved
 36 |   | Accepted
 37 |   | Failed String
 38 |   | ErrorRunningTest Error
 39 | 
 40 | type SnapshotTest =
 41 |   { name :: String
 42 |   , output :: String
 43 |   , result :: SnapshotResult
 44 |   }
 45 | 
 46 | isBad :: SnapshotResult -> Boolean
 47 | isBad = case _ of
 48 |   Failed _ -> true
 49 |   ErrorRunningTest _ -> true
 50 |   _ -> false
 51 | 
 52 | snapshotMainOutput :: String -> Boolean -> Maybe Pattern -> Aff (Array SnapshotTest)
 53 | snapshotMainOutput directory accept mbPattern = do
 54 |   paths <- readdir directory
 55 |   block <- AVar.empty
 56 |   for_ (Array.range 1 4) \_ -> do
 57 |     liftEffect $ EffectAVar.put unit block mempty
 58 |   flip parTraverse (pursPaths paths) \name -> do
 59 |     AVar.take block
 60 |     result <- runSnapshot name
 61 |     _ <- liftEffect $ EffectAVar.put unit block mempty
 62 |     pure result
 63 |   where
 64 |   pursPaths =
 65 |     mapMaybe (filterPath <=< stripSuffix (Pattern ".purs") <<< basename)
 66 | 
 67 |   filterPath = case mbPattern of
 68 |     Just pat -> \path -> guard (String.contains pat path) $> path
 69 |     Nothing -> pure
 70 | 
 71 |   makeErrorResult :: String -> Error -> Aff SnapshotTest
 72 |   makeErrorResult name err = pure { name, output: "", result: ErrorRunningTest err }
 73 | 
 74 |   runSnapshot :: String -> Aff SnapshotTest
 75 |   runSnapshot name = flip catchError (makeErrorResult name) do
 76 |     result <- exec $ "node --input-type=module -e 'import { main } from \"./output/" <> name <> "/index.js\";main()'"
 77 |     case result of
 78 |       { error: Just err } ->
 79 |         throwError (SystemError.toError err)
 80 |       { stdout } -> do
 81 |         output <- liftEffect $ bufferToUTF8 stdout
 82 |         let
 83 |           outputFile = Path.concat [ directory, name <> ".output" ]
 84 |           acceptOutput = do
 85 |             writeFile outputFile =<< liftEffect (Buffer.fromString output UTF8)
 86 |         savedOutput <- try $ readFile outputFile
 87 |         case savedOutput of
 88 |           Left _ -> do
 89 |             acceptOutput
 90 |             pure { name, output, result: Saved }
 91 |           Right buffer -> do
 92 |             savedOutput' <- liftEffect $ bufferToUTF8 buffer
 93 |             if output == savedOutput' then
 94 |               pure { name, output, result: Passed }
 95 |             else if accept then do
 96 |               acceptOutput
 97 |               pure { name, output, result: Accepted }
 98 |             else do
 99 |               { stdout: diffOutput } <- execWithStdin ("diff " <> outputFile <> " -") output
100 |               diffOutput' <- liftEffect $ bufferToUTF8 diffOutput
101 |               pure { name, output, result: Failed diffOutput' }
102 | 
103 | exec :: String -> Aff ExecResult
104 | exec command = makeAff \k -> do
105 |   childProc <- ChildProcess.exec' command identity (k <<< pure)
106 |   pure $ effectCanceler $ void $ ChildProcess.killSignal SIGABRT childProc
107 | 
108 | execWithStdin :: String -> String -> Aff ExecResult
109 | execWithStdin command input = makeAff \k -> do
110 |   childProc <- ChildProcess.exec' command identity (k <<< pure)
111 |   _ <- Stream.writeString (ChildProcess.stdin childProc) UTF8 input
112 |   Stream.end (ChildProcess.stdin childProc)
113 |   pure $ effectCanceler $ void $ ChildProcess.killSignal SIGABRT childProc
114 | 
115 | bufferToUTF8 :: Buffer -> Effect String
116 | bufferToUTF8 = map (ImmutableBuffer.toString UTF8) <<< freeze
117 | 


--------------------------------------------------------------------------------
/test/Util.purs:
--------------------------------------------------------------------------------
 1 | module Test.Util where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Effect (Effect)
 6 | import Node.Encoding (Encoding(..))
 7 | import Node.Process as Process
 8 | import Node.Stream (writeString)
 9 | 
10 | log :: String -> Effect Unit
11 | log = void <<< writeString Process.stdout UTF8
12 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenBinders.output:
--------------------------------------------------------------------------------
 1 | module Test.Binders where
 2 | 
 3 | lamBinderNegInt = \(-3) -> true
 4 | lamBinderNegNum = \(-3.0) -> true
 5 | lamBinderVar = \a -> true
 6 | lamBinderCtor0 = \Constructor -> true
 7 | lamBinderCtor1BinderNegInt = \(Constructor (-3)) -> true
 8 | lamBinderCtor1BinderNegNum = \(Constructor (-3.0)) -> true
 9 | lamBinderCtor1BinderVar = \(Constructor a) -> true
10 | lamBinderCtor1BinderCtor0 = \(Constructor Constructor) -> true
11 | lamBinderCtor1BinderCtor1 = \(Constructor (Constructor a)) -> true
12 | lamBinderCtor1BinderNamed = \(Constructor x@a) -> true
13 | lamBinderCtor1BinderOp = \(Constructor (a /\ b)) -> true
14 | lamBinderCtor1BinderTyped = \(Constructor (a :: Type)) -> true
15 | lamBinderNamedBinderNegInt = \x@(-3) -> true
16 | lamBinderNamedBinderNegNum = \x@(-3.0) -> true
17 | lamBinderNamedBinderVar = \x@a -> true
18 | lamBinderNamedBinderCtor0 = \x@Constructor -> true
19 | lamBinderNamedBinderCtor1 = \x@(Constructor a) -> true
20 | lamBinderNamedBinderOp = \x@(a /\ b) -> true
21 | lamBinderNamedBinderTyped = \x@(a :: Type) -> true
22 | lamBinderTyped = \(a :: Type) -> true
23 | lamBinderOp = \(a /\ b) -> true
24 | caseBinderNegInt = case _ of -3 -> true
25 | caseBinderNegNum = case _ of -3.0 -> true
26 | caseBinderVar = case _ of a -> true
27 | caseBinderCtor0 = case _ of Constructor -> true
28 | caseBinderCtor1BinderNegInt = case _ of Constructor (-3) -> true
29 | caseBinderCtor1BinderNegNum = case _ of Constructor (-3.0) -> true
30 | caseBinderCtor1BinderVar = case _ of Constructor a -> true
31 | caseBinderCtor1BinderCtor0 = case _ of Constructor Constructor -> true
32 | caseBinderCtor1BinderCtor1 = case _ of Constructor (Constructor a) -> true
33 | caseBinderCtor1BinderNamed = case _ of Constructor x@a -> true
34 | caseBinderCtor1BinderOp = case _ of Constructor (a /\ b) -> true
35 | caseBinderCtor1BinderTyped = case _ of Constructor (a :: Type) -> true
36 | caseBinderNamedBinderNegInt = case _ of x@(-3) -> true
37 | caseBinderNamedBinderNegNum = case _ of x@(-3.0) -> true
38 | caseBinderNamedBinderVar = case _ of x@a -> true
39 | caseBinderNamedBinderCtor0 = case _ of x@Constructor -> true
40 | caseBinderNamedBinderCtor1 = case _ of x@(Constructor a) -> true
41 | caseBinderNamedBinderOp = case _ of x@(a /\ b) -> true
42 | caseBinderNamedBinderTyped = case _ of x@(a :: Type) -> true
43 | caseBinderTyped = case _ of (a :: Type) -> true
44 | caseBinderOp = case _ of a /\ b -> true
45 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenBinders.purs:
--------------------------------------------------------------------------------
  1 | module CodegenBinders where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Effect (Effect)
  6 | import Partial.Unsafe (unsafePartial)
  7 | import PureScript.CST.Types (Module)
  8 | import Test.Util (log)
  9 | import Tidy.Codegen (binaryOp, binderCtor, binderInt, binderNamed, binderNumber, binderOp, binderTyped, binderVar, caseBranch, declValue, exprBool, exprCase, exprLambda, exprSection, module_, printModule, typeCtor)
 10 | 
 11 | test :: Module Void
 12 | test = unsafePartial do
 13 |   let
 14 |     bNegInt = binderInt (-3)
 15 |     bNegNum = binderNumber (-3.0)
 16 |     bVarA = binderVar "a"
 17 |     bVarB = binderVar "b"
 18 |     bTyped = binderTyped bVarA (typeCtor "Type")
 19 |     bNamed arg = binderNamed "x" arg
 20 |     bCtor0 = binderCtor "Constructor" []
 21 |     bCtor1 bArg = binderCtor "Constructor" [ bArg ]
 22 |     bOp l r = binderOp l [ binaryOp "/\\" r ]
 23 |     eBool = exprBool true
 24 |   module_ "Test.Binders" [] []
 25 |     [ declValue "lamBinderNegInt" [] do
 26 |         exprLambda [ bNegInt ] eBool
 27 |     , declValue "lamBinderNegNum" [] do
 28 |         exprLambda [ bNegNum ] eBool
 29 |     , declValue "lamBinderVar" [] do
 30 |         exprLambda [ bVarA ] eBool
 31 |     , declValue "lamBinderCtor0" [] do
 32 |         exprLambda [ bCtor0 ] eBool
 33 |     , declValue "lamBinderCtor1BinderNegInt" [] do
 34 |         exprLambda [ bCtor1 bNegInt ] eBool
 35 |     , declValue "lamBinderCtor1BinderNegNum" [] do
 36 |         exprLambda [ bCtor1 bNegNum ] eBool
 37 |     , declValue "lamBinderCtor1BinderVar" [] do
 38 |         exprLambda [ bCtor1 bVarA ] eBool
 39 |     , declValue "lamBinderCtor1BinderCtor0" [] do
 40 |         exprLambda [ bCtor1 $ bCtor0 ] eBool
 41 |     , declValue "lamBinderCtor1BinderCtor1" [] do
 42 |         exprLambda [ bCtor1 $ bCtor1 bVarA ] eBool
 43 |     , declValue "lamBinderCtor1BinderNamed" [] do
 44 |         exprLambda [ bCtor1 $ bNamed bVarA ] eBool
 45 |     , declValue "lamBinderCtor1BinderOp" [] do
 46 |         exprLambda [ bCtor1 $ bOp bVarA bVarB ] eBool
 47 |     , declValue "lamBinderCtor1BinderTyped" [] do
 48 |         exprLambda [ bCtor1 bTyped ] eBool
 49 |     , declValue "lamBinderNamedBinderNegInt" [] do
 50 |         exprLambda [ bNamed bNegInt ] eBool
 51 |     , declValue "lamBinderNamedBinderNegNum" [] do
 52 |         exprLambda [ bNamed bNegNum ] eBool
 53 |     , declValue "lamBinderNamedBinderVar" [] do
 54 |         exprLambda [ bNamed bVarA ] eBool
 55 |     , declValue "lamBinderNamedBinderCtor0" [] do
 56 |         exprLambda [ bNamed bCtor0 ] eBool
 57 |     , declValue "lamBinderNamedBinderCtor1" [] do
 58 |         exprLambda [ bNamed $ bCtor1 bVarA ] eBool
 59 |     , declValue "lamBinderNamedBinderOp" [] do
 60 |         exprLambda [ bNamed $ bOp bVarA bVarB ] eBool
 61 |     , declValue "lamBinderNamedBinderTyped" [] do
 62 |         exprLambda [ bNamed bTyped ] eBool
 63 |     , declValue "lamBinderTyped" [] do
 64 |         exprLambda [ bTyped ] eBool
 65 |     , declValue "lamBinderOp" [] do
 66 |         exprLambda [ bOp bVarA bVarB ] eBool
 67 |     , declValue "caseBinderNegInt" [] do
 68 |         exprCase [ exprSection ]
 69 |           [ caseBranch [ bNegInt ] eBool
 70 |           ]
 71 |     , declValue "caseBinderNegNum" [] do
 72 |         exprCase [ exprSection ]
 73 |           [ caseBranch [ bNegNum ] eBool
 74 |           ]
 75 |     , declValue "caseBinderVar" [] do
 76 |         exprCase [ exprSection ]
 77 |           [ caseBranch [ bVarA ] eBool
 78 |           ]
 79 |     , declValue "caseBinderCtor0" [] do
 80 |         exprCase [ exprSection ]
 81 |           [ caseBranch [ bCtor0 ] eBool
 82 |           ]
 83 |     , declValue "caseBinderCtor1BinderNegInt" [] do
 84 |         exprCase [ exprSection ]
 85 |           [ caseBranch [ bCtor1 bNegInt ] eBool
 86 |           ]
 87 |     , declValue "caseBinderCtor1BinderNegNum" [] do
 88 |         exprCase [ exprSection ]
 89 |           [ caseBranch [ bCtor1 bNegNum ] eBool
 90 |           ]
 91 |     , declValue "caseBinderCtor1BinderVar" [] do
 92 |         exprCase [ exprSection ]
 93 |           [ caseBranch [ bCtor1 bVarA ] eBool
 94 |           ]
 95 |     , declValue "caseBinderCtor1BinderCtor0" [] do
 96 |         exprCase [ exprSection ]
 97 |           [ caseBranch [ bCtor1 bCtor0 ] eBool
 98 |           ]
 99 |     , declValue "caseBinderCtor1BinderCtor1" [] do
100 |         exprCase [ exprSection ]
101 |           [ caseBranch [ bCtor1 $ bCtor1 bVarA ] eBool
102 |           ]
103 |     , declValue "caseBinderCtor1BinderNamed" [] do
104 |         exprCase [ exprSection ]
105 |           [ caseBranch [ bCtor1 $ bNamed bVarA ] eBool
106 |           ]
107 |     , declValue "caseBinderCtor1BinderOp" [] do
108 |         exprCase [ exprSection ]
109 |           [ caseBranch [ bCtor1 $ bOp bVarA bVarB ] eBool
110 |           ]
111 |     , declValue "caseBinderCtor1BinderTyped" [] do
112 |         exprCase [ exprSection ]
113 |           [ caseBranch [ bCtor1 bTyped ] eBool
114 |           ]
115 |     , declValue "caseBinderNamedBinderNegInt" [] do
116 |         exprCase [ exprSection ]
117 |           [ caseBranch [ bNamed bNegInt ] eBool
118 |           ]
119 |     , declValue "caseBinderNamedBinderNegNum" [] do
120 |         exprCase [ exprSection ]
121 |           [ caseBranch [ bNamed bNegNum ] eBool
122 |           ]
123 |     , declValue "caseBinderNamedBinderVar" [] do
124 |         exprCase [ exprSection ]
125 |           [ caseBranch [ bNamed bVarA ] eBool
126 |           ]
127 |     , declValue "caseBinderNamedBinderCtor0" [] do
128 |         exprCase [ exprSection ]
129 |           [ caseBranch [ bNamed bCtor0 ] eBool
130 |           ]
131 |     , declValue "caseBinderNamedBinderCtor1" [] do
132 |         exprCase [ exprSection ]
133 |           [ caseBranch [ bNamed $ bCtor1 bVarA ] eBool
134 |           ]
135 |     , declValue "caseBinderNamedBinderOp" [] do
136 |         exprCase [ exprSection ]
137 |           [ caseBranch [ bNamed $ bOp bVarA bVarB ] eBool
138 |           ]
139 |     , declValue "caseBinderNamedBinderTyped" [] do
140 |         exprCase [ exprSection ]
141 |           [ caseBranch [ bNamed bTyped ] eBool
142 |           ]
143 |     , declValue "caseBinderTyped" [] do
144 |         exprCase [ exprSection ]
145 |           [ caseBranch [ bTyped ] eBool
146 |           ]
147 |     , declValue "caseBinderOp" [] do
148 |         exprCase [ exprSection ]
149 |           [ caseBranch [ bOp bVarA bVarB ] eBool
150 |           ]
151 |     ]
152 | 
153 | main :: Effect Unit
154 | main = log $ printModule test
155 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenClass.output:
--------------------------------------------------------------------------------
1 | module Test.Class where
2 | 
3 | class Functor f where
4 |   map :: forall a b. (a -> b) -> f a -> f b
5 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenClass.purs:
--------------------------------------------------------------------------------
 1 | module CodegenClass where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Effect (Effect)
 6 | import Partial.Unsafe (unsafePartial)
 7 | import PureScript.CST.Types (Module)
 8 | import Test.Util (log)
 9 | import Tidy.Codegen (classMember, declClass, module_, printModule, typeApp, typeArrow, typeForall, typeVar)
10 | 
11 | test :: Module Void
12 | test = unsafePartial do
13 |   module_ "Test.Class" [] []
14 |     [ declClass [] "Functor" [ typeVar "f" ] []
15 |         [ classMember "map" do
16 |             typeForall [ typeVar "a", typeVar "b" ]
17 |               $ typeArrow
18 |                   [ typeArrow [ typeVar "a" ] (typeVar "b")
19 |                   , typeApp (typeVar "f") [ typeVar "a" ]
20 |                   ]
21 |                   (typeApp (typeVar "f") [ typeVar "b" ])
22 |         ]
23 |     ]
24 | 
25 | main :: Effect Unit
26 | main = log $ printModule test
27 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenData.output:
--------------------------------------------------------------------------------
1 | module Test.Data where
2 | 
3 | data Maybe a = Nothing | Just a
4 | 
5 | data Proxy :: forall k. k -> Type
6 | data Proxy a = Proxy
7 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenData.purs:
--------------------------------------------------------------------------------
 1 | module CodegenData where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Effect (Effect)
 6 | import Partial.Unsafe (unsafePartial)
 7 | import PureScript.CST.Types (Module)
 8 | import Test.Util (log)
 9 | import Tidy.Codegen (dataCtor, declData, declDataSignature, module_, printModule, typeArrow, typeCtor, typeForall, typeVar)
10 | 
11 | test :: Module Void
12 | test = unsafePartial do
13 |   module_ "Test.Data" [] []
14 |     [ declData "Maybe" [ typeVar "a" ]
15 |         [ dataCtor "Nothing" []
16 |         , dataCtor "Just" [ typeVar "a" ]
17 |         ]
18 |     , declDataSignature "Proxy" do
19 |         typeForall [ typeVar "k" ]
20 |           (typeArrow [ typeVar "k" ] (typeCtor "Type"))
21 |     , declData "Proxy" [ typeVar "a" ]
22 |         [ dataCtor "Proxy" []
23 |         ]
24 |     ]
25 | 
26 | main :: Effect Unit
27 | main = log $ printModule test
28 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenExamples.output:
--------------------------------------------------------------------------------
 1 | module CodegenExamples where
 2 | 
 3 | binaryOpExample = 4 + a / b
 4 | type TypeCtorExample = Maybe Int
 5 | type TypeRowExample = (id :: UserId, name :: String, age :: Int | r)
 6 | type TypeRecordExample = { id :: UserId, name :: String, age :: Int | r }
 7 | type TypeKindedExample = Maybe :: Type -> Type
 8 | type TypeAppExample = Map UserId User
 9 | type TypeOpExample = String /\ Int /\ Boolean
10 | type TypeOpNameExample = (~>)
11 | type TypeForallExample = forall a. a -> a
12 | type TypeConstrainedExample = forall f a. Functor f => Show a => f a -> f String
13 | type TypeArrowExample = UserId -> String -> Int -> User
14 | exprIdentExample = Map.lookup userId users
15 | exprCtorExample = List.Cons a List.Nil
16 | exprBoolExample = true
17 | exprCharExample = 'A'
18 | exprStringExample = "string"
19 | exprIntExample = 42
20 | exprIntHexExample = 0xff0000
21 | exprNumberExample = 1.618
22 | exprArrayExample = [ 1, 2, 3 ]
23 | exprRecordExample = { id: userId, name: userName, age: userAge }
24 | exprTypedExample = 42 :: Int
25 | exprInfixExample = a `append` b `append` c
26 | exprOpExample = "string" /\ 42 /\ false
27 | exprOpNameExample = (<>)
28 | exprDotExample = response.body.users
29 | exprUpdateExample = user { age = 42, phone { countryCode = 1 } }
30 | exprAppExample = Map.lookup userId users
31 | exprTypeAppExample = Map.lookup @String @(Maybe User) userId users
32 | exprLambdaExample = \a b -> a <> b
33 | exprIfExample = if isLoggedIn user then renderPage else httpError 400
34 | exprCaseExample = case xs of
35 |   List.Cons x _ -> Just x
36 |   Nothing -> Nothing
37 | 
38 | exprLetExample =
39 |   let
40 |     countDown :: Int -> Int
41 |     countDown n
42 |       | n > 0 = countDown (n - 1)
43 |       | otherwise = n
44 |   in
45 |     countDown 100
46 | 
47 | exprDoExample = do
48 |   followers <- getFollowers user
49 |   favorites <- getFavorites user
50 |   pure { followers, favorites }
51 | 
52 | letBinderExample = let { name } = user in name
53 | doLetExample = do
54 |   let { age } = user
55 |   age
56 | 
57 | doDiscardExample = do
58 |   logoutUser user
59 |   pure (httpStatus 200)
60 | 
61 | doBindExample = do
62 |   { followers } <- getUser user
63 |   pure followers
64 | 
65 | getName user = name
66 |   where
67 |   { name } = user
68 | 
69 | countDown n
70 |   | n > 0 = countDown (n - 1)
71 |   | otherwise = n
72 | 
73 | binderWildcardExample = \_ -> countDown 100
74 | data Either a b = Left a | Right b
75 | type UserFields r = (id :: UserId, name :: String, age :: Int | r)
76 | newtype UserId = UserId String
77 | 
78 | class Eq a <= Ord a where
79 |   compare :: a -> a -> Ordering
80 | 
81 | instance IsTypeEqual a a True
82 | else instance IsTypeEqual a b False
83 | 
84 | derive instance Eq UserId
85 | derive newtype instance Eq UserId
86 | countDown n
87 |   | n > 0 = countDown (n - 1)
88 |   | otherwise = n
89 | 
90 | infixl 4 map as <$>
91 | infixr 0 RowApply as +
92 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenExamples.purs:
--------------------------------------------------------------------------------
  1 | ------------------------------------
  2 | -- This module is code generated. --
  3 | --          DO NOT EDIT!          --
  4 | ------------------------------------
  5 | module CodegenExamples where
  6 | 
  7 | import Prelude
  8 | 
  9 | import Data.Maybe (Maybe(..))
 10 | import Data.Tuple (Tuple(..))
 11 | import Effect (Effect)
 12 | import Partial.Unsafe (unsafePartial)
 13 | import PureScript.CST.Types (Module, Fixity(..))
 14 | import Test.Util (log)
 15 | import Tidy.Codegen (binaryOp, binderCtor, binderRecord, binderVar, binderWildcard, caseBranch, classMember, dataCtor, declClass, declData, declDerive, declDeriveNewtype, declInfix, declInstance, declInstanceChain, declNewtype, declType, declValue, doBind, doDiscard, doLet, exprApp, exprArray, exprBool, exprCase, exprChar, exprCtor, exprDo, exprDot, exprIdent, exprIf, exprInfix, exprInt, exprIntHex, exprLambda, exprLet, exprNumber, exprOp, exprOpName, exprRecord, exprString, exprTypeApp, exprTyped, exprUpdate, exprWhere, guardBranch, guardExpr, letBinder, letSignature, letValue, module_, printModule, typeApp, typeArrow, typeConstrained, typeCtor, typeForall, typeKinded, typeOp, typeOpName, typeRecord, typeRow, typeVar, update, updateNested)
 16 | 
 17 | test :: Module Void
 18 | test = unsafePartial
 19 |   ( module_ "CodegenExamples" [] []
 20 |       [ declValue "binaryOpExample" []
 21 |           ( exprOp (exprInt 4)
 22 |               [ binaryOp "+" (exprIdent "a")
 23 |               , binaryOp "/" (exprIdent "b")
 24 |               ]
 25 |           )
 26 |       , declType "TypeCtorExample" [] (typeApp (typeCtor "Maybe") [ typeCtor "Int" ])
 27 |       , declType "TypeRowExample" []
 28 |           ( typeRow
 29 |               [ Tuple "id" (typeCtor "UserId")
 30 |               , Tuple "name" (typeCtor "String")
 31 |               , Tuple "age" (typeCtor "Int")
 32 |               ]
 33 |               (Just (typeVar "r"))
 34 |           )
 35 |       , declType "TypeRecordExample" []
 36 |           ( typeRecord
 37 |               [ Tuple "id" (typeCtor "UserId")
 38 |               , Tuple "name" (typeCtor "String")
 39 |               , Tuple "age" (typeCtor "Int")
 40 |               ]
 41 |               (Just (typeVar "r"))
 42 |           )
 43 |       , declType "TypeKindedExample" []
 44 |           ( typeKinded (typeCtor "Maybe")
 45 |               (typeArrow [ typeCtor "Type" ] (typeCtor "Type"))
 46 |           )
 47 |       , declType "TypeAppExample" []
 48 |           ( typeApp (typeCtor "Map")
 49 |               [ typeCtor "UserId"
 50 |               , typeCtor "User"
 51 |               ]
 52 |           )
 53 |       , declType "TypeOpExample" []
 54 |           ( typeOp (typeCtor "String")
 55 |               [ binaryOp "/\\" (typeCtor "Int")
 56 |               , binaryOp "/\\" (typeCtor "Boolean")
 57 |               ]
 58 |           )
 59 |       , declType "TypeOpNameExample" [] (typeOpName "(~>)")
 60 |       , declType "TypeForallExample" []
 61 |           ( typeForall [ typeVar "a" ]
 62 |               (typeArrow [ typeVar "a" ] (typeVar "a"))
 63 |           )
 64 |       , declType "TypeConstrainedExample" []
 65 |           ( typeForall [ typeVar "f", typeVar "a" ]
 66 |               ( typeConstrained
 67 |                   [ typeApp (typeCtor "Functor") [ typeVar "f" ]
 68 |                   , typeApp (typeCtor "Show") [ typeVar "a" ]
 69 |                   ]
 70 |                   ( typeArrow
 71 |                       [ typeApp (typeVar "f")
 72 |                           [ typeVar "a" ]
 73 |                       ]
 74 |                       ( typeApp (typeVar "f")
 75 |                           [ typeCtor "String" ]
 76 |                       )
 77 |                   )
 78 |               )
 79 |           )
 80 |       , declType "TypeArrowExample" []
 81 |           ( typeArrow
 82 |               [ typeCtor "UserId"
 83 |               , typeCtor "String"
 84 |               , typeCtor "Int"
 85 |               ]
 86 |               (typeCtor "User")
 87 |           )
 88 |       , declValue "exprIdentExample" []
 89 |           ( exprApp (exprIdent "Map.lookup")
 90 |               [ exprIdent "userId"
 91 |               , exprIdent "users"
 92 |               ]
 93 |           )
 94 |       , declValue "exprCtorExample" []
 95 |           ( exprApp (exprCtor "List.Cons")
 96 |               [ exprIdent "a"
 97 |               , exprCtor "List.Nil"
 98 |               ]
 99 |           )
100 |       , declValue "exprBoolExample" [] (exprBool true)
101 |       , declValue "exprCharExample" [] (exprChar 'A')
102 |       , declValue "exprStringExample" [] (exprString "string")
103 |       , declValue "exprIntExample" [] (exprInt 42)
104 |       , declValue "exprIntHexExample" [] (exprIntHex 0xFF0000)
105 |       , declValue "exprNumberExample" [] (exprNumber 1.618)
106 |       , declValue "exprArrayExample" []
107 |           ( exprArray
108 |               [ exprInt 1
109 |               , exprInt 2
110 |               , exprInt 3
111 |               ]
112 |           )
113 |       , declValue "exprRecordExample" []
114 |           ( exprRecord
115 |               [ Tuple "id" (exprIdent "userId")
116 |               , Tuple "name" (exprIdent "userName")
117 |               , Tuple "age" (exprIdent "userAge")
118 |               ]
119 |           )
120 |       , declValue "exprTypedExample" [] (exprTyped (exprInt 42) (typeCtor "Int"))
121 |       , declValue "exprInfixExample" []
122 |           ( exprInfix (exprIdent "a")
123 |               [ Tuple (exprIdent "append") (exprIdent "b")
124 |               , Tuple (exprIdent "append") (exprIdent "c")
125 |               ]
126 |           )
127 |       , declValue "exprOpExample" []
128 |           ( exprOp (exprString "string")
129 |               [ binaryOp "/\\" (exprInt 42)
130 |               , binaryOp "/\\" (exprBool false)
131 |               ]
132 |           )
133 |       , declValue "exprOpNameExample" [] (exprOpName "(<>)")
134 |       , declValue "exprDotExample" [] (exprDot (exprIdent "response") [ "body", "users" ])
135 |       , declValue "exprUpdateExample" []
136 |           ( exprUpdate (exprIdent "user")
137 |               [ update "age" (exprInt 42)
138 |               , updateNested "phone"
139 |                   [ update "countryCode" (exprInt 1)
140 |                   ]
141 |               ]
142 |           )
143 |       , declValue "exprAppExample" []
144 |           ( exprApp (exprIdent "Map.lookup")
145 |               [ exprIdent "userId"
146 |               , exprIdent "users"
147 |               ]
148 |           )
149 |       , declValue "exprTypeAppExample" []
150 |           ( exprTypeApp (exprIdent "Map.lookup")
151 |               [ typeCtor "String"
152 |               , typeApp (typeCtor "Maybe") [ typeCtor "User" ]
153 |               ]
154 |               [ exprIdent "userId"
155 |               , exprIdent "users"
156 |               ]
157 |           )
158 |       , declValue "exprLambdaExample" []
159 |           ( exprLambda [ binderVar "a", binderVar "b" ]
160 |               ( exprOp (exprIdent "a")
161 |                   [ binaryOp "<>" (exprIdent "b") ]
162 |               )
163 |           )
164 |       , declValue "exprIfExample" []
165 |           ( exprIf (exprApp (exprIdent "isLoggedIn") [ exprIdent "user" ])
166 |               (exprIdent "renderPage")
167 |               (exprApp (exprIdent "httpError") [ exprInt 400 ])
168 |           )
169 |       , declValue "exprCaseExample" []
170 |           ( exprCase [ exprIdent "xs" ]
171 |               [ caseBranch [ binderCtor "List.Cons" [ binderVar "x", binderWildcard ] ]
172 |                   ( exprApp (exprCtor "Just")
173 |                       [ exprIdent "x"
174 |                       ]
175 |                   )
176 |               , caseBranch [ binderCtor "Nothing" [] ]
177 |                   (exprCtor "Nothing")
178 |               ]
179 |           )
180 |       , declValue "exprLetExample" []
181 |           ( exprLet
182 |               [ letSignature "countDown" (typeArrow [ typeCtor "Int" ] (typeCtor "Int"))
183 |               , letValue "countDown" [ binderVar "n" ]
184 |                   [ guardBranch [ guardExpr (exprOp (exprIdent "n") [ binaryOp ">" (exprInt 0) ]) ]
185 |                       ( exprApp (exprIdent "countDown")
186 |                           [ exprOp (exprIdent "n") [ binaryOp "-" (exprInt 1) ] ]
187 |                       )
188 |                   , guardBranch [ guardExpr (exprIdent "otherwise") ]
189 |                       (exprIdent "n")
190 |                   ]
191 |               ]
192 |               (exprApp (exprIdent "countDown") [ exprInt 100 ])
193 |           )
194 |       , declValue "exprDoExample" []
195 |           ( exprDo
196 |               [ doBind (binderVar "followers")
197 |                   (exprApp (exprIdent "getFollowers") [ exprIdent "user" ])
198 |               , doBind (binderVar "favorites")
199 |                   (exprApp (exprIdent "getFavorites") [ exprIdent "user" ])
200 |               ]
201 |               ( exprApp (exprIdent "pure")
202 |                   [ exprRecord [ "followers", "favorites" ] ]
203 |               )
204 |           )
205 |       , declValue "letBinderExample" []
206 |           ( exprLet
207 |               [ letBinder (binderRecord [ "name" ])
208 |                   (exprIdent "user")
209 |               ]
210 |               (exprIdent "name")
211 |           )
212 |       , declValue "doLetExample" []
213 |           ( exprDo
214 |               [ doLet
215 |                   [ letBinder (binderRecord [ "age" ])
216 |                       (exprIdent "user")
217 |                   ]
218 |               ]
219 |               (exprIdent "age")
220 |           )
221 |       , declValue "doDiscardExample" []
222 |           ( exprDo
223 |               [ doDiscard
224 |                   ( exprApp (exprIdent "logoutUser")
225 |                       [ exprIdent "user" ]
226 |                   )
227 |               ]
228 |               ( exprApp (exprIdent "pure")
229 |                   [ exprApp (exprIdent "httpStatus")
230 |                       [ exprInt 200 ]
231 |                   ]
232 |               )
233 |           )
234 |       , declValue "doBindExample" []
235 |           ( exprDo
236 |               [ doBind (binderRecord [ "followers" ])
237 |                   (exprApp (exprIdent "getUser") [ exprIdent "user" ])
238 |               ]
239 |               ( exprApp (exprIdent "pure")
240 |                   [ exprIdent "followers" ]
241 |               )
242 |           )
243 |       , declValue "getName" [ binderVar "user" ]
244 |           ( exprWhere (exprIdent "name")
245 |               [ letBinder (binderRecord [ "name" ])
246 |                   (exprIdent "user")
247 |               ]
248 |           )
249 |       , declValue "countDown" [ binderVar "n" ]
250 |           [ guardBranch [ guardExpr (exprOp (exprIdent "n") [ binaryOp ">" (exprInt 0) ]) ]
251 |               ( exprApp (exprIdent "countDown")
252 |                   [ exprOp (exprIdent "n") [ binaryOp "-" (exprInt 1) ] ]
253 |               )
254 |           , guardBranch [ guardExpr (exprIdent "otherwise") ]
255 |               (exprIdent "n")
256 |           ]
257 |       , declValue "binderWildcardExample" []
258 |           ( exprLambda [ binderWildcard ]
259 |               (exprApp (exprIdent "countDown") [ exprInt 100 ])
260 |           )
261 |       , declData "Either" [ typeVar "a", typeVar "b" ]
262 |           [ dataCtor "Left" [ typeVar "a" ]
263 |           , dataCtor "Right" [ typeVar "b" ]
264 |           ]
265 |       , declType "UserFields" [ typeVar "r" ]
266 |           ( typeRow
267 |               [ Tuple "id" (typeCtor "UserId")
268 |               , Tuple "name" (typeCtor "String")
269 |               , Tuple "age" (typeCtor "Int")
270 |               ]
271 |               (Just (typeVar "r"))
272 |           )
273 |       , declNewtype "UserId" [] "UserId" (typeCtor "String")
274 |       , declClass [ typeApp (typeCtor "Eq") [ typeVar "a" ] ] "Ord" [ typeVar "a" ] []
275 |           [ classMember "compare"
276 |               (typeArrow [ typeVar "a", typeVar "a" ] (typeCtor "Ordering"))
277 |           ]
278 |       , declInstanceChain
279 |           [ declInstance Nothing [] "IsTypeEqual"
280 |               [ typeVar "a", typeVar "a", typeCtor "True" ]
281 |               []
282 |           , declInstance Nothing [] "IsTypeEqual"
283 |               [ typeVar "a", typeVar "b", typeCtor "False" ]
284 |               []
285 |           ]
286 |       , declDerive Nothing [] "Eq" [ typeCtor "UserId" ]
287 |       , declDeriveNewtype Nothing [] "Eq" [ typeCtor "UserId" ]
288 |       , declValue "countDown" [ binderVar "n" ]
289 |           [ guardBranch [ guardExpr (exprOp (exprIdent "n") [ binaryOp ">" (exprInt 0) ]) ]
290 |               ( exprApp (exprIdent "countDown")
291 |                   [ exprOp (exprIdent "n") [ binaryOp "-" (exprInt 1) ] ]
292 |               )
293 |           , guardBranch [ guardExpr (exprIdent "otherwise") ]
294 |               (exprIdent "n")
295 |           ]
296 |       , declInfix Infixl 4 "map" "<$>"
297 |       , declInfix Infixr 0 "RowApply" "+"
298 |       ]
299 |   )
300 | 
301 | main :: Effect Unit
302 | main = log (printModule test)
303 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenExports.output:
--------------------------------------------------------------------------------
 1 | module Test.Exports
 2 |   ( map
 3 |   , (<$>)
 4 |   , Void
 5 |   , Either(..)
 6 |   , Maybe(Nothing, Just)
 7 |   , type (+)
 8 |   , class Functor
 9 |   , module Test.Exports
10 |   ) where
11 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenExports.purs:
--------------------------------------------------------------------------------
 1 | module CodegenExports where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Effect (Effect)
 6 | import Partial.Unsafe (unsafePartial)
 7 | import PureScript.CST.Types (Module)
 8 | import Test.Util (log)
 9 | import Tidy.Codegen (exportClass, exportModule, exportOp, exportType, exportTypeAll, exportTypeMembers, exportTypeOp, exportValue, module_, printModule)
10 | 
11 | test :: Module Void
12 | test = unsafePartial do
13 |   module_ "Test.Exports"
14 |     [ exportValue "map"
15 |     , exportOp "<$>"
16 |     , exportType "Void"
17 |     , exportTypeAll "Either"
18 |     , exportTypeMembers "Maybe" [ "Nothing", "Just" ]
19 |     , exportTypeOp "+"
20 |     , exportClass "Functor"
21 |     , exportModule "Test.Exports"
22 |     ]
23 |     []
24 |     []
25 | 
26 | main :: Effect Unit
27 | main = log $ printModule test
28 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenImports.output:
--------------------------------------------------------------------------------
 1 | module CodegenImports where
 2 | 
 3 | import Prelude
 4 | import Control.Category ((<<<))
 5 | import Data.Maybe (maybe, Maybe(..))
 6 | import Data.Maybe as Maybe
 7 | import Data.Foldable (class Foldable)
 8 | import Data.Either (Either(Left, Right))
 9 | import Type.Row (type (+))
10 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenImports.purs:
--------------------------------------------------------------------------------
 1 | module CodegenImports where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Effect (Effect)
 6 | import Partial.Unsafe (unsafePartial)
 7 | import PureScript.CST.Types (Module)
 8 | import Test.Util (log)
 9 | import Tidy.Codegen (declImport, declImportAs, importClass, importOp, importTypeAll, importTypeMembers, importTypeOp, importValue, module_, printModule)
10 | 
11 | test :: Module Void
12 | test = unsafePartial do
13 |   module_ "CodegenImports" []
14 |     [ declImport "Prelude" []
15 |     , declImport "Control.Category" [ importOp "<<<" ]
16 |     , declImport "Data.Maybe"
17 |         [ importValue "maybe"
18 |         , importTypeAll "Maybe"
19 |         ]
20 |     , declImportAs "Data.Maybe" [] "Maybe"
21 |     , declImport "Data.Foldable" [ importClass "Foldable" ]
22 |     , declImport "Data.Either" [ importTypeMembers "Either" [ "Left", "Right" ] ]
23 |     , declImport "Type.Row"
24 |         [ importTypeOp "+"
25 |         ]
26 |     ]
27 |     []
28 | 
29 | main :: Effect Unit
30 | main = log $ printModule test
31 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenInstance.output:
--------------------------------------------------------------------------------
 1 | module Test.Instance where
 2 | 
 3 | instance Functor Maybe where
 4 |   map f a = case a of
 5 |     Nothing -> Nothing
 6 |     Just b -> Just (f b)
 7 | 
 8 | instance Foo (Either a)
 9 | else instance Foo Maybe
10 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenInstance.purs:
--------------------------------------------------------------------------------
 1 | module CodegenInstance where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Data.Maybe (Maybe(..))
 6 | import Effect (Effect)
 7 | import Partial.Unsafe (unsafePartial)
 8 | import PureScript.CST.Types (Module)
 9 | import Test.Util (log)
10 | import Tidy.Codegen (binderCtor, binderVar, caseBranch, declInstance, declInstanceChain, exprApp, exprCase, exprCtor, exprIdent, instValue, module_, printModule, typeApp, typeCtor, typeVar)
11 | 
12 | test :: Module Void
13 | test = unsafePartial do
14 |   module_ "Test.Instance" [] []
15 |     [ declInstance Nothing [] "Functor" [ typeCtor "Maybe" ]
16 |         [ instValue "map" [ binderVar "f", binderVar "a" ] do
17 |             exprCase [ exprIdent "a" ]
18 |               [ caseBranch [ binderCtor "Nothing" [] ] do
19 |                   exprCtor "Nothing"
20 |               , caseBranch [ binderCtor "Just" [ binderVar "b" ] ] do
21 |                   exprApp (exprCtor "Just")
22 |                     [ exprApp (exprIdent "f") [ exprIdent "b" ] ]
23 |               ]
24 |         ]
25 |     , declInstanceChain
26 |         [ declInstance Nothing [] "Foo" [ typeApp (typeCtor "Either") [ typeVar "a" ] ] []
27 |         , declInstance Nothing [] "Foo" [ typeCtor "Maybe" ] []
28 |         ]
29 |     ]
30 | 
31 | main :: Effect Unit
32 | main = log $ printModule test
33 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenMonad.output:
--------------------------------------------------------------------------------
 1 | module Test.Monad (alt', alt'', getNum) where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Control.Alt ((<|>))
 6 | import Data.Map (Map)
 7 | import Data.Map as Map
 8 | import Data.Maybe (Maybe(..), maybe)
 9 | 
10 | getNum :: String -> Map String Int -> Maybe Int
11 | getNum key = maybe (Just 0) <<< Map.lookup key
12 | 
13 | alt' a b = a <|> b
14 | alt'' a b = (<|>) a b
15 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenMonad.purs:
--------------------------------------------------------------------------------
 1 | module CodegenMonad where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Effect (Effect)
 6 | import Partial.Unsafe (unsafePartial)
 7 | import PureScript.CST.Types (Module)
 8 | import Test.Util (log)
 9 | import Tidy.Codegen (binaryOp, binderVar, declSignature, declValue, exprApp, exprCtor, exprIdent, exprInt, exprOp, exprOpName, printModule, typeApp, typeArrow, typeCtor)
10 | import Tidy.Codegen.Monad (codegenModule, exporting, importCtor, importFrom, importOp, importOpen, importType, importValue, write)
11 | 
12 | test :: Module Void
13 | test = unsafePartial do
14 |   codegenModule "Test.Monad" do
15 |     importOpen "Prelude"
16 |     maybeTy <- importFrom "Data.Maybe" (importType "Maybe")
17 |     justCtor <- importFrom "Data.Maybe" (importCtor "Maybe" "Just")
18 |     maybeFn <- importFrom "Data.Maybe" (importValue "maybe")
19 |     mapTy <- importFrom "Data.Map" (importType "Map")
20 |     mapLookup <- importFrom "Data.Map" (importValue "Map.lookup")
21 |     altOp <- importFrom "Control.Alt" (importOp "<|>")
22 |     exporting do
23 |       write $ declSignature "getNum" do
24 |         typeArrow
25 |           [ typeCtor "String"
26 |           , typeApp (typeCtor mapTy) [ typeCtor "String", typeCtor "Int" ]
27 |           ]
28 |           ( typeApp (typeCtor maybeTy)
29 |               [ typeCtor "Int" ]
30 |           )
31 |       write $ declValue "getNum" [ binderVar "key" ] do
32 |         exprOp
33 |           ( exprApp (exprIdent maybeFn)
34 |               [ exprApp (exprCtor justCtor)
35 |                   [ exprInt 0 ]
36 |               ]
37 |           )
38 |           [ binaryOp "<<<"
39 |               ( exprApp (exprIdent mapLookup)
40 |                   [ exprIdent "key" ]
41 |               )
42 |           ]
43 |       write $ declValue "alt'" [ binderVar "a", binderVar "b" ] do
44 |         exprOp (exprIdent "a")
45 |           [ binaryOp altOp
46 |               (exprIdent "b")
47 |           ]
48 |       write $ declValue "alt''" [ binderVar "a", binderVar "b" ] do
49 |         exprApp (exprOpName altOp)
50 |           [ exprIdent "a"
51 |           , exprIdent "b"
52 |           ]
53 | 
54 | main :: Effect Unit
55 | main = log $ printModule test
56 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenNewtype.output:
--------------------------------------------------------------------------------
 1 | module Test.Newtype where
 2 | 
 3 | newtype Const :: forall k. Type -> k -> Type
 4 | newtype Const a b = Const a
 5 | 
 6 | newtype User = User
 7 |   { id :: UserId
 8 |   , name :: String
 9 |   , age :: Int
10 |   , email :: Email
11 |   , phone :: PhoneNumber
12 |   , followers :: Array UserId
13 |   }
14 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenNewtype.purs:
--------------------------------------------------------------------------------
 1 | module CodegenNewtype where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Data.Maybe (Maybe(..))
 6 | import Data.Tuple (Tuple(..))
 7 | import Effect (Effect)
 8 | import Partial.Unsafe (unsafePartial)
 9 | import PureScript.CST.Types (Module)
10 | import Test.Util (log)
11 | import Tidy.Codegen (declNewtype, declNewtypeSignature, module_, printModule, typeApp, typeArrow, typeCtor, typeForall, typeRecord, typeVar)
12 | 
13 | test :: Module Void
14 | test = unsafePartial do
15 |   module_ "Test.Newtype" [] []
16 |     [ declNewtypeSignature "Const" do
17 |         typeForall [ typeVar "k" ]
18 |           ( typeArrow
19 |               [ typeCtor "Type"
20 |               , typeVar "k"
21 |               ]
22 |               (typeCtor "Type")
23 |           )
24 |     , declNewtype "Const" [ typeVar "a", typeVar "b" ]
25 |         "Const"
26 |         (typeVar "a")
27 |     , declNewtype "User" []
28 |         "User"
29 |         ( typeRecord
30 |             [ Tuple "id" (typeCtor "UserId")
31 |             , Tuple "name" (typeCtor "String")
32 |             , Tuple "age" (typeCtor "Int")
33 |             , Tuple "email" (typeCtor "Email")
34 |             , Tuple "phone" (typeCtor "PhoneNumber")
35 |             , Tuple "followers" (typeApp (typeCtor "Array") [ typeCtor "UserId" ])
36 |             ]
37 |             Nothing
38 |         )
39 |     ]
40 | 
41 | main :: Effect Unit
42 | main = log $ printModule test
43 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenReadme.output:
--------------------------------------------------------------------------------
 1 | module Data.Maybe where
 2 | 
 3 | import Prelude
 4 | 
 5 | data Maybe a = Nothing | Just a
 6 | 
 7 | derive instance Functor Maybe
 8 | 
 9 | maybe :: forall a b. b -> (a -> b) -> Maybe a -> b
10 | maybe nothing just = case _ of
11 |   Just a -> just a
12 |   Nothing -> nothing
13 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenReadme.purs:
--------------------------------------------------------------------------------
 1 | module CodegenReadme where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Control.Monad.Writer (tell)
 6 | import Data.Maybe (Maybe(..))
 7 | import Effect (Effect)
 8 | import Partial.Unsafe (unsafePartial)
 9 | import PureScript.CST.Types (Module)
10 | import Test.Util (log)
11 | import Tidy.Codegen (binderCtor, binderVar, caseBranch, dataCtor, declData, declDerive, declSignature, declValue, exprApp, exprCase, exprIdent, exprSection, printModule, typeApp, typeArrow, typeCtor, typeForall, typeVar)
12 | import Tidy.Codegen.Monad (codegenModule, importOpen)
13 | 
14 | test :: Module Void
15 | test = unsafePartial $ codegenModule "Data.Maybe" do
16 |   importOpen "Prelude"
17 |   tell
18 |     [ declData "Maybe" [ typeVar "a" ]
19 |         [ dataCtor "Nothing" []
20 |         , dataCtor "Just" [ typeVar "a" ]
21 |         ]
22 | 
23 |     , declDerive Nothing [] "Functor" [ typeCtor "Maybe" ]
24 | 
25 |     , declSignature "maybe" do
26 |         typeForall [ typeVar "a", typeVar "b" ] do
27 |           typeArrow
28 |             [ typeVar "b"
29 |             , typeArrow [ typeVar "a" ] (typeVar "b")
30 |             , typeApp (typeCtor "Maybe") [ typeVar "a" ]
31 |             ]
32 |             (typeVar "b")
33 |     , declValue "maybe" [ binderVar "nothing", binderVar "just" ] do
34 |         exprCase [ exprSection ]
35 |           [ caseBranch [ binderCtor "Just" [ binderVar "a" ] ] do
36 |               exprApp (exprIdent "just") [ exprIdent "a" ]
37 |           , caseBranch [ binderCtor "Nothing" [] ] do
38 |               exprIdent "nothing"
39 |           ]
40 |     ]
41 | 
42 | main :: Effect Unit
43 | main = log $ printModule test
44 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenTypeSynonym.output:
--------------------------------------------------------------------------------
 1 | module Test.TypeSynonym where
 2 | 
 3 | type Id :: forall k. k -> k
 4 | type Id a = a
 5 | 
 6 | type UserFields r =
 7 |   ( id :: UserId
 8 |   , name :: String
 9 |   , age :: Int
10 |   , email :: Email
11 |   , phone :: PhoneNumber
12 |   , followers :: Array UserId
13 |   | r
14 |   )
15 | 


--------------------------------------------------------------------------------
/test/snapshots/CodegenTypeSynonym.purs:
--------------------------------------------------------------------------------
 1 | module CodegenTypeSynonym where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Data.Maybe (Maybe(..))
 6 | import Data.Tuple (Tuple(..))
 7 | import Effect (Effect)
 8 | import Partial.Unsafe (unsafePartial)
 9 | import PureScript.CST.Types (Module)
10 | import Test.Util (log)
11 | import Tidy.Codegen (declType, declTypeSignature, module_, printModule, typeApp, typeArrow, typeCtor, typeForall, typeRow, typeVar)
12 | 
13 | test :: Module Void
14 | test = unsafePartial do
15 |   module_ "Test.TypeSynonym" [] []
16 |     [ declTypeSignature "Id" do
17 |         typeForall [ typeVar "k" ]
18 |           $ typeArrow [ typeVar "k" ] (typeVar "k")
19 |     , declType "Id" [ typeVar "a" ] (typeVar "a")
20 |     , declType "UserFields" [ typeVar "r" ]
21 |         ( typeRow
22 |             [ Tuple "id" (typeCtor "UserId")
23 |             , Tuple "name" (typeCtor "String")
24 |             , Tuple "age" (typeCtor "Int")
25 |             , Tuple "email" (typeCtor "Email")
26 |             , Tuple "phone" (typeCtor "PhoneNumber")
27 |             , Tuple "followers" (typeApp (typeCtor "Array") [ typeCtor "UserId" ])
28 |             ]
29 |             (Just (typeVar "r"))
30 |         )
31 |     ]
32 | 
33 | main :: Effect Unit
34 | main = log $ printModule test
35 | 


--------------------------------------------------------------------------------