├── .github └── workflows │ └── main.yml ├── .gitignore ├── .npmignore ├── .nvmrc ├── LICENSE ├── README.md ├── assets ├── some-application │ ├── elm.json │ └── src │ │ ├── ElmTupleN.elm │ │ ├── GuidaTupleN.guida │ │ └── Invalid.elm └── some-package │ ├── elm.json │ └── src │ └── Main.elm ├── bin └── index.js ├── elm.json ├── eslint.config.mjs ├── examples ├── elm.json └── src │ ├── Animation.elm │ ├── Book.elm │ ├── Buttons.elm │ ├── Cards.elm │ ├── Clock.elm │ ├── Crate.elm │ ├── Cube.elm │ ├── CurrentTime.elm │ ├── DragAndDrop.elm │ ├── FirstPerson.elm │ ├── Forms.elm │ ├── Groceries.elm │ ├── Hello.elm │ ├── ImagePreviews.elm │ ├── Keyboard.elm │ ├── Mario.elm │ ├── Mouse.elm │ ├── Numbers.elm │ ├── Picture.elm │ ├── Positions.elm │ ├── Quotes.elm │ ├── Shapes.elm │ ├── TextFields.elm │ ├── Thwomp.elm │ ├── Triangle.elm │ ├── Turtle.elm │ └── Upload.elm ├── lib ├── browser.js ├── node.d.ts └── node.js ├── libraries └── test │ ├── README.md │ └── src │ ├── Console │ └── Text.elm │ └── Test │ ├── Reporter │ ├── Console.elm │ ├── Console │ │ ├── Format.elm │ │ └── Format │ │ │ ├── Color.elm │ │ │ └── Monochrome.elm │ ├── Highlightable.elm │ ├── JUnit.elm │ ├── Json.elm │ ├── Reporter.elm │ └── TestResults.elm │ └── Runner │ ├── JsMessage.elm │ ├── Node.elm │ └── Node │ └── Vendor │ ├── Console.elm │ └── Diff.elm ├── package-lock.json ├── package.json ├── review ├── elm.json └── src │ └── ReviewConfig.elm ├── scripts ├── build.sh └── performance-comparison.sh ├── src ├── Browser │ ├── Format.elm │ ├── Install.elm │ ├── Main.elm │ ├── Make.elm │ └── Uninstall.elm ├── Builder │ ├── BackgroundWriter.elm │ ├── Build.elm │ ├── Deps │ │ ├── Bump.elm │ │ ├── Diff.elm │ │ ├── Registry.elm │ │ ├── Solver.elm │ │ └── Website.elm │ ├── Elm │ │ ├── Details.elm │ │ └── Outline.elm │ ├── File.elm │ ├── Generate.elm │ ├── Http.elm │ ├── Reporting.elm │ ├── Reporting │ │ ├── Exit.elm │ │ ├── Exit │ │ │ └── Help.elm │ │ └── Task.elm │ └── Stuff.elm ├── Codec │ └── Archive │ │ └── Zip.elm ├── Compiler │ ├── AST │ │ ├── Canonical.elm │ │ ├── Optimized.elm │ │ ├── Source.elm │ │ └── Utils │ │ │ ├── Binop.elm │ │ │ ├── Shader.elm │ │ │ └── Type.elm │ ├── Canonicalize │ │ ├── Effects.elm │ │ ├── Environment.elm │ │ ├── Environment │ │ │ ├── Dups.elm │ │ │ ├── Foreign.elm │ │ │ └── Local.elm │ │ ├── Expression.elm │ │ ├── Module.elm │ │ ├── Pattern.elm │ │ └── Type.elm │ ├── Compile.elm │ ├── Data │ │ ├── Bag.elm │ │ ├── Index.elm │ │ ├── Map │ │ │ └── Utils.elm │ │ ├── Name.elm │ │ ├── NonEmptyList.elm │ │ └── OneOrMore.elm │ ├── Elm │ │ ├── Compiler │ │ │ ├── Imports.elm │ │ │ ├── Type.elm │ │ │ └── Type │ │ │ │ └── Extract.elm │ │ ├── Constraint.elm │ │ ├── Docs.elm │ │ ├── Interface.elm │ │ ├── Kernel.elm │ │ ├── Licenses.elm │ │ ├── Magnitude.elm │ │ ├── ModuleName.elm │ │ ├── Package.elm │ │ ├── String.elm │ │ └── Version.elm │ ├── Generate │ │ ├── Html.elm │ │ ├── JavaScript.elm │ │ ├── JavaScript │ │ │ ├── Builder.elm │ │ │ ├── Expression.elm │ │ │ ├── Functions.elm │ │ │ ├── Name.elm │ │ │ └── SourceMap.elm │ │ └── Mode.elm │ ├── Json │ │ ├── Decode.elm │ │ ├── Encode.elm │ │ └── String.elm │ ├── Nitpick │ │ ├── Debug.elm │ │ └── PatternMatches.elm │ ├── Optimize │ │ ├── Case.elm │ │ ├── DecisionTree.elm │ │ ├── Expression.elm │ │ ├── Module.elm │ │ ├── Names.elm │ │ └── Port.elm │ ├── Parse │ │ ├── Declaration.elm │ │ ├── Expression.elm │ │ ├── Keyword.elm │ │ ├── Module.elm │ │ ├── Number.elm │ │ ├── Pattern.elm │ │ ├── Primitives.elm │ │ ├── Shader.elm │ │ ├── Space.elm │ │ ├── String.elm │ │ ├── Symbol.elm │ │ ├── SyntaxVersion.elm │ │ ├── Type.elm │ │ └── Variable.elm │ ├── Reporting │ │ ├── Annotation.elm │ │ ├── Doc.elm │ │ ├── Error.elm │ │ ├── Error │ │ │ ├── Canonicalize.elm │ │ │ ├── Docs.elm │ │ │ ├── Import.elm │ │ │ ├── Json.elm │ │ │ ├── Main.elm │ │ │ ├── Pattern.elm │ │ │ ├── Syntax.elm │ │ │ └── Type.elm │ │ ├── Render │ │ │ ├── Code.elm │ │ │ ├── Type.elm │ │ │ └── Type │ │ │ │ └── Localizer.elm │ │ ├── Report.elm │ │ ├── Result.elm │ │ ├── Suggest.elm │ │ └── Warning.elm │ └── Type │ │ ├── Constrain │ │ ├── Expression.elm │ │ ├── Module.elm │ │ └── Pattern.elm │ │ ├── Error.elm │ │ ├── Instantiate.elm │ │ ├── Occurs.elm │ │ ├── Solve.elm │ │ ├── Type.elm │ │ ├── Unify.elm │ │ └── UnionFind.elm ├── Control │ └── Monad │ │ └── State │ │ ├── Strict.elm │ │ └── TypeCheck │ │ └── Strict.elm ├── Data │ ├── IORef.elm │ ├── Map.elm │ ├── Set.elm │ ├── Vector.elm │ └── Vector │ │ └── Mutable.elm ├── Node │ ├── Format.elm │ └── Main.elm ├── Prelude.elm ├── System │ ├── Console │ │ └── Ansi.elm │ ├── Exit.elm │ ├── IO.elm │ ├── Process.elm │ └── TypeCheck │ │ └── IO.elm ├── Terminal │ ├── Bump.elm │ ├── Diff.elm │ ├── Format.elm │ ├── Init.elm │ ├── Install.elm │ ├── Main.elm │ ├── Make.elm │ ├── Publish.elm │ ├── Repl.elm │ ├── Terminal.elm │ ├── Terminal │ │ ├── Chomp.elm │ │ ├── Error.elm │ │ ├── Helpers.elm │ │ └── Internal.elm │ ├── Test.elm │ └── Uninstall.elm ├── Text │ └── PrettyPrint │ │ └── ANSI │ │ └── Leijen.elm └── Utils │ ├── Bytes │ ├── Decode.elm │ └── Encode.elm │ ├── Crash.elm │ ├── Impure.elm │ └── Main.elm ├── tests ├── Parse │ ├── PrimitivesTests.elm │ ├── RecordTests.elm │ └── StringTests.elm ├── backwards-compatibility.test.js ├── repl.test.js └── tuples.test.js └── try ├── README.md ├── app.js ├── package-lock.json ├── package.json ├── public ├── app.css └── index.html └── server.js /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | # This workflow will do a clean installation of node dependencies, cache/restore them, build the source code and run tests for the configured nvm version of node 2 | # For more information see: https://docs.github.com/en/actions/automating-builds-and-tests/building-and-testing-nodejs 3 | 4 | name: CI 5 | 6 | on: 7 | push: 8 | branches: ["**"] 9 | pull_request: 10 | branches: ["**"] 11 | 12 | jobs: 13 | build: 14 | runs-on: ubuntu-latest 15 | timeout-minutes: 15 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | - uses: actions/setup-node@v4 20 | with: 21 | node-version-file: ".nvmrc" 22 | cache: "npm" 23 | - run: npm ci 24 | - run: npm run build:bin 25 | - run: npm run build:browser 26 | - run: npm run test:eslint 27 | - run: npm run test:elm-format-validate 28 | - run: npm run test:jest 29 | - run: npm run test:elm 30 | - run: npm run test:elm-review 31 | - name: self-hosted environment 32 | run: ./bin/index.js make --optimize src/Terminal/Main.elm 33 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | node_modules 2 | elm-stuff 3 | .DS_Store 4 | .idea 5 | 6 | # Guida 7 | guida-stuff 8 | 9 | # Main 10 | lib/guida.node.js 11 | lib/guida.node.min.js 12 | 13 | # Browser 14 | lib/guida.browser.js 15 | lib/guida.browser.min.js 16 | 17 | # Command line 18 | bin/guida.js 19 | bin/guida.min.js 20 | 21 | # Try 22 | try/public/app.js -------------------------------------------------------------------------------- /.npmignore: -------------------------------------------------------------------------------- 1 | .github 2 | bin/guida.js 3 | elm-stuff 4 | examples 5 | lib/guida.node.js 6 | lib/guida.browser.js 7 | guida-stuff 8 | review 9 | scripts 10 | src 11 | tests 12 | try 13 | .nvmrc 14 | elm.json 15 | eslint.config.mjs -------------------------------------------------------------------------------- /.nvmrc: -------------------------------------------------------------------------------- 1 | v23.10.0 -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Original work Copyright 2012-2024 Evan Czaplicki 2 | Modified work Copyright 2024-present Décio Ferreira 3 | 4 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 7 | 8 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 9 | 10 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Guida programming language 2 | 3 | Guida is a functional programming language that builds upon the solid foundation of Elm, offering 4 | backward compatibility with all existing Elm 0.19.1 projects. 5 | 6 | # Vision 7 | 8 | Guida builds on the foundations of Elm, aiming to advance the future of functional programming. 9 | By translating Elm's compiler from Haskell to a self-hosted environment, Guida helps developers to 10 | build reliable, maintainable, and performant applications without leaving the language they love. 11 | 12 | **Continuity and Confidence (Version 0.x):** 13 | Guida starts by ensuring full backward compatibility with Elm v0.19.1, allowing developers to migrate 14 | effortlessly and explore Guida with complete confidence. 15 | 16 | This commitment to continuity means that this version will faithfully replicate not only the 17 | features and behaviors of Elm v0.19.1, but also any existing bugs and quirks. 18 | By doing so, we provide a stable and predictable environment for developers, ensuring that their 19 | existing Elm projects work exactly as expected when migrated to Guida. 20 | 21 | **Evolution and Innovation (Version 1.x and Beyond):** 22 | As Guida evolves, we will introduce new features and improvements. 23 | This phase will foster a unified ecosystem that adapts to the needs of its users. 24 | 25 | **Core Principles:** 26 | 27 | - **Backward Compatibility:** Respect for existing Elm projects, ensuring a frictionless migration. 28 | - **Accessibility:** Lowering barriers for developers by implementing Guida’s core in its own syntax. 29 | 30 | Our ultimate goal is to create a language that inherits the best aspects of Elm while adapting and 31 | growing to meet the needs of its users. 32 | 33 | # Install 34 | 35 | To install Guida as an npm package, run the following command: 36 | 37 | ``` 38 | npm install -g guida 39 | ``` 40 | 41 | You should now be able to run `guida --version`. 42 | 43 | # Development 44 | 45 | Start by installing [Node Version Manager](https://github.com/nvm-sh/nvm). 46 | 47 | Switch to the correct node version number by running: 48 | 49 | ``` 50 | nvm use 51 | ``` 52 | 53 | Install the dependencies: 54 | 55 | ``` 56 | npm install 57 | ``` 58 | 59 | Generate guida: 60 | 61 | ``` 62 | npm run build 63 | ``` 64 | 65 | Link the project to run `guida` command: 66 | 67 | ``` 68 | npm link 69 | ``` 70 | 71 | You should now be able to run `guida`: 72 | 73 | ``` 74 | guida --help 75 | ``` 76 | 77 | To compare the performance of guida with elm, you can run `./scripts/performance-comparison.sh`. 78 | 79 | # Examples 80 | 81 | To run an example `cd` into the `examples` folder, and run the `guida make` command: 82 | 83 | ``` 84 | cd examples 85 | guida make --debug src/Hello.elm 86 | ``` 87 | 88 | You can then `open index.html`. 89 | 90 | # Try 91 | 92 | Find an example of how to use the browser version of the compiler on the [`try` folder](try/README.md). 93 | 94 | ## Clear cache 95 | 96 | To clear all cache and re-generate `./bin/guida.js` run the following: 97 | 98 | ``` 99 | rm -rf ~/.guida guida-stuff; npm run build 100 | ``` 101 | 102 | # Run tests 103 | 104 | Run all tests: 105 | 106 | ``` 107 | npm test 108 | ``` 109 | 110 | Run `jest` tests: 111 | 112 | ``` 113 | npm test:jest 114 | ``` 115 | 116 | Run `elm-test` tests: 117 | 118 | ``` 119 | npm run test:elm 120 | ``` 121 | 122 | Run `elm-review` tests: 123 | 124 | ``` 125 | npm run test:elm-review 126 | ``` 127 | 128 | Run `elm-format` validation: 129 | 130 | ``` 131 | npm run test:elm-format-validate 132 | ``` 133 | 134 | # Format elm source code 135 | 136 | ``` 137 | npm run elm-format 138 | ``` 139 | 140 | # Publish new npm package version 141 | 142 | Before publishing a new npm package version, make sure you are on the correct 143 | branch, ie. in case of wanting to publish a 0.x version, you should have the 144 | `v0.x` branch checked out. 145 | 146 | To publish a new version, we should then run the following commands: 147 | 148 | ``` 149 | npm version 150 | npm publish 151 | git push origin 152 | git push origin tag v 153 | ``` 154 | 155 | As an example, these should have been the commands ran for publishing `v0.2.0-alpha` 156 | 157 | ``` 158 | npm version 0.2.0-alpha 159 | npm publish 160 | git push origin v0.x 161 | git push origin tag v0.2.0-alpha 162 | ``` 163 | 164 | The `` value relates to the `version` field value found on `package.json`. 165 | 166 | # References 167 | 168 | - Initial transpilation from Haskell to Elm done based on [Elm compiler v0.19.1](https://github.com/elm/compiler/releases/tag/0.19.1) 169 | (more specifically [commit c9aefb6](https://github.com/elm/compiler/commit/c9aefb6230f5e0bda03205ab0499f6e4af924495)) 170 | - Terminal logic implementation based on https://github.com/albertdahlin/elm-posix 171 | 172 | # Resources 173 | 174 | - [Hoogle](https://hoogle.haskell.org/) 175 | - [Online Haskell Compiler](https://www.tutorialspoint.com/compile_haskell_online.php) 176 | -------------------------------------------------------------------------------- /assets/some-application/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.2", 10 | "elm/core": "1.0.5", 11 | "elm/html": "1.0.0" 12 | }, 13 | "indirect": { 14 | "elm/json": "1.1.3", 15 | "elm/time": "1.0.0", 16 | "elm/url": "1.0.0", 17 | "elm/virtual-dom": "1.0.3" 18 | } 19 | }, 20 | "test-dependencies": { 21 | "direct": {}, 22 | "indirect": {} 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /assets/some-application/src/ElmTupleN.elm: -------------------------------------------------------------------------------- 1 | module ElmTupleN exposing 2 | ( tuple2 3 | , tuple3 4 | , tuple4 5 | , tuple5 6 | , tuple6 7 | ) 8 | 9 | 10 | tuple2 : ( Int, Int ) 11 | tuple2 = 12 | ( 1, 2 ) 13 | 14 | 15 | tuple3 : ( Int, Int, Int ) 16 | tuple3 = 17 | ( 1, 2, 3 ) 18 | 19 | 20 | tuple4 : ( Int, Int, Int, Int ) 21 | tuple4 = 22 | ( 1, 2, 3, 4 ) 23 | 24 | 25 | tuple5 : ( Int, Int, Int, Int, Int ) 26 | tuple5 = 27 | ( 1, 2, 3, 4, 5 ) 28 | 29 | 30 | tuple6 : ( Int, Int, Int, Int, Int, Int ) 31 | tuple6 = 32 | ( 1, 2, 3, 4, 5, 6 ) 33 | -------------------------------------------------------------------------------- /assets/some-application/src/GuidaTupleN.guida: -------------------------------------------------------------------------------- 1 | module GuidaTupleN exposing 2 | ( tuple2 3 | , tuple3 4 | , tuple4 5 | , tuple5 6 | , tuple6 7 | ) 8 | 9 | 10 | tuple2 : ( Int, Int ) 11 | tuple2 = 12 | ( 1, 2 ) 13 | 14 | 15 | tuple3 : ( Int, Int, Int ) 16 | tuple3 = 17 | ( 1, 2, 3 ) 18 | 19 | 20 | tuple4 : ( Int, Int, Int, Int ) 21 | tuple4 = 22 | ( 1, 2, 3, 4 ) 23 | 24 | 25 | tuple5 : ( Int, Int, Int, Int, Int ) 26 | tuple5 = 27 | ( 1, 2, 3, 4, 5 ) 28 | 29 | 30 | tuple6 : ( Int, Int, Int, Int, Int, Int ) 31 | tuple6 = 32 | ( 1, 2, 3, 4, 5, 6 ) 33 | -------------------------------------------------------------------------------- /assets/some-application/src/Invalid.elm: -------------------------------------------------------------------------------- 1 | module Invalid exposing (..) 2 | -------------------------------------------------------------------------------- /assets/some-package/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "author/project", 4 | "summary": "Update this with a brief description before publishing.", 5 | "license": "BSD-3-Clause", 6 | "version": "1.0.0", 7 | "exposed-modules": [ 8 | "Main" 9 | ], 10 | "elm-version": "0.19.1 <= v < 0.20.0", 11 | "dependencies": { 12 | "elm/core": "1.0.5 <= v < 2.0.0" 13 | }, 14 | "test-dependencies": {} 15 | } -------------------------------------------------------------------------------- /assets/some-package/src/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (add1) 2 | 3 | {-| This library is a test library for testing the Elm compiler. 4 | 5 | 6 | # Example 7 | 8 | @docs add1 9 | 10 | -} 11 | 12 | 13 | {-| Add 1 to the given number. 14 | 15 | add1 2 == 3 16 | 17 | -} 18 | add1 : Int -> Int 19 | add1 x = 20 | x + 1 21 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "Janiczek/elm-vlq": "1.0.0", 10 | "dasch/levenshtein": "1.0.3", 11 | "elm/bytes": "1.0.8", 12 | "elm/core": "1.0.5", 13 | "elm/http": "2.0.0", 14 | "elm/json": "1.1.3", 15 | "elm/regex": "1.0.0", 16 | "elm/time": "1.0.0", 17 | "elm/url": "1.0.0", 18 | "elm-community/array-extra": "2.6.0", 19 | "elm-community/basics-extra": "4.1.0", 20 | "elm-community/list-extra": "8.7.0", 21 | "elm-community/maybe-extra": "5.3.0", 22 | "elm-community/result-extra": "2.4.0", 23 | "guida-lang/glsl": "1.0.0", 24 | "guida-lang/graph": "1.0.1", 25 | "jxxcarlson/hex": "4.0.1", 26 | "lue-bird/elm-syntax-format": "1.1.7", 27 | "obiloud/numeric-decimal": "3.0.1", 28 | "rtfeldman/elm-hex": "1.0.0", 29 | "stil4m/elm-syntax": "7.3.8", 30 | "the-sett/elm-pretty-printer": "3.1.0", 31 | "truqu/elm-base64": "2.0.4" 32 | }, 33 | "indirect": { 34 | "andre-dietrich/parser-combinators": "4.1.0", 35 | "elm/file": "1.0.5", 36 | "elm/parser": "1.1.0", 37 | "fredcy/elm-parseint": "2.0.1", 38 | "miniBill/elm-unicode": "1.1.1", 39 | "pilatch/flip": "1.0.0", 40 | "stil4m/structured-writer": "1.0.3", 41 | "zwilias/elm-rosetree": "1.5.0" 42 | } 43 | }, 44 | "test-dependencies": { 45 | "direct": { 46 | "elm-explorations/test": "2.2.0" 47 | }, 48 | "indirect": { 49 | "elm/html": "1.0.0", 50 | "elm/random": "1.0.0", 51 | "elm/virtual-dom": "1.0.3" 52 | } 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /eslint.config.mjs: -------------------------------------------------------------------------------- 1 | import { defineConfig, globalIgnores } from "eslint/config"; 2 | import globals from "globals"; 3 | import js from "@eslint/js"; 4 | import pluginJest from "eslint-plugin-jest"; 5 | 6 | 7 | export default defineConfig([ 8 | globalIgnores([ 9 | "bin/guida.js", 10 | "bin/guida.min.js", 11 | "lib/guida.browser.js", 12 | "lib/guida.browser.min.js", 13 | "lib/guida.node.js", 14 | "lib/guida.node.min.js", 15 | "elm-stuff", 16 | "guida-stuff", 17 | ]), 18 | { files: ["**/*.{js,mjs,cjs}"] }, 19 | { files: ["**/*.js"], languageOptions: { sourceType: "commonjs" } }, 20 | { files: ["bin/**/*.{js,mjs,cjs}"], languageOptions: { globals: globals.node } }, 21 | { files: ["lib/browser.js"], languageOptions: { globals: globals.browser } }, 22 | { files: ["lib/node.js"], languageOptions: { globals: globals.node } }, 23 | { files: ["try/**/*.{js,mjs,cjs}"], languageOptions: { globals: { ...globals.browser, ...globals.node } } }, 24 | { 25 | files: ["**/*.{js,mjs,cjs}"], 26 | plugins: { js }, 27 | extends: ["js/recommended"], 28 | rules: { 29 | "no-unused-vars": ["error", { 30 | "argsIgnorePattern": "^_", 31 | "caughtErrorsIgnorePattern": "^_" 32 | }] 33 | } 34 | }, 35 | { 36 | files: ["**/*.test.js"], 37 | plugins: { jest: pluginJest }, 38 | languageOptions: { 39 | globals: { ...globals.node, ...pluginJest.environments.globals.globals }, 40 | }, 41 | rules: { 42 | "no-empty": ["error", { "allowEmptyCatch": true }], 43 | "jest/no-disabled-tests": "warn", 44 | "jest/no-focused-tests": "error", 45 | "jest/no-identical-title": "error", 46 | "jest/prefer-to-have-length": "warn", 47 | "jest/valid-expect": "error", 48 | }, 49 | }, 50 | ]); -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.2", 10 | "elm/core": "1.0.5", 11 | "elm/file": "1.0.5", 12 | "elm/html": "1.0.0", 13 | "elm/http": "2.0.0", 14 | "elm/json": "1.1.3", 15 | "elm/random": "1.0.0", 16 | "elm/svg": "1.0.1", 17 | "elm/time": "1.0.0", 18 | "elm-explorations/linear-algebra": "1.0.3", 19 | "elm-explorations/webgl": "1.1.3", 20 | "evancz/elm-playground": "1.0.3" 21 | }, 22 | "indirect": { 23 | "elm/bytes": "1.0.8", 24 | "elm/url": "1.0.0", 25 | "elm/virtual-dom": "1.0.3" 26 | } 27 | }, 28 | "test-dependencies": { 29 | "direct": {}, 30 | "indirect": {} 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /examples/src/Animation.elm: -------------------------------------------------------------------------------- 1 | module Animation exposing (main) 2 | 3 | -- Create animations that spin, wave, and zig-zag. 4 | -- This one is a little red wagon bumping along a dirt road. 5 | -- 6 | -- Learn more about the playground here: 7 | -- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ 8 | -- 9 | 10 | import Playground exposing (..) 11 | 12 | 13 | main = 14 | animation view 15 | 16 | 17 | view time = 18 | [ octagon darkGray 36 19 | |> moveLeft 100 20 | |> rotate (spin 3 time) 21 | , octagon darkGray 36 22 | |> moveRight 100 23 | |> rotate (spin 3 time) 24 | , rectangle red 300 80 25 | |> moveUp (wave 50 54 2 time) 26 | |> rotate (zigzag -2 2 8 time) 27 | ] 28 | -------------------------------------------------------------------------------- /examples/src/Book.elm: -------------------------------------------------------------------------------- 1 | module Book exposing (main) 2 | 3 | -- Make a GET request to load a book called "Public Opinion" 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/effects/http.html 7 | -- 8 | 9 | import Browser 10 | import Html exposing (Html, pre, text) 11 | import Http 12 | 13 | 14 | 15 | -- MAIN 16 | 17 | 18 | main = 19 | Browser.element 20 | { init = init 21 | , update = update 22 | , subscriptions = subscriptions 23 | , view = view 24 | } 25 | 26 | 27 | 28 | -- MODEL 29 | 30 | 31 | type Model 32 | = Failure 33 | | Loading 34 | | Success String 35 | 36 | 37 | init : () -> ( Model, Cmd Msg ) 38 | init _ = 39 | ( Loading 40 | , Http.get 41 | { url = "https://elm-lang.org/assets/public-opinion.txt" 42 | , expect = Http.expectString GotText 43 | } 44 | ) 45 | 46 | 47 | 48 | -- UPDATE 49 | 50 | 51 | type Msg 52 | = GotText (Result Http.Error String) 53 | 54 | 55 | update : Msg -> Model -> ( Model, Cmd Msg ) 56 | update msg model = 57 | case msg of 58 | GotText result -> 59 | case result of 60 | Ok fullText -> 61 | ( Success fullText, Cmd.none ) 62 | 63 | Err _ -> 64 | ( Failure, Cmd.none ) 65 | 66 | 67 | 68 | -- SUBSCRIPTIONS 69 | 70 | 71 | subscriptions : Model -> Sub Msg 72 | subscriptions model = 73 | Sub.none 74 | 75 | 76 | 77 | -- VIEW 78 | 79 | 80 | view : Model -> Html Msg 81 | view model = 82 | case model of 83 | Failure -> 84 | text "I was unable to load your book." 85 | 86 | Loading -> 87 | text "Loading..." 88 | 89 | Success fullText -> 90 | pre [] [ text fullText ] 91 | -------------------------------------------------------------------------------- /examples/src/Buttons.elm: -------------------------------------------------------------------------------- 1 | module Buttons exposing (main) 2 | 3 | -- Press buttons to increment and decrement a counter. 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/architecture/buttons.html 7 | -- 8 | 9 | import Browser 10 | import Html exposing (Html, button, div, text) 11 | import Html.Events exposing (onClick) 12 | 13 | 14 | 15 | -- MAIN 16 | 17 | 18 | main = 19 | Browser.sandbox { init = init, update = update, view = view } 20 | 21 | 22 | 23 | -- MODEL 24 | 25 | 26 | type alias Model = 27 | Int 28 | 29 | 30 | init : Model 31 | init = 32 | 0 33 | 34 | 35 | 36 | -- UPDATE 37 | 38 | 39 | type Msg 40 | = Increment 41 | | Decrement 42 | 43 | 44 | update : Msg -> Model -> Model 45 | update msg model = 46 | case msg of 47 | Increment -> 48 | model + 1 49 | 50 | Decrement -> 51 | model - 1 52 | 53 | 54 | 55 | -- VIEW 56 | 57 | 58 | view : Model -> Html Msg 59 | view model = 60 | div [] 61 | [ button [ onClick Decrement ] [ text "-" ] 62 | , div [] [ text (String.fromInt model) ] 63 | , button [ onClick Increment ] [ text "+" ] 64 | ] 65 | -------------------------------------------------------------------------------- /examples/src/Cards.elm: -------------------------------------------------------------------------------- 1 | module Cards exposing (main) 2 | 3 | -- Press a button to draw a random card. 4 | -- 5 | -- Dependencies: 6 | -- elm install elm/random 7 | -- 8 | 9 | import Browser 10 | import Html exposing (..) 11 | import Html.Attributes exposing (style) 12 | import Html.Events exposing (..) 13 | import Random 14 | 15 | 16 | 17 | -- MAIN 18 | 19 | 20 | main = 21 | Browser.element 22 | { init = init 23 | , update = update 24 | , subscriptions = subscriptions 25 | , view = view 26 | } 27 | 28 | 29 | 30 | -- MODEL 31 | 32 | 33 | type alias Model = 34 | { card : Card 35 | } 36 | 37 | 38 | init : () -> ( Model, Cmd Msg ) 39 | init _ = 40 | ( Model Three 41 | , Cmd.none 42 | ) 43 | 44 | 45 | type Card 46 | = Ace 47 | | Two 48 | | Three 49 | | Four 50 | | Five 51 | | Six 52 | | Seven 53 | | Eight 54 | | Nine 55 | | Ten 56 | | Jack 57 | | Queen 58 | | King 59 | 60 | 61 | 62 | -- UPDATE 63 | 64 | 65 | type Msg 66 | = Draw 67 | | NewCard Card 68 | 69 | 70 | update : Msg -> Model -> ( Model, Cmd Msg ) 71 | update msg model = 72 | case msg of 73 | Draw -> 74 | ( model 75 | , Random.generate NewCard cardGenerator 76 | ) 77 | 78 | NewCard newCard -> 79 | ( Model newCard 80 | , Cmd.none 81 | ) 82 | 83 | 84 | cardGenerator : Random.Generator Card 85 | cardGenerator = 86 | Random.uniform Ace 87 | [ Two 88 | , Three 89 | , Four 90 | , Five 91 | , Six 92 | , Seven 93 | , Eight 94 | , Nine 95 | , Ten 96 | , Jack 97 | , Queen 98 | , King 99 | ] 100 | 101 | 102 | 103 | -- SUBSCRIPTIONS 104 | 105 | 106 | subscriptions : Model -> Sub Msg 107 | subscriptions model = 108 | Sub.none 109 | 110 | 111 | 112 | -- VIEW 113 | 114 | 115 | view : Model -> Html Msg 116 | view model = 117 | div [] 118 | [ button [ onClick Draw ] [ text "Draw" ] 119 | , div [ style "font-size" "12em" ] [ text (viewCard model.card) ] 120 | ] 121 | 122 | 123 | viewCard : Card -> String 124 | viewCard card = 125 | case card of 126 | Ace -> 127 | "🂡" 128 | 129 | Two -> 130 | "🂢" 131 | 132 | Three -> 133 | "🂣" 134 | 135 | Four -> 136 | "🂤" 137 | 138 | Five -> 139 | "🂥" 140 | 141 | Six -> 142 | "🂦" 143 | 144 | Seven -> 145 | "🂧" 146 | 147 | Eight -> 148 | "🂨" 149 | 150 | Nine -> 151 | "🂩" 152 | 153 | Ten -> 154 | "🂪" 155 | 156 | Jack -> 157 | "🂫" 158 | 159 | Queen -> 160 | "🂭" 161 | 162 | King -> 163 | "🂮" 164 | -------------------------------------------------------------------------------- /examples/src/Clock.elm: -------------------------------------------------------------------------------- 1 | module Clock exposing (main) 2 | 3 | -- Show an analog clock for your time zone. 4 | -- 5 | -- Dependencies: 6 | -- elm install elm/svg 7 | -- elm install elm/time 8 | -- 9 | -- For a simpler version, check out: 10 | -- https://elm-lang.org/examples/time 11 | -- 12 | 13 | import Browser 14 | import Html exposing (Html) 15 | import Svg exposing (..) 16 | import Svg.Attributes exposing (..) 17 | import Task 18 | import Time 19 | 20 | 21 | 22 | -- MAIN 23 | 24 | 25 | main = 26 | Browser.element 27 | { init = init 28 | , view = view 29 | , update = update 30 | , subscriptions = subscriptions 31 | } 32 | 33 | 34 | 35 | -- MODEL 36 | 37 | 38 | type alias Model = 39 | { zone : Time.Zone 40 | , time : Time.Posix 41 | } 42 | 43 | 44 | init : () -> ( Model, Cmd Msg ) 45 | init _ = 46 | ( Model Time.utc (Time.millisToPosix 0) 47 | , Cmd.batch 48 | [ Task.perform AdjustTimeZone Time.here 49 | , Task.perform Tick Time.now 50 | ] 51 | ) 52 | 53 | 54 | 55 | -- UPDATE 56 | 57 | 58 | type Msg 59 | = Tick Time.Posix 60 | | AdjustTimeZone Time.Zone 61 | 62 | 63 | update : Msg -> Model -> ( Model, Cmd Msg ) 64 | update msg model = 65 | case msg of 66 | Tick newTime -> 67 | ( { model | time = newTime } 68 | , Cmd.none 69 | ) 70 | 71 | AdjustTimeZone newZone -> 72 | ( { model | zone = newZone } 73 | , Cmd.none 74 | ) 75 | 76 | 77 | 78 | -- SUBSCRIPTIONS 79 | 80 | 81 | subscriptions : Model -> Sub Msg 82 | subscriptions model = 83 | Time.every 1000 Tick 84 | 85 | 86 | 87 | -- VIEW 88 | 89 | 90 | view : Model -> Html Msg 91 | view model = 92 | let 93 | hour = 94 | toFloat (Time.toHour model.zone model.time) 95 | 96 | minute = 97 | toFloat (Time.toMinute model.zone model.time) 98 | 99 | second = 100 | toFloat (Time.toSecond model.zone model.time) 101 | in 102 | svg 103 | [ viewBox "0 0 400 400" 104 | , width "400" 105 | , height "400" 106 | ] 107 | [ circle [ cx "200", cy "200", r "120", fill "#1293D8" ] [] 108 | , viewHand 6 60 (hour / 12) 109 | , viewHand 6 90 (minute / 60) 110 | , viewHand 3 90 (second / 60) 111 | ] 112 | 113 | 114 | viewHand : Int -> Float -> Float -> Svg msg 115 | viewHand width length turns = 116 | let 117 | t = 118 | 2 * pi * (turns - 0.25) 119 | 120 | x = 121 | 200 + length * cos t 122 | 123 | y = 124 | 200 + length * sin t 125 | in 126 | line 127 | [ x1 "200" 128 | , y1 "200" 129 | , x2 (String.fromFloat x) 130 | , y2 (String.fromFloat y) 131 | , stroke "white" 132 | , strokeWidth (String.fromInt width) 133 | , strokeLinecap "round" 134 | ] 135 | [] 136 | -------------------------------------------------------------------------------- /examples/src/Cube.elm: -------------------------------------------------------------------------------- 1 | module Cube exposing (main) 2 | 3 | -- Render a spinning cube. 4 | -- 5 | -- Dependencies: 6 | -- elm install elm-explorations/linear-algebra 7 | -- elm install elm-explorations/webgl 8 | -- 9 | 10 | import Browser 11 | import Browser.Events as E 12 | import Html exposing (Html) 13 | import Html.Attributes exposing (height, style, width) 14 | import Math.Matrix4 as Mat4 exposing (Mat4) 15 | import Math.Vector3 as Vec3 exposing (Vec3, vec3) 16 | import WebGL 17 | 18 | 19 | 20 | -- MAIN 21 | 22 | 23 | main = 24 | Browser.element 25 | { init = init 26 | , view = view 27 | , update = update 28 | , subscriptions = subscriptions 29 | } 30 | 31 | 32 | 33 | -- MODEL 34 | 35 | 36 | type alias Model = 37 | Float 38 | 39 | 40 | init : () -> ( Model, Cmd Msg ) 41 | init () = 42 | ( 0, Cmd.none ) 43 | 44 | 45 | 46 | -- UPDATE 47 | 48 | 49 | type Msg 50 | = TimeDelta Float 51 | 52 | 53 | update : Msg -> Model -> ( Model, Cmd Msg ) 54 | update msg angle = 55 | case msg of 56 | TimeDelta dt -> 57 | ( angle + dt / 5000, Cmd.none ) 58 | 59 | 60 | 61 | -- SUBSCRIPTIONS 62 | 63 | 64 | subscriptions : Model -> Sub Msg 65 | subscriptions _ = 66 | E.onAnimationFrameDelta TimeDelta 67 | 68 | 69 | 70 | -- VIEW 71 | 72 | 73 | view : Model -> Html Msg 74 | view angle = 75 | WebGL.toHtml 76 | [ width 400 77 | , height 400 78 | , style "display" "block" 79 | ] 80 | [ WebGL.entity vertexShader fragmentShader cubeMesh (uniforms angle) 81 | ] 82 | 83 | 84 | type alias Uniforms = 85 | { rotation : Mat4 86 | , perspective : Mat4 87 | , camera : Mat4 88 | } 89 | 90 | 91 | uniforms : Float -> Uniforms 92 | uniforms angle = 93 | { rotation = 94 | Mat4.mul 95 | (Mat4.makeRotate (3 * angle) (vec3 0 1 0)) 96 | (Mat4.makeRotate (2 * angle) (vec3 1 0 0)) 97 | , perspective = Mat4.makePerspective 45 1 0.01 100 98 | , camera = Mat4.makeLookAt (vec3 0 0 5) (vec3 0 0 0) (vec3 0 1 0) 99 | } 100 | 101 | 102 | 103 | -- MESH 104 | 105 | 106 | type alias Vertex = 107 | { color : Vec3 108 | , position : Vec3 109 | } 110 | 111 | 112 | cubeMesh : WebGL.Mesh Vertex 113 | cubeMesh = 114 | let 115 | rft = 116 | vec3 1 1 1 117 | 118 | lft = 119 | vec3 -1 1 1 120 | 121 | lbt = 122 | vec3 -1 -1 1 123 | 124 | rbt = 125 | vec3 1 -1 1 126 | 127 | rbb = 128 | vec3 1 -1 -1 129 | 130 | rfb = 131 | vec3 1 1 -1 132 | 133 | lfb = 134 | vec3 -1 1 -1 135 | 136 | lbb = 137 | vec3 -1 -1 -1 138 | in 139 | WebGL.triangles <| 140 | List.concat <| 141 | [ face (vec3 115 210 22) rft rfb rbb rbt -- green 142 | , face (vec3 52 101 164) rft rfb lfb lft -- blue 143 | , face (vec3 237 212 0) rft lft lbt rbt -- yellow 144 | , face (vec3 204 0 0) rfb lfb lbb rbb -- red 145 | , face (vec3 117 80 123) lft lfb lbb lbt -- purple 146 | , face (vec3 245 121 0) rbt rbb lbb lbt -- orange 147 | ] 148 | 149 | 150 | face : Vec3 -> Vec3 -> Vec3 -> Vec3 -> Vec3 -> List ( Vertex, Vertex, Vertex ) 151 | face color a b c d = 152 | let 153 | vertex position = 154 | Vertex (Vec3.scale (1 / 255) color) position 155 | in 156 | [ ( vertex a, vertex b, vertex c ) 157 | , ( vertex c, vertex d, vertex a ) 158 | ] 159 | 160 | 161 | 162 | -- SHADERS 163 | 164 | 165 | vertexShader : WebGL.Shader Vertex Uniforms { vcolor : Vec3 } 166 | vertexShader = 167 | [glsl| 168 | attribute vec3 position; 169 | attribute vec3 color; 170 | uniform mat4 perspective; 171 | uniform mat4 camera; 172 | uniform mat4 rotation; 173 | varying vec3 vcolor; 174 | void main () { 175 | gl_Position = perspective * camera * rotation * vec4(position, 1.0); 176 | vcolor = color; 177 | } 178 | |] 179 | 180 | 181 | fragmentShader : WebGL.Shader {} Uniforms { vcolor : Vec3 } 182 | fragmentShader = 183 | [glsl| 184 | precision mediump float; 185 | varying vec3 vcolor; 186 | void main () { 187 | gl_FragColor = 0.8 * vec4(vcolor, 1.0); 188 | } 189 | |] 190 | -------------------------------------------------------------------------------- /examples/src/CurrentTime.elm: -------------------------------------------------------------------------------- 1 | module CurrentTime exposing (main) 2 | 3 | -- Show the current time in your time zone. 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/effects/time.html 7 | -- 8 | -- For an analog clock, check out this SVG example: 9 | -- https://elm-lang.org/examples/clock 10 | -- 11 | 12 | import Browser 13 | import Html exposing (..) 14 | import Task 15 | import Time 16 | 17 | 18 | 19 | -- MAIN 20 | 21 | 22 | main = 23 | Browser.element 24 | { init = init 25 | , view = view 26 | , update = update 27 | , subscriptions = subscriptions 28 | } 29 | 30 | 31 | 32 | -- MODEL 33 | 34 | 35 | type alias Model = 36 | { zone : Time.Zone 37 | , time : Time.Posix 38 | } 39 | 40 | 41 | init : () -> ( Model, Cmd Msg ) 42 | init _ = 43 | ( Model Time.utc (Time.millisToPosix 0) 44 | , Task.perform AdjustTimeZone Time.here 45 | ) 46 | 47 | 48 | 49 | -- UPDATE 50 | 51 | 52 | type Msg 53 | = Tick Time.Posix 54 | | AdjustTimeZone Time.Zone 55 | 56 | 57 | update : Msg -> Model -> ( Model, Cmd Msg ) 58 | update msg model = 59 | case msg of 60 | Tick newTime -> 61 | ( { model | time = newTime } 62 | , Cmd.none 63 | ) 64 | 65 | AdjustTimeZone newZone -> 66 | ( { model | zone = newZone } 67 | , Cmd.none 68 | ) 69 | 70 | 71 | 72 | -- SUBSCRIPTIONS 73 | 74 | 75 | subscriptions : Model -> Sub Msg 76 | subscriptions model = 77 | Time.every 1000 Tick 78 | 79 | 80 | 81 | -- VIEW 82 | 83 | 84 | view : Model -> Html Msg 85 | view model = 86 | let 87 | hour = 88 | String.fromInt (Time.toHour model.zone model.time) 89 | 90 | minute = 91 | String.fromInt (Time.toMinute model.zone model.time) 92 | 93 | second = 94 | String.fromInt (Time.toSecond model.zone model.time) 95 | in 96 | h1 [] [ text (hour ++ ":" ++ minute ++ ":" ++ second) ] 97 | -------------------------------------------------------------------------------- /examples/src/DragAndDrop.elm: -------------------------------------------------------------------------------- 1 | module DragAndDrop exposing (main) 2 | 3 | -- Image upload with a drag and drop zone. 4 | -- 5 | -- Dependencies: 6 | -- elm install elm/file 7 | -- elm install elm/json 8 | -- 9 | 10 | import Browser 11 | import File exposing (File) 12 | import File.Select as Select 13 | import Html exposing (..) 14 | import Html.Attributes exposing (..) 15 | import Html.Events exposing (..) 16 | import Json.Decode as D 17 | 18 | 19 | 20 | -- MAIN 21 | 22 | 23 | main = 24 | Browser.element 25 | { init = init 26 | , view = view 27 | , update = update 28 | , subscriptions = subscriptions 29 | } 30 | 31 | 32 | 33 | -- MODEL 34 | 35 | 36 | type alias Model = 37 | { hover : Bool 38 | , files : List File 39 | } 40 | 41 | 42 | init : () -> ( Model, Cmd Msg ) 43 | init _ = 44 | ( Model False [], Cmd.none ) 45 | 46 | 47 | 48 | -- UPDATE 49 | 50 | 51 | type Msg 52 | = Pick 53 | | DragEnter 54 | | DragLeave 55 | | GotFiles File (List File) 56 | 57 | 58 | update : Msg -> Model -> ( Model, Cmd Msg ) 59 | update msg model = 60 | case msg of 61 | Pick -> 62 | ( model 63 | , Select.files [ "image/*" ] GotFiles 64 | ) 65 | 66 | DragEnter -> 67 | ( { model | hover = True } 68 | , Cmd.none 69 | ) 70 | 71 | DragLeave -> 72 | ( { model | hover = False } 73 | , Cmd.none 74 | ) 75 | 76 | GotFiles file files -> 77 | ( { model 78 | | files = file :: files 79 | , hover = False 80 | } 81 | , Cmd.none 82 | ) 83 | 84 | 85 | 86 | -- SUBSCRIPTIONS 87 | 88 | 89 | subscriptions : Model -> Sub Msg 90 | subscriptions model = 91 | Sub.none 92 | 93 | 94 | 95 | -- VIEW 96 | 97 | 98 | view : Model -> Html Msg 99 | view model = 100 | div 101 | [ style "border" 102 | (if model.hover then 103 | "6px dashed purple" 104 | 105 | else 106 | "6px dashed #ccc" 107 | ) 108 | , style "border-radius" "20px" 109 | , style "width" "480px" 110 | , style "height" "100px" 111 | , style "margin" "100px auto" 112 | , style "padding" "20px" 113 | , style "display" "flex" 114 | , style "flex-direction" "column" 115 | , style "justify-content" "center" 116 | , style "align-items" "center" 117 | , hijackOn "dragenter" (D.succeed DragEnter) 118 | , hijackOn "dragover" (D.succeed DragEnter) 119 | , hijackOn "dragleave" (D.succeed DragLeave) 120 | , hijackOn "drop" dropDecoder 121 | ] 122 | [ button [ onClick Pick ] [ text "Upload Images" ] 123 | , span [ style "color" "#ccc" ] [ text (Debug.toString model) ] 124 | ] 125 | 126 | 127 | dropDecoder : D.Decoder Msg 128 | dropDecoder = 129 | D.at [ "dataTransfer", "files" ] (D.oneOrMore GotFiles File.decoder) 130 | 131 | 132 | hijackOn : String -> D.Decoder msg -> Attribute msg 133 | hijackOn event decoder = 134 | preventDefaultOn event (D.map hijack decoder) 135 | 136 | 137 | hijack : msg -> ( msg, Bool ) 138 | hijack msg = 139 | ( msg, True ) 140 | -------------------------------------------------------------------------------- /examples/src/Forms.elm: -------------------------------------------------------------------------------- 1 | module Forms exposing (main) 2 | 3 | -- Input a user name and password. Make sure the password matches. 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/architecture/forms.html 7 | -- 8 | 9 | import Browser 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (onInput) 13 | 14 | 15 | 16 | -- MAIN 17 | 18 | 19 | main = 20 | Browser.sandbox { init = init, update = update, view = view } 21 | 22 | 23 | 24 | -- MODEL 25 | 26 | 27 | type alias Model = 28 | { name : String 29 | , password : String 30 | , passwordAgain : String 31 | } 32 | 33 | 34 | init : Model 35 | init = 36 | Model "" "" "" 37 | 38 | 39 | 40 | -- UPDATE 41 | 42 | 43 | type Msg 44 | = Name String 45 | | Password String 46 | | PasswordAgain String 47 | 48 | 49 | update : Msg -> Model -> Model 50 | update msg model = 51 | case msg of 52 | Name name -> 53 | { model | name = name } 54 | 55 | Password password -> 56 | { model | password = password } 57 | 58 | PasswordAgain password -> 59 | { model | passwordAgain = password } 60 | 61 | 62 | 63 | -- VIEW 64 | 65 | 66 | view : Model -> Html Msg 67 | view model = 68 | div [] 69 | [ viewInput "text" "Name" model.name Name 70 | , viewInput "password" "Password" model.password Password 71 | , viewInput "password" "Re-enter Password" model.passwordAgain PasswordAgain 72 | , viewValidation model 73 | ] 74 | 75 | 76 | viewInput : String -> String -> String -> (String -> msg) -> Html msg 77 | viewInput t p v toMsg = 78 | input [ type_ t, placeholder p, value v, onInput toMsg ] [] 79 | 80 | 81 | viewValidation : Model -> Html msg 82 | viewValidation model = 83 | if model.password == model.passwordAgain then 84 | div [ style "color" "green" ] [ text "OK" ] 85 | 86 | else 87 | div [ style "color" "red" ] [ text "Passwords do not match!" ] 88 | -------------------------------------------------------------------------------- /examples/src/Groceries.elm: -------------------------------------------------------------------------------- 1 | module Groceries exposing (main) 2 | 3 | -- Show a list of items I need to buy at the grocery store. 4 | -- 5 | 6 | import Html exposing (..) 7 | 8 | 9 | main = 10 | div [] 11 | [ h1 [] [ text "My Grocery List" ] 12 | , ul [] 13 | [ li [] [ text "Black Beans" ] 14 | , li [] [ text "Limes" ] 15 | , li [] [ text "Greek Yogurt" ] 16 | , li [] [ text "Cilantro" ] 17 | , li [] [ text "Honey" ] 18 | , li [] [ text "Sweet Potatoes" ] 19 | , li [] [ text "Cumin" ] 20 | , li [] [ text "Chili Powder" ] 21 | , li [] [ text "Quinoa" ] 22 | ] 23 | ] 24 | -------------------------------------------------------------------------------- /examples/src/Hello.elm: -------------------------------------------------------------------------------- 1 | module Hello exposing (main) 2 | 3 | import Html exposing (text) 4 | 5 | 6 | main = 7 | text "Hello!" 8 | -------------------------------------------------------------------------------- /examples/src/ImagePreviews.elm: -------------------------------------------------------------------------------- 1 | module ImagePreviews exposing (main) 2 | 3 | -- Image upload with a drag and drop zone. See image previews! 4 | -- 5 | -- Dependencies: 6 | -- elm install elm/file 7 | -- elm install elm/json 8 | -- 9 | 10 | import Browser 11 | import File exposing (File) 12 | import File.Select as Select 13 | import Html exposing (..) 14 | import Html.Attributes exposing (..) 15 | import Html.Events exposing (..) 16 | import Json.Decode as D 17 | import Task 18 | 19 | 20 | 21 | -- MAIN 22 | 23 | 24 | main = 25 | Browser.element 26 | { init = init 27 | , view = view 28 | , update = update 29 | , subscriptions = subscriptions 30 | } 31 | 32 | 33 | 34 | -- MODEL 35 | 36 | 37 | type alias Model = 38 | { hover : Bool 39 | , previews : List String 40 | } 41 | 42 | 43 | init : () -> ( Model, Cmd Msg ) 44 | init _ = 45 | ( Model False [], Cmd.none ) 46 | 47 | 48 | 49 | -- UPDATE 50 | 51 | 52 | type Msg 53 | = Pick 54 | | DragEnter 55 | | DragLeave 56 | | GotFiles File (List File) 57 | | GotPreviews (List String) 58 | 59 | 60 | update : Msg -> Model -> ( Model, Cmd Msg ) 61 | update msg model = 62 | case msg of 63 | Pick -> 64 | ( model 65 | , Select.files [ "image/*" ] GotFiles 66 | ) 67 | 68 | DragEnter -> 69 | ( { model | hover = True } 70 | , Cmd.none 71 | ) 72 | 73 | DragLeave -> 74 | ( { model | hover = False } 75 | , Cmd.none 76 | ) 77 | 78 | GotFiles file files -> 79 | ( { model | hover = False } 80 | , Task.perform GotPreviews <| 81 | Task.sequence <| 82 | List.map File.toUrl (file :: files) 83 | ) 84 | 85 | GotPreviews urls -> 86 | ( { model | previews = urls } 87 | , Cmd.none 88 | ) 89 | 90 | 91 | 92 | -- SUBSCRIPTIONS 93 | 94 | 95 | subscriptions : Model -> Sub Msg 96 | subscriptions model = 97 | Sub.none 98 | 99 | 100 | 101 | -- VIEW 102 | 103 | 104 | view : Model -> Html Msg 105 | view model = 106 | div 107 | [ style "border" 108 | (if model.hover then 109 | "6px dashed purple" 110 | 111 | else 112 | "6px dashed #ccc" 113 | ) 114 | , style "border-radius" "20px" 115 | , style "width" "480px" 116 | , style "margin" "100px auto" 117 | , style "padding" "40px" 118 | , style "display" "flex" 119 | , style "flex-direction" "column" 120 | , style "justify-content" "center" 121 | , style "align-items" "center" 122 | , hijackOn "dragenter" (D.succeed DragEnter) 123 | , hijackOn "dragover" (D.succeed DragEnter) 124 | , hijackOn "dragleave" (D.succeed DragLeave) 125 | , hijackOn "drop" dropDecoder 126 | ] 127 | [ button [ onClick Pick ] [ text "Upload Images" ] 128 | , div 129 | [ style "display" "flex" 130 | , style "align-items" "center" 131 | , style "height" "60px" 132 | , style "padding" "20px" 133 | ] 134 | (List.map viewPreview model.previews) 135 | ] 136 | 137 | 138 | viewPreview : String -> Html msg 139 | viewPreview url = 140 | div 141 | [ style "width" "60px" 142 | , style "height" "60px" 143 | , style "background-image" ("url('" ++ url ++ "')") 144 | , style "background-position" "center" 145 | , style "background-repeat" "no-repeat" 146 | , style "background-size" "contain" 147 | ] 148 | [] 149 | 150 | 151 | dropDecoder : D.Decoder Msg 152 | dropDecoder = 153 | D.at [ "dataTransfer", "files" ] (D.oneOrMore GotFiles File.decoder) 154 | 155 | 156 | hijackOn : String -> D.Decoder msg -> Attribute msg 157 | hijackOn event decoder = 158 | preventDefaultOn event (D.map hijack decoder) 159 | 160 | 161 | hijack : msg -> ( msg, Bool ) 162 | hijack msg = 163 | ( msg, True ) 164 | -------------------------------------------------------------------------------- /examples/src/Keyboard.elm: -------------------------------------------------------------------------------- 1 | module Keyboard exposing (main) 2 | 3 | -- Move a square around with the arrow keys: UP, DOWN, LEFT, RIGHT 4 | -- Try making it move around more quickly! 5 | -- 6 | -- Learn more about the playground here: 7 | -- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ 8 | -- 9 | 10 | import Playground exposing (..) 11 | 12 | 13 | main = 14 | game view update ( 0, 0 ) 15 | 16 | 17 | view computer ( x, y ) = 18 | [ square blue 40 19 | |> move x y 20 | ] 21 | 22 | 23 | update computer ( x, y ) = 24 | ( x + toX computer.keyboard 25 | , y + toY computer.keyboard 26 | ) 27 | -------------------------------------------------------------------------------- /examples/src/Mario.elm: -------------------------------------------------------------------------------- 1 | module Mario exposing (main) 2 | 3 | -- Walk around with the arrow keys. Press the UP arrow to jump! 4 | -- 5 | -- Learn more about the playground here: 6 | -- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ 7 | -- 8 | 9 | import Playground exposing (..) 10 | 11 | 12 | 13 | -- MAIN 14 | 15 | 16 | main = 17 | game view 18 | update 19 | { x = 0 20 | , y = 0 21 | , vx = 0 22 | , vy = 0 23 | , dir = "right" 24 | } 25 | 26 | 27 | 28 | -- VIEW 29 | 30 | 31 | view computer mario = 32 | let 33 | w = 34 | computer.screen.width 35 | 36 | h = 37 | computer.screen.height 38 | 39 | b = 40 | computer.screen.bottom 41 | in 42 | [ rectangle (rgb 174 238 238) w h 43 | , rectangle (rgb 74 163 41) w 100 44 | |> moveY b 45 | , image 70 70 (toGif mario) 46 | |> move mario.x (b + 76 + mario.y) 47 | ] 48 | 49 | 50 | toGif mario = 51 | if mario.y > 0 then 52 | "https://elm-lang.org/images/mario/jump/" ++ mario.dir ++ ".gif" 53 | 54 | else if mario.vx /= 0 then 55 | "https://elm-lang.org/images/mario/walk/" ++ mario.dir ++ ".gif" 56 | 57 | else 58 | "https://elm-lang.org/images/mario/stand/" ++ mario.dir ++ ".gif" 59 | 60 | 61 | 62 | -- UPDATE 63 | 64 | 65 | update computer mario = 66 | let 67 | dt = 68 | 1.666 69 | 70 | vx = 71 | toX computer.keyboard 72 | 73 | vy = 74 | if mario.y == 0 then 75 | if computer.keyboard.up then 76 | 5 77 | 78 | else 79 | 0 80 | 81 | else 82 | mario.vy - dt / 8 83 | 84 | x = 85 | mario.x + dt * vx 86 | 87 | y = 88 | mario.y + dt * vy 89 | in 90 | { x = x 91 | , y = max 0 y 92 | , vx = vx 93 | , vy = vy 94 | , dir = 95 | if vx == 0 then 96 | mario.dir 97 | 98 | else if vx < 0 then 99 | "left" 100 | 101 | else 102 | "right" 103 | } 104 | -------------------------------------------------------------------------------- /examples/src/Mouse.elm: -------------------------------------------------------------------------------- 1 | module Mouse exposing (main) 2 | 3 | -- Draw a cicle around the mouse. Change its color by pressing down. 4 | -- 5 | -- Learn more about the playground here: 6 | -- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ 7 | -- 8 | 9 | import Playground exposing (..) 10 | 11 | 12 | main = 13 | game view update () 14 | 15 | 16 | view computer memory = 17 | [ circle lightPurple 30 18 | |> moveX computer.mouse.x 19 | |> moveY computer.mouse.y 20 | |> fade 21 | (if computer.mouse.down then 22 | 0.2 23 | 24 | else 25 | 1 26 | ) 27 | ] 28 | 29 | 30 | update computer memory = 31 | memory 32 | -------------------------------------------------------------------------------- /examples/src/Numbers.elm: -------------------------------------------------------------------------------- 1 | module Numbers exposing (main) 2 | 3 | -- Press a button to generate a random number between 1 and 6. 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/effects/random.html 7 | -- 8 | 9 | import Browser 10 | import Html exposing (..) 11 | import Html.Events exposing (..) 12 | import Random 13 | 14 | 15 | 16 | -- MAIN 17 | 18 | 19 | main = 20 | Browser.element 21 | { init = init 22 | , update = update 23 | , subscriptions = subscriptions 24 | , view = view 25 | } 26 | 27 | 28 | 29 | -- MODEL 30 | 31 | 32 | type alias Model = 33 | { dieFace : Int 34 | } 35 | 36 | 37 | init : () -> ( Model, Cmd Msg ) 38 | init _ = 39 | ( Model 1 40 | , Cmd.none 41 | ) 42 | 43 | 44 | 45 | -- UPDATE 46 | 47 | 48 | type Msg 49 | = Roll 50 | | NewFace Int 51 | 52 | 53 | update : Msg -> Model -> ( Model, Cmd Msg ) 54 | update msg model = 55 | case msg of 56 | Roll -> 57 | ( model 58 | , Random.generate NewFace (Random.int 1 6) 59 | ) 60 | 61 | NewFace newFace -> 62 | ( Model newFace 63 | , Cmd.none 64 | ) 65 | 66 | 67 | 68 | -- SUBSCRIPTIONS 69 | 70 | 71 | subscriptions : Model -> Sub Msg 72 | subscriptions model = 73 | Sub.none 74 | 75 | 76 | 77 | -- VIEW 78 | 79 | 80 | view : Model -> Html Msg 81 | view model = 82 | div [] 83 | [ h1 [] [ text (String.fromInt model.dieFace) ] 84 | , button [ onClick Roll ] [ text "Roll" ] 85 | ] 86 | -------------------------------------------------------------------------------- /examples/src/Picture.elm: -------------------------------------------------------------------------------- 1 | module Picture exposing (main) 2 | 3 | -- Create pictures from simple shapes. Like a tree! 4 | -- 5 | -- Learn more about the playground here: 6 | -- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ 7 | -- 8 | 9 | import Playground exposing (..) 10 | 11 | 12 | main = 13 | picture 14 | [ rectangle brown 40 200 15 | |> moveDown 80 16 | , circle green 100 17 | |> moveUp 100 18 | ] 19 | -------------------------------------------------------------------------------- /examples/src/Positions.elm: -------------------------------------------------------------------------------- 1 | module Positions exposing (main) 2 | 3 | -- A button that moves to random positions when pressed. 4 | -- 5 | -- Dependencies: 6 | -- elm install elm/random 7 | -- 8 | 9 | import Browser 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (..) 13 | import Random 14 | 15 | 16 | 17 | -- MAIN 18 | 19 | 20 | main = 21 | Browser.element 22 | { init = init 23 | , update = update 24 | , subscriptions = subscriptions 25 | , view = view 26 | } 27 | 28 | 29 | 30 | -- MODEL 31 | 32 | 33 | type alias Model = 34 | { x : Int 35 | , y : Int 36 | } 37 | 38 | 39 | init : () -> ( Model, Cmd Msg ) 40 | init _ = 41 | ( Model 100 100 42 | , Cmd.none 43 | ) 44 | 45 | 46 | 47 | -- UPDATE 48 | 49 | 50 | type Msg 51 | = Clicked 52 | | NewPosition ( Int, Int ) 53 | 54 | 55 | update : Msg -> Model -> ( Model, Cmd Msg ) 56 | update msg model = 57 | case msg of 58 | Clicked -> 59 | ( model 60 | , Random.generate NewPosition positionGenerator 61 | ) 62 | 63 | NewPosition ( x, y ) -> 64 | ( Model x y 65 | , Cmd.none 66 | ) 67 | 68 | 69 | positionGenerator : Random.Generator ( Int, Int ) 70 | positionGenerator = 71 | Random.map2 Tuple.pair 72 | (Random.int 50 350) 73 | (Random.int 50 350) 74 | 75 | 76 | 77 | -- SUBSCRIPTIONS 78 | 79 | 80 | subscriptions : Model -> Sub Msg 81 | subscriptions model = 82 | Sub.none 83 | 84 | 85 | 86 | -- VIEW 87 | 88 | 89 | view : Model -> Html Msg 90 | view model = 91 | button 92 | [ style "position" "absolute" 93 | , style "top" (String.fromInt model.x ++ "px") 94 | , style "left" (String.fromInt model.y ++ "px") 95 | , onClick Clicked 96 | ] 97 | [ text "Click me!" ] 98 | -------------------------------------------------------------------------------- /examples/src/Quotes.elm: -------------------------------------------------------------------------------- 1 | module Quotes exposing (main) 2 | 3 | -- Press a button to send a GET request for random quotes. 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/effects/json.html 7 | -- 8 | 9 | import Browser 10 | import Html exposing (..) 11 | import Html.Attributes exposing (style) 12 | import Html.Events exposing (..) 13 | import Http 14 | import Json.Decode exposing (Decoder, field, int, map4, string) 15 | 16 | 17 | 18 | -- MAIN 19 | 20 | 21 | main = 22 | Browser.element 23 | { init = init 24 | , update = update 25 | , subscriptions = subscriptions 26 | , view = view 27 | } 28 | 29 | 30 | 31 | -- MODEL 32 | 33 | 34 | type Model 35 | = Failure 36 | | Loading 37 | | Success Quote 38 | 39 | 40 | type alias Quote = 41 | { quote : String 42 | , source : String 43 | , author : String 44 | , year : Int 45 | } 46 | 47 | 48 | init : () -> ( Model, Cmd Msg ) 49 | init _ = 50 | ( Loading, getRandomQuote ) 51 | 52 | 53 | 54 | -- UPDATE 55 | 56 | 57 | type Msg 58 | = MorePlease 59 | | GotQuote (Result Http.Error Quote) 60 | 61 | 62 | update : Msg -> Model -> ( Model, Cmd Msg ) 63 | update msg model = 64 | case msg of 65 | MorePlease -> 66 | ( Loading, getRandomQuote ) 67 | 68 | GotQuote result -> 69 | case result of 70 | Ok quote -> 71 | ( Success quote, Cmd.none ) 72 | 73 | Err _ -> 74 | ( Failure, Cmd.none ) 75 | 76 | 77 | 78 | -- SUBSCRIPTIONS 79 | 80 | 81 | subscriptions : Model -> Sub Msg 82 | subscriptions model = 83 | Sub.none 84 | 85 | 86 | 87 | -- VIEW 88 | 89 | 90 | view : Model -> Html Msg 91 | view model = 92 | div [] 93 | [ h2 [] [ text "Random Quotes" ] 94 | , viewQuote model 95 | ] 96 | 97 | 98 | viewQuote : Model -> Html Msg 99 | viewQuote model = 100 | case model of 101 | Failure -> 102 | div [] 103 | [ text "I could not load a random quote for some reason. " 104 | , button [ onClick MorePlease ] [ text "Try Again!" ] 105 | ] 106 | 107 | Loading -> 108 | text "Loading..." 109 | 110 | Success quote -> 111 | div [] 112 | [ button [ onClick MorePlease, style "display" "block" ] [ text "More Please!" ] 113 | , blockquote [] [ text quote.quote ] 114 | , p [ style "text-align" "right" ] 115 | [ text "— " 116 | , cite [] [ text quote.source ] 117 | , text (" by " ++ quote.author ++ " (" ++ String.fromInt quote.year ++ ")") 118 | ] 119 | ] 120 | 121 | 122 | 123 | -- HTTP 124 | 125 | 126 | getRandomQuote : Cmd Msg 127 | getRandomQuote = 128 | Http.get 129 | { url = "https://elm-lang.org/api/random-quotes" 130 | , expect = Http.expectJson GotQuote quoteDecoder 131 | } 132 | 133 | 134 | quoteDecoder : Decoder Quote 135 | quoteDecoder = 136 | map4 Quote 137 | (field "quote" string) 138 | (field "source" string) 139 | (field "author" string) 140 | (field "year" int) 141 | -------------------------------------------------------------------------------- /examples/src/Shapes.elm: -------------------------------------------------------------------------------- 1 | module Shapes exposing (main) 2 | 3 | -- Scalable Vector Graphics (SVG) can be a nice way to draw things in 2D. 4 | -- Here are some common SVG shapes. 5 | -- 6 | -- Dependencies: 7 | -- elm install elm/svg 8 | -- 9 | 10 | import Html exposing (Html) 11 | import Svg exposing (..) 12 | import Svg.Attributes exposing (..) 13 | 14 | 15 | main : Html msg 16 | main = 17 | svg 18 | [ viewBox "0 0 400 400" 19 | , width "400" 20 | , height "400" 21 | ] 22 | [ circle 23 | [ cx "50" 24 | , cy "50" 25 | , r "40" 26 | , fill "red" 27 | , stroke "black" 28 | , strokeWidth "3" 29 | ] 30 | [] 31 | , rect 32 | [ x "100" 33 | , y "10" 34 | , width "40" 35 | , height "40" 36 | , fill "green" 37 | , stroke "black" 38 | , strokeWidth "2" 39 | ] 40 | [] 41 | , line 42 | [ x1 "20" 43 | , y1 "200" 44 | , x2 "200" 45 | , y2 "20" 46 | , stroke "blue" 47 | , strokeWidth "10" 48 | , strokeLinecap "round" 49 | ] 50 | [] 51 | , polyline 52 | [ points "200,40 240,40 240,80 280,80 280,120 320,120 320,160" 53 | , fill "none" 54 | , stroke "red" 55 | , strokeWidth "4" 56 | , strokeDasharray "20,2" 57 | ] 58 | [] 59 | , text_ 60 | [ x "130" 61 | , y "130" 62 | , fill "black" 63 | , textAnchor "middle" 64 | , dominantBaseline "central" 65 | , transform "rotate(-45 130,130)" 66 | ] 67 | [ text "Welcome to Shapes Club" 68 | ] 69 | ] 70 | 71 | 72 | 73 | -- There are a lot of odd things about SVG, so always try to find examples 74 | -- to help you understand the weird stuff. Like these: 75 | -- 76 | -- https://www.w3schools.com/graphics/svg_examples.asp 77 | -- https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d 78 | -- 79 | -- If you cannot find relevant examples, make an experiment. If you push 80 | -- through the weirdness, you can do a lot with SVG. 81 | -------------------------------------------------------------------------------- /examples/src/TextFields.elm: -------------------------------------------------------------------------------- 1 | module TextFields exposing (main) 2 | 3 | -- A text input for reversing text. Very useful! 4 | -- 5 | -- Read how it works: 6 | -- https://guide.elm-lang.org/architecture/text_fields.html 7 | -- 8 | 9 | import Browser 10 | import Html exposing (Attribute, Html, div, input, text) 11 | import Html.Attributes exposing (..) 12 | import Html.Events exposing (onInput) 13 | 14 | 15 | 16 | -- MAIN 17 | 18 | 19 | main = 20 | Browser.sandbox { init = init, update = update, view = view } 21 | 22 | 23 | 24 | -- MODEL 25 | 26 | 27 | type alias Model = 28 | { content : String 29 | } 30 | 31 | 32 | init : Model 33 | init = 34 | { content = "" } 35 | 36 | 37 | 38 | -- UPDATE 39 | 40 | 41 | type Msg 42 | = Change String 43 | 44 | 45 | update : Msg -> Model -> Model 46 | update msg model = 47 | case msg of 48 | Change newContent -> 49 | { model | content = newContent } 50 | 51 | 52 | 53 | -- VIEW 54 | 55 | 56 | view : Model -> Html Msg 57 | view model = 58 | div [] 59 | [ input [ placeholder "Text to reverse", value model.content, onInput Change ] [] 60 | , div [] [ text (String.reverse model.content) ] 61 | ] 62 | -------------------------------------------------------------------------------- /examples/src/Triangle.elm: -------------------------------------------------------------------------------- 1 | module Triangle exposing (main) 2 | 3 | -- elm install elm-explorations/linear-algebra 4 | -- elm install elm-explorations/webgl 5 | 6 | import Browser 7 | import Browser.Events as E 8 | import Html exposing (Html) 9 | import Html.Attributes exposing (height, style, width) 10 | import Math.Matrix4 as Mat4 exposing (Mat4) 11 | import Math.Vector3 as Vec3 exposing (Vec3, vec3) 12 | import WebGL 13 | 14 | 15 | 16 | -- MAIN 17 | 18 | 19 | main = 20 | Browser.element 21 | { init = init 22 | , view = view 23 | , update = update 24 | , subscriptions = subscriptions 25 | } 26 | 27 | 28 | 29 | -- MODEL 30 | 31 | 32 | type alias Model = 33 | Float 34 | 35 | 36 | init : () -> ( Model, Cmd Msg ) 37 | init () = 38 | ( 0, Cmd.none ) 39 | 40 | 41 | 42 | -- UPDATE 43 | 44 | 45 | type Msg 46 | = TimeDelta Float 47 | 48 | 49 | update : Msg -> Model -> ( Model, Cmd Msg ) 50 | update msg currentTime = 51 | case msg of 52 | TimeDelta delta -> 53 | ( delta + currentTime, Cmd.none ) 54 | 55 | 56 | 57 | -- SUBSCRIPTIONS 58 | 59 | 60 | subscriptions : Model -> Sub Msg 61 | subscriptions _ = 62 | E.onAnimationFrameDelta TimeDelta 63 | 64 | 65 | 66 | -- VIEW 67 | 68 | 69 | view : Model -> Html msg 70 | view t = 71 | WebGL.toHtml 72 | [ width 400 73 | , height 400 74 | , style "display" "block" 75 | ] 76 | [ WebGL.entity vertexShader fragmentShader mesh { perspective = perspective (t / 1000) } 77 | ] 78 | 79 | 80 | perspective : Float -> Mat4 81 | perspective t = 82 | Mat4.mul 83 | (Mat4.makePerspective 45 1 0.01 100) 84 | (Mat4.makeLookAt (vec3 (4 * cos t) 0 (4 * sin t)) (vec3 0 0 0) (vec3 0 1 0)) 85 | 86 | 87 | 88 | -- MESH 89 | 90 | 91 | type alias Vertex = 92 | { position : Vec3 93 | , color : Vec3 94 | } 95 | 96 | 97 | mesh : WebGL.Mesh Vertex 98 | mesh = 99 | WebGL.triangles 100 | [ ( Vertex (vec3 0 0 0) (vec3 1 0 0) 101 | , Vertex (vec3 1 1 0) (vec3 0 1 0) 102 | , Vertex (vec3 1 -1 0) (vec3 0 0 1) 103 | ) 104 | ] 105 | 106 | 107 | 108 | -- SHADERS 109 | 110 | 111 | type alias Uniforms = 112 | { perspective : Mat4 113 | } 114 | 115 | 116 | vertexShader : WebGL.Shader Vertex Uniforms { vcolor : Vec3 } 117 | vertexShader = 118 | [glsl| 119 | attribute vec3 position; 120 | attribute vec3 color; 121 | uniform mat4 perspective; 122 | varying vec3 vcolor; 123 | 124 | void main () { 125 | gl_Position = perspective * vec4(position, 1.0); 126 | vcolor = color; 127 | } 128 | |] 129 | 130 | 131 | fragmentShader : WebGL.Shader {} Uniforms { vcolor : Vec3 } 132 | fragmentShader = 133 | [glsl| 134 | precision mediump float; 135 | varying vec3 vcolor; 136 | 137 | void main () { 138 | gl_FragColor = vec4(vcolor, 1.0); 139 | } 140 | |] 141 | -------------------------------------------------------------------------------- /examples/src/Turtle.elm: -------------------------------------------------------------------------------- 1 | module Turtle exposing (main) 2 | 3 | -- Use arrow keys to move the turtle around. 4 | -- 5 | -- Forward with UP and turn with LEFT and RIGHT. 6 | -- 7 | -- Learn more about the playground here: 8 | -- https://package.elm-lang.org/packages/evancz/elm-playground/latest/ 9 | -- 10 | 11 | import Playground exposing (..) 12 | 13 | 14 | main = 15 | game view 16 | update 17 | { x = 0 18 | , y = 0 19 | , angle = 0 20 | } 21 | 22 | 23 | view computer turtle = 24 | [ rectangle blue computer.screen.width computer.screen.height 25 | , image 96 96 "https://elm-lang.org/images/turtle.gif" 26 | |> move turtle.x turtle.y 27 | |> rotate turtle.angle 28 | ] 29 | 30 | 31 | update computer turtle = 32 | { x = turtle.x + toY computer.keyboard * cos (degrees turtle.angle) 33 | , y = turtle.y + toY computer.keyboard * sin (degrees turtle.angle) 34 | , angle = turtle.angle - toX computer.keyboard 35 | } 36 | -------------------------------------------------------------------------------- /examples/src/Upload.elm: -------------------------------------------------------------------------------- 1 | module Upload exposing (main) 2 | 3 | -- File upload with the node. 4 | -- 5 | -- Dependencies: 6 | -- elm install elm/file 7 | -- elm install elm/json 8 | -- 9 | 10 | import Browser 11 | import File exposing (File) 12 | import Html exposing (..) 13 | import Html.Attributes exposing (..) 14 | import Html.Events exposing (..) 15 | import Json.Decode as D 16 | 17 | 18 | 19 | -- MAIN 20 | 21 | 22 | main = 23 | Browser.element 24 | { init = init 25 | , view = view 26 | , update = update 27 | , subscriptions = subscriptions 28 | } 29 | 30 | 31 | 32 | -- MODEL 33 | 34 | 35 | type alias Model = 36 | List File 37 | 38 | 39 | init : () -> ( Model, Cmd Msg ) 40 | init _ = 41 | ( [], Cmd.none ) 42 | 43 | 44 | 45 | -- UPDATE 46 | 47 | 48 | type Msg 49 | = GotFiles (List File) 50 | 51 | 52 | update : Msg -> Model -> ( Model, Cmd Msg ) 53 | update msg model = 54 | case msg of 55 | GotFiles files -> 56 | ( files, Cmd.none ) 57 | 58 | 59 | 60 | -- SUBSCRIPTIONS 61 | 62 | 63 | subscriptions : Model -> Sub Msg 64 | subscriptions model = 65 | Sub.none 66 | 67 | 68 | 69 | -- VIEW 70 | 71 | 72 | view : Model -> Html Msg 73 | view model = 74 | div [] 75 | [ input 76 | [ type_ "file" 77 | , multiple True 78 | , on "change" (D.map GotFiles filesDecoder) 79 | ] 80 | [] 81 | , div [] [ text (Debug.toString model) ] 82 | ] 83 | 84 | 85 | filesDecoder : D.Decoder (List File) 86 | filesDecoder = 87 | D.at [ "target", "files" ] (D.list File.decoder) 88 | -------------------------------------------------------------------------------- /lib/node.d.ts: -------------------------------------------------------------------------------- 1 | export function init(extraEnv?: any): { 2 | format: (content: string) => { output?: string, error?: any } 3 | }; 4 | -------------------------------------------------------------------------------- /libraries/test/README.md: -------------------------------------------------------------------------------- 1 | # node-test-runner 2 | 3 | Copied from [v0.19.1-revision15](https://github.com/rtfeldman/node-test-runner/tree/0.19.1-revision15). -------------------------------------------------------------------------------- /libraries/test/src/Console/Text.elm: -------------------------------------------------------------------------------- 1 | module Console.Text exposing 2 | ( Color 3 | , ColorModifier 4 | , Style 5 | , Text 6 | , UseColor(..) 7 | , concat 8 | , dark 9 | , green 10 | , plain 11 | , red 12 | , render 13 | , underline 14 | , yellow 15 | ) 16 | 17 | import Test.Runner.Node.Vendor.Console as Console 18 | 19 | 20 | type Text 21 | = Text { background : Color, foreground : Color, style : Style, modifiers : List ColorModifier } String 22 | | Texts (List Text) 23 | 24 | 25 | type UseColor 26 | = UseColor 27 | | Monochrome 28 | 29 | 30 | type Color 31 | = Default 32 | | Red 33 | | Green 34 | | Yellow 35 | | Black 36 | | Blue 37 | | Magenta 38 | | Cyan 39 | | White 40 | 41 | 42 | type ColorModifier 43 | = Inverted 44 | | Dark 45 | 46 | 47 | type Style 48 | = Normal 49 | | Bold 50 | | Underline 51 | 52 | 53 | render : UseColor -> Text -> String 54 | render useColor txt = 55 | case txt of 56 | Text attrs str -> 57 | case useColor of 58 | UseColor -> 59 | str 60 | |> colorizeBackground attrs.background 61 | |> colorizeForeground attrs.foreground 62 | |> applyModifiers attrs.modifiers 63 | |> applyStyle attrs.style 64 | 65 | Monochrome -> 66 | str 67 | 68 | Texts texts -> 69 | List.map (render useColor) texts 70 | |> String.join "" 71 | 72 | 73 | concat : List Text -> Text 74 | concat = 75 | Texts 76 | 77 | 78 | plain : String -> Text 79 | plain = 80 | Text { foreground = Default, background = Default, style = Normal, modifiers = [] } 81 | 82 | 83 | 84 | -- FOREGROUND COLORS -- 85 | 86 | 87 | red : String -> Text 88 | red = 89 | Text { foreground = Red, background = Default, style = Normal, modifiers = [] } 90 | 91 | 92 | green : String -> Text 93 | green = 94 | Text { foreground = Green, background = Default, style = Normal, modifiers = [] } 95 | 96 | 97 | yellow : String -> Text 98 | yellow = 99 | Text { foreground = Yellow, background = Default, style = Normal, modifiers = [] } 100 | 101 | 102 | dark : Text -> Text 103 | dark txt = 104 | case txt of 105 | Text styles str -> 106 | Text { styles | modifiers = Dark :: styles.modifiers } str 107 | 108 | Texts texts -> 109 | Texts (List.map dark texts) 110 | 111 | 112 | 113 | -- STYLES -- 114 | 115 | 116 | underline : Text -> Text 117 | underline txt = 118 | case txt of 119 | Text styles str -> 120 | Text { styles | style = Underline } str 121 | 122 | Texts texts -> 123 | Texts (List.map dark texts) 124 | 125 | 126 | 127 | -- INTERNAL HELPERS -- 128 | 129 | 130 | colorizeForeground : Color -> String -> String 131 | colorizeForeground color str = 132 | case color of 133 | Default -> 134 | str 135 | 136 | Red -> 137 | Console.red str 138 | 139 | Green -> 140 | Console.green str 141 | 142 | Yellow -> 143 | Console.yellow str 144 | 145 | Black -> 146 | Console.black str 147 | 148 | Blue -> 149 | Console.blue str 150 | 151 | Magenta -> 152 | Console.magenta str 153 | 154 | Cyan -> 155 | Console.cyan str 156 | 157 | White -> 158 | Console.white str 159 | 160 | 161 | colorizeBackground : Color -> String -> String 162 | colorizeBackground color str = 163 | case color of 164 | Default -> 165 | str 166 | 167 | Red -> 168 | Console.bgRed str 169 | 170 | Green -> 171 | Console.bgGreen str 172 | 173 | Yellow -> 174 | Console.bgYellow str 175 | 176 | Black -> 177 | Console.bgBlack str 178 | 179 | Blue -> 180 | Console.bgBlue str 181 | 182 | Magenta -> 183 | Console.bgMagenta str 184 | 185 | Cyan -> 186 | Console.bgCyan str 187 | 188 | White -> 189 | Console.bgWhite str 190 | 191 | 192 | applyStyle : Style -> String -> String 193 | applyStyle style str = 194 | case style of 195 | Normal -> 196 | str 197 | 198 | Bold -> 199 | Console.bold str 200 | 201 | Underline -> 202 | Console.underline str 203 | 204 | 205 | applyModifiers : List ColorModifier -> String -> String 206 | applyModifiers modifiers str = 207 | List.foldl applyModifiersHelp str modifiers 208 | 209 | 210 | applyModifiersHelp : ColorModifier -> String -> String 211 | applyModifiersHelp modifier str = 212 | case modifier of 213 | Inverted -> 214 | Console.colorsInverted str 215 | 216 | Dark -> 217 | Console.dark str 218 | -------------------------------------------------------------------------------- /libraries/test/src/Test/Reporter/Console/Format/Color.elm: -------------------------------------------------------------------------------- 1 | module Test.Reporter.Console.Format.Color exposing (formatEquality) 2 | 3 | import Test.Reporter.Highlightable as Highlightable exposing (Highlightable) 4 | import Test.Runner.Node.Vendor.Console as Console 5 | 6 | 7 | formatEquality : List (Highlightable String) -> List (Highlightable String) -> ( String, String ) 8 | formatEquality highlightedExpected highlightedActual = 9 | let 10 | formattedExpected = 11 | highlightedExpected 12 | |> List.map fromHighlightable 13 | |> String.join "" 14 | 15 | formattedActual = 16 | highlightedActual 17 | |> List.map fromHighlightable 18 | |> String.join "" 19 | in 20 | ( formattedExpected, formattedActual ) 21 | 22 | 23 | fromHighlightable : Highlightable String -> String 24 | fromHighlightable = 25 | Highlightable.resolve 26 | -- Cyan seems to look readable with both white and black text on top, 27 | -- so it should work with both dark and light console themes 28 | { fromHighlighted = Console.colorsInverted 29 | , fromPlain = identity 30 | } 31 | -------------------------------------------------------------------------------- /libraries/test/src/Test/Reporter/Console/Format/Monochrome.elm: -------------------------------------------------------------------------------- 1 | module Test.Reporter.Console.Format.Monochrome exposing (formatEquality) 2 | 3 | import Test.Reporter.Highlightable as Highlightable exposing (Highlightable) 4 | 5 | 6 | formatEquality : List (Highlightable String) -> List (Highlightable String) -> ( String, String ) 7 | formatEquality highlightedExpected highlightedActual = 8 | let 9 | ( formattedExpected, expectedIndicators ) = 10 | highlightedExpected 11 | |> List.map (fromHighlightable "▲") 12 | |> List.unzip 13 | 14 | ( formattedActual, actualIndicators ) = 15 | highlightedActual 16 | |> List.map (fromHighlightable "▼") 17 | |> List.unzip 18 | 19 | combinedExpected = 20 | String.join "\n" 21 | [ String.join "" formattedExpected 22 | , String.join "" expectedIndicators 23 | ] 24 | 25 | combinedActual = 26 | String.join "\n" 27 | [ String.join "" actualIndicators 28 | , String.join "" formattedActual 29 | ] 30 | in 31 | ( combinedExpected, combinedActual ) 32 | 33 | 34 | fromHighlightable : String -> Highlightable String -> ( String, String ) 35 | fromHighlightable indicator = 36 | Highlightable.resolve 37 | { fromHighlighted = \char -> ( char, indicator ) 38 | , fromPlain = \char -> ( char, " " ) 39 | } 40 | -------------------------------------------------------------------------------- /libraries/test/src/Test/Reporter/Highlightable.elm: -------------------------------------------------------------------------------- 1 | module Test.Reporter.Highlightable exposing (Highlightable, diffLists, map, resolve) 2 | 3 | import Test.Runner.Node.Vendor.Diff as Diff exposing (Change(..)) 4 | 5 | 6 | type Highlightable a 7 | = Highlighted a 8 | | Plain a 9 | 10 | 11 | resolve : { fromHighlighted : a -> b, fromPlain : a -> b } -> Highlightable a -> b 12 | resolve { fromHighlighted, fromPlain } highlightable = 13 | case highlightable of 14 | Highlighted val -> 15 | fromHighlighted val 16 | 17 | Plain val -> 18 | fromPlain val 19 | 20 | 21 | diffLists : List a -> List a -> List (Highlightable a) 22 | diffLists expected actual = 23 | -- TODO make sure this looks reasonable for multiline strings 24 | Diff.diff expected actual 25 | |> List.concatMap fromDiff 26 | 27 | 28 | map : (a -> b) -> Highlightable a -> Highlightable b 29 | map transform highlightable = 30 | case highlightable of 31 | Highlighted val -> 32 | Highlighted (transform val) 33 | 34 | Plain val -> 35 | Plain (transform val) 36 | 37 | 38 | fromDiff : Change a -> List (Highlightable a) 39 | fromDiff diff = 40 | case diff of 41 | Added _ -> 42 | [] 43 | 44 | Removed char -> 45 | [ Highlighted char ] 46 | 47 | NoChange char -> 48 | [ Plain char ] 49 | -------------------------------------------------------------------------------- /libraries/test/src/Test/Reporter/Reporter.elm: -------------------------------------------------------------------------------- 1 | module Test.Reporter.Reporter exposing (Report(..), RunInfo, TestReporter, createReporter) 2 | 3 | import Console.Text exposing (UseColor) 4 | import Json.Encode exposing (Value) 5 | import Test.Reporter.Console as ConsoleReporter 6 | import Test.Reporter.JUnit as JUnitReporter 7 | import Test.Reporter.Json as JsonReporter 8 | import Test.Reporter.TestResults exposing (SummaryInfo, TestResult) 9 | 10 | 11 | type Report 12 | = ConsoleReport UseColor 13 | | JsonReport 14 | | JUnitReport 15 | 16 | 17 | type alias TestReporter = 18 | { format : String 19 | , reportBegin : RunInfo -> Maybe Value 20 | , reportComplete : TestResult -> Value 21 | , reportSummary : SummaryInfo -> Maybe String -> Value 22 | } 23 | 24 | 25 | type alias RunInfo = 26 | { globs : List String 27 | , paths : List String 28 | , fuzzRuns : Int 29 | , testCount : Int 30 | , initialSeed : Int 31 | } 32 | 33 | 34 | createReporter : Report -> TestReporter 35 | createReporter report = 36 | case report of 37 | JsonReport -> 38 | TestReporter "JSON" 39 | JsonReporter.reportBegin 40 | JsonReporter.reportComplete 41 | JsonReporter.reportSummary 42 | 43 | ConsoleReport useColor -> 44 | TestReporter "CHALK" 45 | (ConsoleReporter.reportBegin useColor) 46 | (ConsoleReporter.reportComplete useColor) 47 | (ConsoleReporter.reportSummary useColor) 48 | 49 | JUnitReport -> 50 | TestReporter "JUNIT" 51 | JUnitReporter.reportBegin 52 | JUnitReporter.reportComplete 53 | JUnitReporter.reportSummary 54 | -------------------------------------------------------------------------------- /libraries/test/src/Test/Reporter/TestResults.elm: -------------------------------------------------------------------------------- 1 | module Test.Reporter.TestResults exposing 2 | ( Failure 3 | , Outcome(..) 4 | , SummaryInfo 5 | , TestResult 6 | , isFailure 7 | , outcomesFromExpectations 8 | ) 9 | 10 | import Expect exposing (Expectation) 11 | import Test.Distribution exposing (DistributionReport) 12 | import Test.Runner 13 | import Test.Runner.Failure exposing (Reason) 14 | 15 | 16 | type Outcome 17 | = Passed DistributionReport 18 | | Todo String 19 | | Failed (List ( Failure, DistributionReport )) 20 | 21 | 22 | type alias TestResult = 23 | { labels : List String 24 | , outcome : Outcome 25 | , duration : Int -- in milliseconds 26 | } 27 | 28 | 29 | type alias SummaryInfo = 30 | { testCount : Int 31 | , passed : Int 32 | , failed : Int 33 | , todos : List ( List String, String ) 34 | , duration : Float 35 | } 36 | 37 | 38 | type alias Failure = 39 | { given : Maybe String 40 | , description : String 41 | , reason : Reason 42 | } 43 | 44 | 45 | isFailure : Outcome -> Bool 46 | isFailure outcome = 47 | case outcome of 48 | Failed _ -> 49 | True 50 | 51 | _ -> 52 | False 53 | 54 | 55 | outcomesFromExpectations : List Expectation -> List Outcome 56 | outcomesFromExpectations expectations = 57 | case expectations of 58 | expectation :: [] -> 59 | -- Most often we'll get exactly 1 pass, so try that case first! 60 | case Test.Runner.getFailureReason expectation of 61 | Nothing -> 62 | [ Passed (Test.Runner.getDistributionReport expectation) ] 63 | 64 | Just failure -> 65 | if Test.Runner.isTodo expectation then 66 | [ Todo failure.description ] 67 | 68 | else 69 | [ Failed 70 | [ ( failure, Test.Runner.getDistributionReport expectation ) ] 71 | ] 72 | 73 | _ :: _ -> 74 | let 75 | builder = 76 | List.foldl outcomesFromExpectationsHelp 77 | { passes = [], todos = [], failures = [] } 78 | expectations 79 | 80 | failuresList = 81 | case builder.failures of 82 | [] -> 83 | [] 84 | 85 | failures -> 86 | [ Failed failures ] 87 | in 88 | List.concat 89 | [ List.map Passed builder.passes 90 | , List.map Todo builder.todos 91 | , failuresList 92 | ] 93 | 94 | [] -> 95 | [] 96 | 97 | 98 | type alias OutcomeBuilder = 99 | { passes : List DistributionReport 100 | , todos : List String 101 | , failures : List ( Failure, DistributionReport ) 102 | } 103 | 104 | 105 | outcomesFromExpectationsHelp : Expectation -> OutcomeBuilder -> OutcomeBuilder 106 | outcomesFromExpectationsHelp expectation builder = 107 | case Test.Runner.getFailureReason expectation of 108 | Just failure -> 109 | if Test.Runner.isTodo expectation then 110 | { builder | todos = failure.description :: builder.todos } 111 | 112 | else 113 | { builder 114 | | failures = 115 | ( failure 116 | , Test.Runner.getDistributionReport expectation 117 | ) 118 | :: builder.failures 119 | } 120 | 121 | Nothing -> 122 | { builder 123 | | passes = 124 | Test.Runner.getDistributionReport expectation 125 | :: builder.passes 126 | } 127 | -------------------------------------------------------------------------------- /libraries/test/src/Test/Runner/JsMessage.elm: -------------------------------------------------------------------------------- 1 | module Test.Runner.JsMessage exposing (JsMessage(..), decoder) 2 | 3 | import Json.Decode as Decode exposing (Decoder) 4 | 5 | 6 | type JsMessage 7 | = Test Int 8 | | Summary Float Int (List ( List String, String )) 9 | 10 | 11 | decoder : Decoder JsMessage 12 | decoder = 13 | Decode.field "type" Decode.string 14 | |> Decode.andThen decodeMessageFromType 15 | 16 | 17 | decodeMessageFromType : String -> Decoder JsMessage 18 | decodeMessageFromType messageType = 19 | case messageType of 20 | "TEST" -> 21 | Decode.field "index" Decode.int 22 | |> Decode.map Test 23 | 24 | "SUMMARY" -> 25 | Decode.map3 Summary 26 | (Decode.field "duration" Decode.float) 27 | (Decode.field "failures" Decode.int) 28 | (Decode.field "todos" (Decode.list todoDecoder)) 29 | 30 | _ -> 31 | Decode.fail ("Unrecognized message type: " ++ messageType) 32 | 33 | 34 | todoDecoder : Decoder ( List String, String ) 35 | todoDecoder = 36 | Decode.map2 (\a b -> ( a, b )) 37 | (Decode.field "labels" (Decode.list Decode.string)) 38 | (Decode.field "todo" Decode.string) 39 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "guida", 3 | "version": "1.0.0-alpha", 4 | "description": "Guida is a functional programming language that builds upon the solid foundation of Elm, offering backward compatibility with all existing Elm 0.19.1 projects", 5 | "author": "Decio Ferreira", 6 | "license": "BSD-3-Clause", 7 | "main": "lib/node.js", 8 | "browser": "lib/browser.js", 9 | "bin": { 10 | "guida": "bin/index.js" 11 | }, 12 | "scripts": { 13 | "build": "npm-run-all --sequential build:*", 14 | "build:node": "./scripts/build.sh node", 15 | "build:browser": "./scripts/build.sh browser", 16 | "build:bin": "./scripts/build.sh bin", 17 | "test": "npm-run-all --sequential test:*", 18 | "test:eslint": "eslint", 19 | "test:elm-format-validate": "elm-format . --validate", 20 | "test:jest": "jest", 21 | "test:elm": "elm-test", 22 | "test:elm-review": "elm-review", 23 | "elm-format": "elm-format . --yes", 24 | "prepack": "npm run build" 25 | }, 26 | "dependencies": { 27 | "adm-zip": "^0.5.16", 28 | "form-data": "^4.0.2", 29 | "indexeddb-fs": "^2.1.5", 30 | "jszip": "^3.10.1", 31 | "mock-xmlhttprequest": "^8.4.1", 32 | "tmp": "^0.2.3", 33 | "which": "^5.0.0" 34 | }, 35 | "devDependencies": { 36 | "@eslint/js": "^9.23.0", 37 | "elm": "^0.19.1-6", 38 | "elm-format": "^0.8.7", 39 | "elm-review": "^2.13.2", 40 | "elm-test": "^0.19.1-revision15", 41 | "eslint": "^9.23.0", 42 | "eslint-plugin-jest": "^28.11.0", 43 | "globals": "^16.0.0", 44 | "guida": "^0.3.0-alpha", 45 | "jest": "^29.7.0", 46 | "npm-run-all": "^4.1.5", 47 | "uglify-js": "^3.19.3" 48 | } 49 | } -------------------------------------------------------------------------------- /review/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "elm/json": "1.1.3", 11 | "elm/project-metadata-utils": "1.0.2", 12 | "jfmengels/elm-review": "2.15.1", 13 | "jfmengels/elm-review-code-style": "1.2.0", 14 | "jfmengels/elm-review-common": "1.3.3", 15 | "jfmengels/elm-review-debug": "1.0.8", 16 | "jfmengels/elm-review-documentation": "2.0.4", 17 | "jfmengels/elm-review-simplify": "2.1.6", 18 | "jfmengels/elm-review-unused": "1.2.4", 19 | "stil4m/elm-syntax": "7.3.8" 20 | }, 21 | "indirect": { 22 | "elm/bytes": "1.0.8", 23 | "elm/html": "1.0.0", 24 | "elm/parser": "1.1.0", 25 | "elm/random": "1.0.0", 26 | "elm/regex": "1.0.0", 27 | "elm/time": "1.0.0", 28 | "elm/virtual-dom": "1.0.3", 29 | "elm-explorations/test": "2.2.0", 30 | "pzp1997/assoc-list": "1.0.0", 31 | "rtfeldman/elm-hex": "1.0.0", 32 | "stil4m/structured-writer": "1.0.3" 33 | } 34 | }, 35 | "test-dependencies": { 36 | "direct": { 37 | "elm-explorations/test": "2.2.0" 38 | }, 39 | "indirect": {} 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /review/src/ReviewConfig.elm: -------------------------------------------------------------------------------- 1 | module ReviewConfig exposing (config) 2 | 3 | {-| Do not rename the ReviewConfig module or the config function, because 4 | `elm-review` will look for these. 5 | 6 | To add packages that contain rules, add them to this review project using 7 | 8 | `elm install author/packagename` 9 | 10 | when inside the directory containing this file. 11 | 12 | -} 13 | 14 | import Docs.ReviewAtDocs 15 | import NoConfusingPrefixOperator 16 | import NoDebug.Log 17 | import NoDebug.TodoOrToString 18 | import NoExposingEverything 19 | import NoImportingEverything 20 | import NoMissingTypeAnnotation 21 | import NoMissingTypeAnnotationInLetIn 22 | import NoMissingTypeExpose 23 | import NoPrematureLetComputation 24 | import NoSimpleLetBody 25 | import NoUnused.CustomTypeConstructorArgs 26 | import NoUnused.CustomTypeConstructors 27 | import NoUnused.Dependencies 28 | import NoUnused.Exports 29 | import NoUnused.Parameters 30 | import NoUnused.Patterns 31 | import NoUnused.Variables 32 | import Review.Rule as Rule exposing (Rule) 33 | import Simplify 34 | 35 | 36 | config : List Rule 37 | config = 38 | [ Docs.ReviewAtDocs.rule 39 | , NoConfusingPrefixOperator.rule 40 | , NoDebug.Log.rule 41 | , NoDebug.TodoOrToString.rule 42 | |> Rule.ignoreErrorsForDirectories [ "tests/" ] 43 | , NoExposingEverything.rule 44 | , NoImportingEverything.rule [] 45 | , NoMissingTypeAnnotation.rule 46 | , NoMissingTypeAnnotationInLetIn.rule 47 | , NoMissingTypeExpose.rule 48 | , NoSimpleLetBody.rule 49 | , NoPrematureLetComputation.rule 50 | 51 | -- , NoUnused.CustomTypeConstructors.rule [] 52 | -- , NoUnused.CustomTypeConstructorArgs.rule 53 | , NoUnused.Dependencies.rule 54 | 55 | -- , NoUnused.Exports.rule 56 | , NoUnused.Parameters.rule 57 | |> Rule.ignoreErrorsForFiles [ "src/Utils/Crash.elm" ] 58 | , NoUnused.Patterns.rule 59 | , NoUnused.Variables.rule 60 | , Simplify.rule Simplify.defaults 61 | ] 62 | -------------------------------------------------------------------------------- /scripts/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Ref.: https://github.com/elm/compiler/blob/master/hints/optimize.md 4 | 5 | set -e 6 | 7 | case $1 in 8 | "node") 9 | filepath="lib/guida.node" 10 | elm_entry="src/Node/Main.elm" 11 | ;; 12 | "browser") 13 | filepath="lib/guida.browser" 14 | elm_entry="src/Browser/Main.elm" 15 | ;; 16 | "bin") 17 | filepath="bin/guida" 18 | elm_entry="src/Terminal/Main.elm" 19 | ;; 20 | *) 21 | echo "Usage: $0 node|browser|bin" 22 | exit 1 23 | ;; 24 | esac 25 | 26 | js="$filepath.js" 27 | min="$filepath.min.js" 28 | 29 | guida make --optimize --output=$js $elm_entry 30 | 31 | uglifyjs $js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output $min 32 | 33 | echo "Initial size: $(cat $js | wc -c) bytes ($js)" 34 | echo "Minified size:$(cat $min | wc -c) bytes ($min)" 35 | echo "Gzipped size: $(cat $min | gzip -c | wc -c) bytes" -------------------------------------------------------------------------------- /scripts/performance-comparison.sh: -------------------------------------------------------------------------------- 1 | # Clean all 2 | rm -rf guida-stuff ~/.guida elm-stuff ~/.elm 3 | 4 | echo "------------------" 5 | 6 | # GUIDA 7 | 8 | ## Run initial guida 9 | time ./bin/index.js make src/Terminal/Main.elm 10 | 11 | ## Clean local guida-stuff 12 | rm -rf guida-stuff 13 | time ./bin/index.js make src/Terminal/Main.elm 14 | 15 | ## No clean (guida) 16 | time ./bin/index.js make src/Terminal/Main.elm 17 | 18 | echo "------------------" 19 | 20 | # ELM 21 | 22 | ## Run initial elm 23 | time elm make src/Terminal/Main.elm 24 | 25 | ## Clean local elm-stuff 26 | rm -rf elm-stuff 27 | time elm make src/Terminal/Main.elm 28 | 29 | ## No clean (elm) 30 | time elm make src/Terminal/Main.elm 31 | -------------------------------------------------------------------------------- /src/Browser/Format.elm: -------------------------------------------------------------------------------- 1 | module Browser.Format exposing (run) 2 | 3 | import Elm.Syntax.File 4 | import ElmSyntaxParserLenient 5 | import ElmSyntaxPrint 6 | 7 | 8 | 9 | -- RUN 10 | 11 | 12 | run : String -> Result String String 13 | run inputText = 14 | case ElmSyntaxParserLenient.run ElmSyntaxParserLenient.module_ inputText of 15 | Just modu -> 16 | Ok (render modu) 17 | 18 | Nothing -> 19 | -- FIXME missings errs 20 | Err "Something went wrong..." 21 | 22 | 23 | 24 | -- RENDER 25 | 26 | 27 | render : Elm.Syntax.File.File -> String 28 | render modul = 29 | ElmSyntaxPrint.module_ modul 30 | |> ElmSyntaxPrint.toString 31 | -------------------------------------------------------------------------------- /src/Browser/Main.elm: -------------------------------------------------------------------------------- 1 | module Browser.Main exposing (main) 2 | 3 | import Browser.Format as Format 4 | import Browser.Install as Install 5 | import Browser.Make as Make 6 | import Browser.Uninstall as Uninstall 7 | import Builder.Reporting.Exit as Exit 8 | import Compiler.Elm.Package as Pkg 9 | import Compiler.Json.Encode as E 10 | import Compiler.Parse.Primitives as P 11 | import Json.Decode as Decode 12 | import Json.Encode as Encode 13 | import System.IO as IO exposing (IO) 14 | import Utils.Impure as Impure 15 | 16 | 17 | main : IO.Program 18 | main = 19 | IO.run app 20 | 21 | 22 | app : IO () 23 | app = 24 | getArgs 25 | |> IO.bind 26 | (\args -> 27 | case args of 28 | MakeArgs path debug optimize withSourceMaps -> 29 | Make.run path (Make.Flags debug optimize withSourceMaps) 30 | |> IO.bind 31 | (\result -> 32 | case result of 33 | Ok output -> 34 | exitWithResponse (Encode.object [ ( "output", Encode.string output ) ]) 35 | 36 | Err error -> 37 | exitWithResponse (Encode.object [ ( "error", Encode.string (E.encodeUgly (Exit.toJson (Exit.makeToReport error))) ) ]) 38 | ) 39 | 40 | FormatArgs path -> 41 | case Format.run path of 42 | Ok output -> 43 | exitWithResponse (Encode.object [ ( "output", Encode.string output ) ]) 44 | 45 | Err error -> 46 | exitWithResponse (Encode.object [ ( "error", Encode.string error ) ]) 47 | 48 | InstallArgs pkgString -> 49 | case P.fromByteString Pkg.parser Tuple.pair pkgString of 50 | Ok pkg -> 51 | Install.run pkg 52 | |> IO.bind (\_ -> exitWithResponse Encode.null) 53 | 54 | Err _ -> 55 | exitWithResponse (Encode.object [ ( "error", Encode.string "Invalid package..." ) ]) 56 | 57 | UninstallArgs pkgString -> 58 | case P.fromByteString Pkg.parser Tuple.pair pkgString of 59 | Ok pkg -> 60 | Uninstall.run pkg 61 | |> IO.bind (\_ -> exitWithResponse Encode.null) 62 | 63 | Err _ -> 64 | exitWithResponse (Encode.object [ ( "error", Encode.string "Invalid package..." ) ]) 65 | ) 66 | 67 | 68 | getArgs : IO Args 69 | getArgs = 70 | Impure.task "getArgs" [] Impure.EmptyBody (Impure.DecoderResolver argsDecoder) 71 | 72 | 73 | exitWithResponse : Encode.Value -> IO a 74 | exitWithResponse value = 75 | Impure.task "exitWithResponse" [] (Impure.JsonBody value) Impure.Crash 76 | 77 | 78 | 79 | -- ARGS 80 | 81 | 82 | type Args 83 | = MakeArgs String Bool Bool Bool 84 | | FormatArgs String 85 | | InstallArgs String 86 | | UninstallArgs String 87 | 88 | 89 | argsDecoder : Decode.Decoder Args 90 | argsDecoder = 91 | Decode.field "command" Decode.string 92 | |> Decode.andThen 93 | (\command -> 94 | case command of 95 | "make" -> 96 | Decode.map4 MakeArgs 97 | (Decode.field "path" Decode.string) 98 | (Decode.field "debug" Decode.bool) 99 | (Decode.field "optimize" Decode.bool) 100 | (Decode.field "sourcemaps" Decode.bool) 101 | 102 | "format" -> 103 | Decode.map FormatArgs 104 | (Decode.field "content" Decode.string) 105 | 106 | "install" -> 107 | Decode.map InstallArgs 108 | (Decode.field "pkg" Decode.string) 109 | 110 | "uninstall" -> 111 | Decode.map UninstallArgs 112 | (Decode.field "pkg" Decode.string) 113 | 114 | _ -> 115 | Decode.fail ("Unknown command: " ++ command) 116 | ) 117 | -------------------------------------------------------------------------------- /src/Builder/BackgroundWriter.elm: -------------------------------------------------------------------------------- 1 | module Builder.BackgroundWriter exposing 2 | ( Scope 3 | , withScope 4 | , writeBinary 5 | ) 6 | 7 | import Builder.File as File 8 | import System.IO as IO exposing (IO) 9 | import Utils.Bytes.Decode as BD 10 | import Utils.Bytes.Encode as BE 11 | import Utils.Main as Utils 12 | 13 | 14 | 15 | -- BACKGROUND WRITER 16 | 17 | 18 | type Scope 19 | = Scope (Utils.MVar (List (Utils.MVar ()))) 20 | 21 | 22 | withScope : (Scope -> IO a) -> IO a 23 | withScope callback = 24 | Utils.newMVar (BE.list (\_ -> BE.unit ())) [] 25 | |> IO.bind 26 | (\workList -> 27 | callback (Scope workList) 28 | |> IO.bind 29 | (\result -> 30 | Utils.takeMVar (BD.list Utils.mVarDecoder) workList 31 | |> IO.bind 32 | (\mvars -> 33 | Utils.listTraverse_ (Utils.takeMVar (BD.succeed ())) mvars 34 | |> IO.fmap (\_ -> result) 35 | ) 36 | ) 37 | ) 38 | 39 | 40 | writeBinary : (a -> BE.Encoder) -> Scope -> String -> a -> IO () 41 | writeBinary toEncoder (Scope workList) path value = 42 | Utils.newEmptyMVar 43 | |> IO.bind 44 | (\mvar -> 45 | Utils.forkIO 46 | (File.writeBinary toEncoder path value 47 | |> IO.bind (\_ -> Utils.putMVar BE.unit mvar ()) 48 | ) 49 | |> IO.bind 50 | (\_ -> 51 | Utils.takeMVar (BD.list Utils.mVarDecoder) workList 52 | |> IO.bind 53 | (\oldWork -> 54 | let 55 | newWork : List (Utils.MVar ()) 56 | newWork = 57 | mvar :: oldWork 58 | in 59 | Utils.putMVar (BE.list Utils.mVarEncoder) workList newWork 60 | ) 61 | ) 62 | ) 63 | -------------------------------------------------------------------------------- /src/Builder/Deps/Bump.elm: -------------------------------------------------------------------------------- 1 | module Builder.Deps.Bump exposing (getPossibilities) 2 | 3 | import Builder.Deps.Registry exposing (KnownVersions(..)) 4 | import Compiler.Elm.Magnitude as M 5 | import Compiler.Elm.Version as V 6 | import List.Extra 7 | import Utils.Main as Utils 8 | 9 | 10 | 11 | -- GET POSSIBILITIES 12 | 13 | 14 | getPossibilities : KnownVersions -> List ( V.Version, V.Version, M.Magnitude ) 15 | getPossibilities (KnownVersions latest previous) = 16 | let 17 | allVersions : List V.Version 18 | allVersions = 19 | List.reverse (latest :: previous) 20 | 21 | minorPoints : List V.Version 22 | minorPoints = 23 | List.filterMap List.Extra.last (Utils.listGroupBy sameMajor allVersions) 24 | 25 | patchPoints : List V.Version 26 | patchPoints = 27 | List.filterMap List.Extra.last (Utils.listGroupBy sameMinor allVersions) 28 | in 29 | ( latest, V.bumpMajor latest, M.MAJOR ) 30 | :: List.map (\v -> ( v, V.bumpMinor v, M.MINOR )) minorPoints 31 | ++ List.map (\v -> ( v, V.bumpPatch v, M.PATCH )) patchPoints 32 | 33 | 34 | sameMajor : V.Version -> V.Version -> Bool 35 | sameMajor (V.Version major1 _ _) (V.Version major2 _ _) = 36 | major1 == major2 37 | 38 | 39 | sameMinor : V.Version -> V.Version -> Bool 40 | sameMinor (V.Version major1 minor1 _) (V.Version major2 minor2 _) = 41 | major1 == major2 && minor1 == minor2 42 | -------------------------------------------------------------------------------- /src/Builder/Deps/Website.elm: -------------------------------------------------------------------------------- 1 | module Builder.Deps.Website exposing 2 | ( metadata 3 | , route 4 | ) 5 | 6 | import Builder.Http as Http 7 | import Compiler.Elm.Package as Pkg 8 | import Compiler.Elm.Version as V 9 | import System.IO as IO exposing (IO) 10 | import Utils.Main as Utils 11 | 12 | 13 | domain : IO String 14 | domain = 15 | Utils.envLookupEnv "GUIDA_REGISTRY" 16 | |> IO.fmap (Maybe.withDefault "https://package.elm-lang.org") 17 | 18 | 19 | route : String -> List ( String, String ) -> IO String 20 | route path params = 21 | domain 22 | |> IO.fmap (\d -> Http.toUrl (d ++ path) params) 23 | 24 | 25 | metadata : Pkg.Name -> V.Version -> String -> IO String 26 | metadata name version file = 27 | domain 28 | |> IO.fmap (\d -> d ++ "/packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/" ++ file) 29 | -------------------------------------------------------------------------------- /src/Builder/Reporting/Exit/Help.elm: -------------------------------------------------------------------------------- 1 | module Builder.Reporting.Exit.Help exposing 2 | ( Report 3 | , compilerReport 4 | , docReport 5 | , jsonReport 6 | , report 7 | , reportToDoc 8 | , reportToJson 9 | , toStderr 10 | , toStdout 11 | ) 12 | 13 | import Compiler.Json.Encode as E 14 | import Compiler.Reporting.Doc as D 15 | import Compiler.Reporting.Error as Error 16 | import Maybe.Extra as Maybe 17 | import System.IO as IO exposing (IO) 18 | 19 | 20 | 21 | -- REPORT 22 | 23 | 24 | type Report 25 | = CompilerReport String Error.Module (List Error.Module) 26 | | Report String (Maybe String) D.Doc 27 | 28 | 29 | report : String -> Maybe String -> String -> List D.Doc -> Report 30 | report title path startString others = 31 | Report title path <| D.stack (D.reflow startString :: others) 32 | 33 | 34 | docReport : String -> Maybe String -> D.Doc -> List D.Doc -> Report 35 | docReport title path startDoc others = 36 | Report title path <| D.stack (startDoc :: others) 37 | 38 | 39 | jsonReport : String -> Maybe String -> D.Doc -> Report 40 | jsonReport = 41 | Report 42 | 43 | 44 | compilerReport : String -> Error.Module -> List Error.Module -> Report 45 | compilerReport = 46 | CompilerReport 47 | 48 | 49 | 50 | -- TO DOC 51 | 52 | 53 | reportToDoc : Report -> D.Doc 54 | reportToDoc report_ = 55 | case report_ of 56 | CompilerReport root e es -> 57 | Error.toDoc root e es 58 | 59 | Report title maybePath message -> 60 | let 61 | makeDashes : Int -> String 62 | makeDashes n = 63 | String.repeat (max 1 (80 - n)) "-" 64 | 65 | errorBarEnd : String 66 | errorBarEnd = 67 | case maybePath of 68 | Nothing -> 69 | makeDashes (4 + String.length title) 70 | 71 | Just path -> 72 | makeDashes (5 + String.length title + String.length path) 73 | ++ " " 74 | ++ path 75 | 76 | errorBar : D.Doc 77 | errorBar = 78 | D.dullcyan 79 | (D.fromChars "--" 80 | |> D.plus (D.fromChars title) 81 | |> D.plus (D.fromChars errorBarEnd) 82 | ) 83 | in 84 | D.stack [ errorBar, message, D.fromChars "" ] 85 | 86 | 87 | 88 | -- TO JSON 89 | 90 | 91 | reportToJson : Report -> E.Value 92 | reportToJson report_ = 93 | case report_ of 94 | CompilerReport _ e es -> 95 | E.object 96 | [ ( "type", E.string "compile-errors" ) 97 | , ( "errors", E.list Error.toJson (e :: es) ) 98 | ] 99 | 100 | Report title maybePath message -> 101 | E.object 102 | [ ( "type", E.string "error" ) 103 | , ( "path", Maybe.unwrap E.null E.string maybePath ) 104 | , ( "title", E.string title ) 105 | , ( "message", D.encode message ) 106 | ] 107 | 108 | 109 | 110 | -- OUTPUT 111 | 112 | 113 | toString : D.Doc -> String 114 | toString = 115 | D.toString 116 | 117 | 118 | toStdout : D.Doc -> IO () 119 | toStdout doc = 120 | toHandle IO.stdout doc 121 | 122 | 123 | toStderr : D.Doc -> IO () 124 | toStderr doc = 125 | toHandle IO.stderr doc 126 | 127 | 128 | toHandle : IO.Handle -> D.Doc -> IO () 129 | toHandle handle doc = 130 | IO.hIsTerminalDevice handle 131 | |> IO.bind 132 | (\isTerminal -> 133 | if isTerminal then 134 | D.toAnsi handle doc 135 | 136 | else 137 | IO.hPutStr handle (toString doc) 138 | ) 139 | -------------------------------------------------------------------------------- /src/Builder/Reporting/Task.elm: -------------------------------------------------------------------------------- 1 | module Builder.Reporting.Task exposing 2 | ( Task 3 | , bind 4 | , eio 5 | , fmap 6 | , io 7 | , mapError 8 | , mio 9 | , pure 10 | , run 11 | , throw 12 | , void 13 | ) 14 | 15 | import System.IO as IO exposing (IO) 16 | 17 | 18 | 19 | -- TASKS 20 | 21 | 22 | type Task x a 23 | = Task (IO (Result x a)) 24 | 25 | 26 | run : Task x a -> IO (Result x a) 27 | run (Task task) = 28 | task 29 | 30 | 31 | throw : x -> Task x a 32 | throw x = 33 | Task (IO.pure (Err x)) 34 | 35 | 36 | mapError : (x -> y) -> Task x a -> Task y a 37 | mapError func (Task task) = 38 | Task (IO.fmap (Result.mapError func) task) 39 | 40 | 41 | 42 | -- IO 43 | 44 | 45 | io : IO a -> Task x a 46 | io work = 47 | Task (IO.fmap Ok work) 48 | 49 | 50 | mio : x -> IO (Maybe a) -> Task x a 51 | mio x work = 52 | Task 53 | (IO.fmap 54 | (\result -> 55 | case result of 56 | Just a -> 57 | Ok a 58 | 59 | Nothing -> 60 | Err x 61 | ) 62 | work 63 | ) 64 | 65 | 66 | eio : (x -> y) -> IO (Result x a) -> Task y a 67 | eio func work = 68 | Task (IO.fmap (Result.mapError func) work) 69 | 70 | 71 | 72 | -- INSTANCES 73 | 74 | 75 | fmap : (a -> b) -> Task x a -> Task x b 76 | fmap func (Task taskA) = 77 | Task (IO.fmap (Result.map func) taskA) 78 | 79 | 80 | void : Task x a -> Task x () 81 | void = 82 | fmap (\_ -> ()) 83 | 84 | 85 | pure : a -> Task x a 86 | pure a = 87 | Task (IO.pure (Ok a)) 88 | 89 | 90 | bind : (a -> Task x b) -> Task x a -> Task x b 91 | bind callback (Task taskA) = 92 | Task 93 | (IO.bind 94 | (\resultA -> 95 | case Result.map callback resultA of 96 | Ok (Task b) -> 97 | b 98 | 99 | Err err -> 100 | IO.pure (Err err) 101 | ) 102 | taskA 103 | ) 104 | -------------------------------------------------------------------------------- /src/Codec/Archive/Zip.elm: -------------------------------------------------------------------------------- 1 | module Codec.Archive.Zip exposing 2 | ( Archive 3 | , Entry 4 | , FilePath 5 | , eRelativePath 6 | , fromEntry 7 | , zEntries 8 | ) 9 | 10 | {-| The module provides everything you may need to manipulate Zip archives. 11 | There are three things that should be clarified right away, to avoid confusion. 12 | 13 | Ref.: 14 | 15 | -} 16 | 17 | 18 | {-| FIXME System.IO.FilePath 19 | -} 20 | type alias FilePath = 21 | String 22 | 23 | 24 | type alias Archive = 25 | List Entry 26 | 27 | 28 | type alias Entry = 29 | { eRelativePath : FilePath 30 | , eData : String 31 | } 32 | 33 | 34 | zEntries : Archive -> List Entry 35 | zEntries = 36 | identity 37 | 38 | 39 | eRelativePath : Entry -> FilePath 40 | eRelativePath zipEntry = 41 | zipEntry.eRelativePath 42 | 43 | 44 | fromEntry : Entry -> String 45 | fromEntry zipEntry = 46 | zipEntry.eData 47 | -------------------------------------------------------------------------------- /src/Compiler/AST/Utils/Binop.elm: -------------------------------------------------------------------------------- 1 | module Compiler.AST.Utils.Binop exposing 2 | ( Associativity(..) 3 | , Precedence 4 | , associativityDecoder 5 | , associativityEncoder 6 | , jsonAssociativityDecoder 7 | , jsonAssociativityEncoder 8 | , jsonPrecedenceDecoder 9 | , jsonPrecedenceEncoder 10 | , precedenceDecoder 11 | , precedenceEncoder 12 | ) 13 | 14 | import Json.Decode as Decode 15 | import Json.Encode as Encode 16 | import Utils.Bytes.Decode as BD 17 | import Utils.Bytes.Encode as BE 18 | 19 | 20 | 21 | -- BINOP STUFF 22 | 23 | 24 | type alias Precedence = 25 | Int 26 | 27 | 28 | type Associativity 29 | = Left 30 | | Non 31 | | Right 32 | 33 | 34 | 35 | -- JSON ENCODERS and DECODERS 36 | 37 | 38 | jsonPrecedenceEncoder : Precedence -> Encode.Value 39 | jsonPrecedenceEncoder = 40 | Encode.int 41 | 42 | 43 | jsonPrecedenceDecoder : Decode.Decoder Precedence 44 | jsonPrecedenceDecoder = 45 | Decode.int 46 | 47 | 48 | jsonAssociativityEncoder : Associativity -> Encode.Value 49 | jsonAssociativityEncoder associativity = 50 | case associativity of 51 | Left -> 52 | Encode.string "Left" 53 | 54 | Non -> 55 | Encode.string "Non" 56 | 57 | Right -> 58 | Encode.string "Right" 59 | 60 | 61 | jsonAssociativityDecoder : Decode.Decoder Associativity 62 | jsonAssociativityDecoder = 63 | Decode.string 64 | |> Decode.andThen 65 | (\str -> 66 | case str of 67 | "Left" -> 68 | Decode.succeed Left 69 | 70 | "Non" -> 71 | Decode.succeed Non 72 | 73 | "Right" -> 74 | Decode.succeed Right 75 | 76 | _ -> 77 | Decode.fail ("Unknown Associativity: " ++ str) 78 | ) 79 | 80 | 81 | 82 | -- ENCODERS and DECODERS 83 | 84 | 85 | precedenceEncoder : Precedence -> BE.Encoder 86 | precedenceEncoder = 87 | BE.int 88 | 89 | 90 | precedenceDecoder : BD.Decoder Precedence 91 | precedenceDecoder = 92 | BD.int 93 | 94 | 95 | associativityEncoder : Associativity -> BE.Encoder 96 | associativityEncoder associativity = 97 | BE.unsignedInt8 98 | (case associativity of 99 | Left -> 100 | 0 101 | 102 | Non -> 103 | 1 104 | 105 | Right -> 106 | 2 107 | ) 108 | 109 | 110 | associativityDecoder : BD.Decoder Associativity 111 | associativityDecoder = 112 | BD.unsignedInt8 113 | |> BD.andThen 114 | (\idx -> 115 | case idx of 116 | 0 -> 117 | BD.succeed Left 118 | 119 | 1 -> 120 | BD.succeed Non 121 | 122 | 2 -> 123 | BD.succeed Right 124 | 125 | _ -> 126 | BD.fail 127 | ) 128 | -------------------------------------------------------------------------------- /src/Compiler/AST/Utils/Shader.elm: -------------------------------------------------------------------------------- 1 | module Compiler.AST.Utils.Shader exposing 2 | ( Source(..) 3 | , Type(..) 4 | , Types(..) 5 | , fromString 6 | , sourceDecoder 7 | , sourceEncoder 8 | , toJsStringBuilder 9 | , typesDecoder 10 | , typesEncoder 11 | ) 12 | 13 | import Compiler.Data.Name exposing (Name) 14 | import Data.Map exposing (Dict) 15 | import Utils.Bytes.Decode as BD 16 | import Utils.Bytes.Encode as BE 17 | 18 | 19 | 20 | -- SOURCE 21 | 22 | 23 | type Source 24 | = Source String 25 | 26 | 27 | 28 | -- TYPES 29 | 30 | 31 | type Types 32 | = Types (Dict String Name Type) (Dict String Name Type) (Dict String Name Type) 33 | 34 | 35 | type Type 36 | = Int 37 | | Float 38 | | V2 39 | | V3 40 | | V4 41 | | M4 42 | | Texture 43 | 44 | 45 | 46 | -- TO BUILDER 47 | 48 | 49 | toJsStringBuilder : Source -> String 50 | toJsStringBuilder (Source src) = 51 | src 52 | 53 | 54 | 55 | -- FROM STRING 56 | 57 | 58 | fromString : String -> Source 59 | fromString = 60 | Source << escape 61 | 62 | 63 | escape : String -> String 64 | escape = 65 | String.foldr 66 | (\char acc -> 67 | case char of 68 | '\u{000D}' -> 69 | acc 70 | 71 | '\n' -> 72 | acc 73 | |> String.cons 'n' 74 | |> String.cons '\\' 75 | 76 | '"' -> 77 | acc 78 | |> String.cons '"' 79 | |> String.cons '\\' 80 | 81 | '\'' -> 82 | acc 83 | |> String.cons '\'' 84 | |> String.cons '\\' 85 | 86 | '\\' -> 87 | acc 88 | |> String.cons '\\' 89 | |> String.cons '\\' 90 | 91 | _ -> 92 | String.cons char acc 93 | ) 94 | "" 95 | 96 | 97 | 98 | -- ENCODERS and DECODERS 99 | 100 | 101 | sourceEncoder : Source -> BE.Encoder 102 | sourceEncoder (Source src) = 103 | BE.string src 104 | 105 | 106 | sourceDecoder : BD.Decoder Source 107 | sourceDecoder = 108 | BD.map Source BD.string 109 | 110 | 111 | typesEncoder : Types -> BE.Encoder 112 | typesEncoder (Types attribute uniform varying) = 113 | BE.sequence 114 | [ BE.assocListDict compare BE.string typeEncoder attribute 115 | , BE.assocListDict compare BE.string typeEncoder uniform 116 | , BE.assocListDict compare BE.string typeEncoder varying 117 | ] 118 | 119 | 120 | typesDecoder : BD.Decoder Types 121 | typesDecoder = 122 | BD.map3 Types 123 | (BD.assocListDict identity BD.string typeDecoder) 124 | (BD.assocListDict identity BD.string typeDecoder) 125 | (BD.assocListDict identity BD.string typeDecoder) 126 | 127 | 128 | typeEncoder : Type -> BE.Encoder 129 | typeEncoder type_ = 130 | BE.unsignedInt8 131 | (case type_ of 132 | Int -> 133 | 0 134 | 135 | Float -> 136 | 1 137 | 138 | V2 -> 139 | 2 140 | 141 | V3 -> 142 | 3 143 | 144 | V4 -> 145 | 4 146 | 147 | M4 -> 148 | 5 149 | 150 | Texture -> 151 | 6 152 | ) 153 | 154 | 155 | typeDecoder : BD.Decoder Type 156 | typeDecoder = 157 | BD.unsignedInt8 158 | |> BD.andThen 159 | (\idx -> 160 | case idx of 161 | 0 -> 162 | BD.succeed Int 163 | 164 | 1 -> 165 | BD.succeed Float 166 | 167 | 2 -> 168 | BD.succeed V2 169 | 170 | 3 -> 171 | BD.succeed V3 172 | 173 | 4 -> 174 | BD.succeed V4 175 | 176 | 5 -> 177 | BD.succeed M4 178 | 179 | 6 -> 180 | BD.succeed Texture 181 | 182 | _ -> 183 | BD.fail 184 | ) 185 | -------------------------------------------------------------------------------- /src/Compiler/AST/Utils/Type.elm: -------------------------------------------------------------------------------- 1 | module Compiler.AST.Utils.Type exposing 2 | ( dealias 3 | , deepDealias 4 | , delambda 5 | , iteratedDealias 6 | ) 7 | 8 | import Compiler.AST.Canonical exposing (AliasType(..), FieldType(..), Type(..)) 9 | import Compiler.Data.Name exposing (Name) 10 | import Data.Map as Dict exposing (Dict) 11 | 12 | 13 | 14 | -- DELAMBDA 15 | 16 | 17 | delambda : Type -> List Type 18 | delambda tipe = 19 | case tipe of 20 | TLambda arg result -> 21 | arg :: delambda result 22 | 23 | _ -> 24 | [ tipe ] 25 | 26 | 27 | 28 | -- DEALIAS 29 | 30 | 31 | dealias : List ( Name, Type ) -> AliasType -> Type 32 | dealias args aliasType = 33 | case aliasType of 34 | Holey tipe -> 35 | dealiasHelp (Dict.fromList identity args) tipe 36 | 37 | Filled tipe -> 38 | tipe 39 | 40 | 41 | dealiasHelp : Dict String Name Type -> Type -> Type 42 | dealiasHelp typeTable tipe = 43 | case tipe of 44 | TLambda a b -> 45 | TLambda 46 | (dealiasHelp typeTable a) 47 | (dealiasHelp typeTable b) 48 | 49 | TVar x -> 50 | Dict.get identity x typeTable 51 | |> Maybe.withDefault tipe 52 | 53 | TRecord fields ext -> 54 | TRecord (Dict.map (\_ -> dealiasField typeTable) fields) ext 55 | 56 | TAlias home name args t_ -> 57 | TAlias home name (List.map (Tuple.mapSecond (dealiasHelp typeTable)) args) t_ 58 | 59 | TType home name args -> 60 | TType home name (List.map (dealiasHelp typeTable) args) 61 | 62 | TUnit -> 63 | TUnit 64 | 65 | TTuple a b cs -> 66 | TTuple 67 | (dealiasHelp typeTable a) 68 | (dealiasHelp typeTable b) 69 | (List.map (dealiasHelp typeTable) cs) 70 | 71 | 72 | dealiasField : Dict String Name Type -> FieldType -> FieldType 73 | dealiasField typeTable (FieldType index tipe) = 74 | FieldType index (dealiasHelp typeTable tipe) 75 | 76 | 77 | 78 | -- DEEP DEALIAS 79 | 80 | 81 | deepDealias : Type -> Type 82 | deepDealias tipe = 83 | case tipe of 84 | TLambda a b -> 85 | TLambda (deepDealias a) (deepDealias b) 86 | 87 | TVar _ -> 88 | tipe 89 | 90 | TRecord fields ext -> 91 | TRecord (Dict.map (\_ -> deepDealiasField) fields) ext 92 | 93 | TAlias _ _ args tipe_ -> 94 | deepDealias (dealias args tipe_) 95 | 96 | TType home name args -> 97 | TType home name (List.map deepDealias args) 98 | 99 | TUnit -> 100 | TUnit 101 | 102 | TTuple a b cs -> 103 | TTuple (deepDealias a) (deepDealias b) (List.map deepDealias cs) 104 | 105 | 106 | deepDealiasField : FieldType -> FieldType 107 | deepDealiasField (FieldType index tipe) = 108 | FieldType index (deepDealias tipe) 109 | 110 | 111 | 112 | -- ITERATED DEALIAS 113 | 114 | 115 | iteratedDealias : Type -> Type 116 | iteratedDealias tipe = 117 | case tipe of 118 | TAlias _ _ args realType -> 119 | iteratedDealias (dealias args realType) 120 | 121 | _ -> 122 | tipe 123 | -------------------------------------------------------------------------------- /src/Compiler/Canonicalize/Environment/Dups.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Canonicalize.Environment.Dups exposing 2 | ( Info 3 | , ToError 4 | , Tracker 5 | , checkFields 6 | , checkFields_ 7 | , checkLocatedFields 8 | , checkLocatedFields_ 9 | , detect 10 | , detectLocated 11 | , insert 12 | , none 13 | , one 14 | , union 15 | , unions 16 | ) 17 | 18 | import Compiler.Data.Name exposing (Name) 19 | import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) 20 | import Compiler.Reporting.Annotation as A 21 | import Compiler.Reporting.Error.Canonicalize as Error exposing (Error) 22 | import Compiler.Reporting.Result as R 23 | import Data.Map as Dict exposing (Dict) 24 | import Utils.Main as Utils 25 | 26 | 27 | 28 | -- DUPLICATE TRACKER 29 | 30 | 31 | type alias Tracker value = 32 | Dict String Name (OneOrMore (Info value)) 33 | 34 | 35 | type Info value 36 | = Info A.Region value 37 | 38 | 39 | 40 | -- DETECT 41 | 42 | 43 | type alias ToError = 44 | Name -> A.Region -> A.Region -> Error 45 | 46 | 47 | detect : ToError -> Tracker a -> R.RResult i w Error (Dict String Name a) 48 | detect toError dict = 49 | Dict.foldl compare 50 | (\name values -> 51 | R.bind 52 | (\acc -> 53 | R.fmap (\b -> Dict.insert identity name b acc) 54 | (detectHelp toError name values) 55 | ) 56 | ) 57 | (R.ok Dict.empty) 58 | dict 59 | 60 | 61 | detectLocated : ToError -> Tracker a -> R.RResult i w Error (Dict String (A.Located Name) a) 62 | detectLocated toError dict = 63 | let 64 | nameLocations : Dict String Name A.Region 65 | nameLocations = 66 | Utils.mapMapMaybe identity compare extractLocation dict 67 | in 68 | dict 69 | |> Utils.mapMapKeys A.toValue compare (\k -> A.At (Maybe.withDefault A.zero <| Dict.get identity k nameLocations) k) 70 | |> R.mapTraverseWithKey A.toValue A.compareLocated (\(A.At _ name) values -> detectHelp toError name values) 71 | 72 | 73 | extractLocation : OneOrMore.OneOrMore (Info a) -> Maybe A.Region 74 | extractLocation oneOrMore = 75 | case oneOrMore of 76 | OneOrMore.One (Info region _) -> 77 | Just region 78 | 79 | OneOrMore.More _ _ -> 80 | Nothing 81 | 82 | 83 | detectHelp : ToError -> Name -> OneOrMore (Info a) -> R.RResult i w Error a 84 | detectHelp toError name values = 85 | case values of 86 | OneOrMore.One (Info _ value) -> 87 | R.ok value 88 | 89 | OneOrMore.More left right -> 90 | let 91 | ( Info r1 _, Info r2 _ ) = 92 | OneOrMore.getFirstTwo left right 93 | in 94 | R.throw (toError name r1 r2) 95 | 96 | 97 | 98 | -- CHECK FIELDS 99 | 100 | 101 | checkLocatedFields : List ( A.Located Name, a ) -> R.RResult i w Error (Dict String (A.Located Name) a) 102 | checkLocatedFields fields = 103 | detectLocated Error.DuplicateField (List.foldr addField none fields) 104 | 105 | 106 | checkFields : List ( A.Located Name, a ) -> R.RResult i w Error (Dict String Name a) 107 | checkFields fields = 108 | detect Error.DuplicateField (List.foldr addField none fields) 109 | 110 | 111 | addField : ( A.Located Name, a ) -> Tracker a -> Tracker a 112 | addField ( A.At region name, value ) dups = 113 | Utils.mapInsertWith identity OneOrMore.more name (OneOrMore.one (Info region value)) dups 114 | 115 | 116 | checkLocatedFields_ : (A.Region -> a -> b) -> List ( A.Located Name, a ) -> R.RResult i w Error (Dict String (A.Located Name) b) 117 | checkLocatedFields_ toValue fields = 118 | detectLocated Error.DuplicateField (List.foldr (addField_ toValue) none fields) 119 | 120 | 121 | checkFields_ : (A.Region -> a -> b) -> List ( A.Located Name, a ) -> R.RResult i w Error (Dict String Name b) 122 | checkFields_ toValue fields = 123 | detect Error.DuplicateField (List.foldr (addField_ toValue) none fields) 124 | 125 | 126 | addField_ : (A.Region -> a -> b) -> ( A.Located Name, a ) -> Tracker b -> Tracker b 127 | addField_ toValue ( A.At region name, value ) dups = 128 | Utils.mapInsertWith identity OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups 129 | 130 | 131 | 132 | -- BUILDING DICTIONARIES 133 | 134 | 135 | none : Tracker a 136 | none = 137 | Dict.empty 138 | 139 | 140 | one : Name -> A.Region -> value -> Tracker value 141 | one name region value = 142 | Dict.singleton identity name (OneOrMore.one (Info region value)) 143 | 144 | 145 | insert : Name -> A.Region -> a -> Tracker a -> Tracker a 146 | insert name region value dict = 147 | Utils.mapInsertWith identity (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict 148 | 149 | 150 | union : Tracker a -> Tracker a -> Tracker a 151 | union a b = 152 | Utils.mapUnionWith identity compare OneOrMore.more a b 153 | 154 | 155 | unions : List (Tracker a) -> Tracker a 156 | unions dicts = 157 | List.foldl union Dict.empty dicts 158 | -------------------------------------------------------------------------------- /src/Compiler/Compile.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Compile exposing 2 | ( Artifacts(..) 3 | , compile 4 | ) 5 | 6 | import Compiler.AST.Canonical as Can 7 | import Compiler.AST.Optimized as Opt 8 | import Compiler.AST.Source as Src 9 | import Compiler.Canonicalize.Module as Canonicalize 10 | import Compiler.Data.Name as Name exposing (Name) 11 | import Compiler.Elm.Interface as I 12 | import Compiler.Elm.ModuleName as ModuleName 13 | import Compiler.Elm.Package as Pkg 14 | import Compiler.Nitpick.PatternMatches as PatternMatches 15 | import Compiler.Optimize.Module as Optimize 16 | import Compiler.Reporting.Error as E 17 | import Compiler.Reporting.Render.Type.Localizer as Localizer 18 | import Compiler.Reporting.Result as R 19 | import Compiler.Type.Constrain.Module as Type 20 | import Compiler.Type.Solve as Type 21 | import Data.Map exposing (Dict) 22 | import System.IO as IO exposing (IO) 23 | import System.TypeCheck.IO as TypeCheck 24 | 25 | 26 | 27 | -- COMPILE 28 | 29 | 30 | type Artifacts 31 | = Artifacts Can.Module (Dict String Name Can.Annotation) Opt.LocalGraph 32 | 33 | 34 | compile : Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> IO (Result E.Error Artifacts) 35 | compile pkg ifaces modul = 36 | IO.pure (canonicalize pkg ifaces modul) 37 | |> IO.fmap 38 | (\canonicalResult -> 39 | case canonicalResult of 40 | Ok canonical -> 41 | Result.map2 (\annotations () -> annotations) 42 | (typeCheck modul canonical) 43 | (nitpick canonical) 44 | |> Result.andThen 45 | (\annotations -> 46 | optimize modul annotations canonical 47 | |> Result.map (\objects -> Artifacts canonical annotations objects) 48 | ) 49 | 50 | Err err -> 51 | Err err 52 | ) 53 | 54 | 55 | 56 | -- PHASES 57 | 58 | 59 | canonicalize : Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> Result E.Error Can.Module 60 | canonicalize pkg ifaces modul = 61 | case Tuple.second (R.run (Canonicalize.canonicalize pkg ifaces modul)) of 62 | Ok canonical -> 63 | Ok canonical 64 | 65 | Err errors -> 66 | Err (E.BadNames errors) 67 | 68 | 69 | typeCheck : Src.Module -> Can.Module -> Result E.Error (Dict String Name Can.Annotation) 70 | typeCheck modul canonical = 71 | case TypeCheck.unsafePerformIO (TypeCheck.bind Type.run (Type.constrain canonical)) of 72 | Ok annotations -> 73 | Ok annotations 74 | 75 | Err errors -> 76 | Err (E.BadTypes (Localizer.fromModule modul) errors) 77 | 78 | 79 | nitpick : Can.Module -> Result E.Error () 80 | nitpick canonical = 81 | case PatternMatches.check canonical of 82 | Ok () -> 83 | Ok () 84 | 85 | Err errors -> 86 | Err (E.BadPatterns errors) 87 | 88 | 89 | optimize : Src.Module -> Dict String Name.Name Can.Annotation -> Can.Module -> Result E.Error Opt.LocalGraph 90 | optimize modul annotations canonical = 91 | case Tuple.second (R.run (Optimize.optimize annotations canonical)) of 92 | Ok localGraph -> 93 | Ok localGraph 94 | 95 | Err errors -> 96 | Err (E.BadMains (Localizer.fromModule modul) errors) 97 | -------------------------------------------------------------------------------- /src/Compiler/Data/Bag.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Data.Bag exposing 2 | ( Bag(..) 3 | , append 4 | , empty 5 | , one 6 | , toList 7 | ) 8 | 9 | -- BAGS 10 | 11 | 12 | type Bag a 13 | = Empty 14 | | One a 15 | | Two (Bag a) (Bag a) 16 | 17 | 18 | 19 | -- HELPERS 20 | 21 | 22 | empty : Bag a 23 | empty = 24 | Empty 25 | 26 | 27 | one : a -> Bag a 28 | one = 29 | One 30 | 31 | 32 | append : Bag a -> Bag a -> Bag a 33 | append left right = 34 | case ( left, right ) of 35 | ( other, Empty ) -> 36 | other 37 | 38 | ( Empty, other ) -> 39 | other 40 | 41 | _ -> 42 | Two left right 43 | 44 | 45 | 46 | -- TO LIST 47 | 48 | 49 | toList : Bag a -> List a 50 | toList bag = 51 | toListHelp bag [] 52 | 53 | 54 | toListHelp : Bag a -> List a -> List a 55 | toListHelp bag list = 56 | case bag of 57 | Empty -> 58 | list 59 | 60 | One x -> 61 | x :: list 62 | 63 | Two a b -> 64 | toListHelp a (toListHelp b list) 65 | -------------------------------------------------------------------------------- /src/Compiler/Data/Index.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Data.Index exposing 2 | ( VerifiedList(..) 3 | , ZeroBased 4 | , first 5 | , indexedMap 6 | , indexedZipWith 7 | , next 8 | , second 9 | , third 10 | , toHuman 11 | , toMachine 12 | , zeroBasedDecoder 13 | , zeroBasedEncoder 14 | ) 15 | 16 | import Utils.Bytes.Decode as BD 17 | import Utils.Bytes.Encode as BE 18 | 19 | 20 | 21 | -- ZERO BASED 22 | 23 | 24 | type ZeroBased 25 | = ZeroBased Int 26 | 27 | 28 | first : ZeroBased 29 | first = 30 | ZeroBased 0 31 | 32 | 33 | second : ZeroBased 34 | second = 35 | ZeroBased 1 36 | 37 | 38 | third : ZeroBased 39 | third = 40 | ZeroBased 2 41 | 42 | 43 | next : ZeroBased -> ZeroBased 44 | next (ZeroBased i) = 45 | ZeroBased (i + 1) 46 | 47 | 48 | 49 | -- DESTRUCT 50 | 51 | 52 | toMachine : ZeroBased -> Int 53 | toMachine (ZeroBased index) = 54 | index 55 | 56 | 57 | toHuman : ZeroBased -> Int 58 | toHuman (ZeroBased index) = 59 | index + 1 60 | 61 | 62 | 63 | -- INDEXED MAP 64 | 65 | 66 | indexedMap : (ZeroBased -> a -> b) -> List a -> List b 67 | indexedMap func xs = 68 | List.map2 func (List.map ZeroBased (List.range 0 (List.length xs - 1))) xs 69 | 70 | 71 | {-| indexedTraverse and indexedForA are defined on `Utils` 72 | -} 73 | 74 | 75 | 76 | -- VERIFIED/INDEXED ZIP 77 | 78 | 79 | type VerifiedList a 80 | = LengthMatch (List a) 81 | | LengthMismatch Int Int 82 | 83 | 84 | indexedZipWith : (ZeroBased -> a -> b -> c) -> List a -> List b -> VerifiedList c 85 | indexedZipWith func listX listY = 86 | indexedZipWithHelp func 0 listX listY [] 87 | 88 | 89 | indexedZipWithHelp : (ZeroBased -> a -> b -> c) -> Int -> List a -> List b -> List c -> VerifiedList c 90 | indexedZipWithHelp func index listX listY revListZ = 91 | case ( listX, listY ) of 92 | ( [], [] ) -> 93 | LengthMatch (List.reverse revListZ) 94 | 95 | ( x :: xs, y :: ys ) -> 96 | indexedZipWithHelp func (index + 1) xs ys (func (ZeroBased index) x y :: revListZ) 97 | 98 | _ -> 99 | LengthMismatch (index + List.length listX) (index + List.length listY) 100 | 101 | 102 | 103 | -- ENCODERS and DECODERS 104 | 105 | 106 | zeroBasedEncoder : ZeroBased -> BE.Encoder 107 | zeroBasedEncoder (ZeroBased zeroBased) = 108 | BE.int zeroBased 109 | 110 | 111 | zeroBasedDecoder : BD.Decoder ZeroBased 112 | zeroBasedDecoder = 113 | BD.map ZeroBased BD.int 114 | -------------------------------------------------------------------------------- /src/Compiler/Data/Map/Utils.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Data.Map.Utils exposing 2 | ( any 3 | , fromKeys 4 | , fromKeysA 5 | ) 6 | 7 | import Data.Map as Dict exposing (Dict) 8 | import System.IO as IO exposing (IO) 9 | import Utils.Main as Utils 10 | 11 | 12 | 13 | -- FROM KEYS 14 | 15 | 16 | fromKeys : (comparable -> v) -> List comparable -> Dict comparable comparable v 17 | fromKeys toValue keys = 18 | Dict.fromList identity (List.map (\k -> ( k, toValue k )) keys) 19 | 20 | 21 | fromKeysA : (k -> comparable) -> (k -> IO v) -> List k -> IO (Dict comparable k v) 22 | fromKeysA toComparable toValue keys = 23 | IO.fmap (Dict.fromList toComparable) (Utils.listTraverse (\k -> IO.fmap (Tuple.pair k) (toValue k)) keys) 24 | 25 | 26 | 27 | -- ANY 28 | 29 | 30 | any : (v -> Bool) -> Dict c k v -> Bool 31 | any isGood dict = 32 | Dict.foldl (\_ _ -> EQ) (\_ v acc -> isGood v || acc) False dict 33 | -------------------------------------------------------------------------------- /src/Compiler/Data/NonEmptyList.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Data.NonEmptyList exposing 2 | ( Nonempty(..) 3 | , cons 4 | , foldr 5 | , map 6 | , singleton 7 | , sortBy 8 | , toList 9 | ) 10 | 11 | -- LIST 12 | 13 | 14 | type Nonempty a 15 | = Nonempty a (List a) 16 | 17 | 18 | singleton : a -> Nonempty a 19 | singleton a = 20 | Nonempty a [] 21 | 22 | 23 | cons : a -> Nonempty a -> Nonempty a 24 | cons a (Nonempty b bs) = 25 | Nonempty b (bs ++ [ a ]) 26 | 27 | 28 | toList : Nonempty a -> List a 29 | toList (Nonempty x xs) = 30 | x :: xs 31 | 32 | 33 | 34 | -- INSTANCES 35 | 36 | 37 | map : (a -> b) -> Nonempty a -> Nonempty b 38 | map func (Nonempty x xs) = 39 | Nonempty (func x) (List.map func xs) 40 | 41 | 42 | foldr : (a -> b -> b) -> b -> Nonempty a -> b 43 | foldr step state (Nonempty x xs) = 44 | List.foldr step state (x :: xs) 45 | 46 | 47 | 48 | -- SORT BY 49 | 50 | 51 | sortBy : (a -> comparable) -> Nonempty a -> Nonempty a 52 | sortBy toRank (Nonempty x xs) = 53 | let 54 | comparison : a -> a -> Order 55 | comparison a b = 56 | compare (toRank a) (toRank b) 57 | in 58 | case List.sortWith comparison xs of 59 | [] -> 60 | Nonempty x [] 61 | 62 | y :: ys -> 63 | case comparison x y of 64 | LT -> 65 | Nonempty x (y :: ys) 66 | 67 | EQ -> 68 | Nonempty x (y :: ys) 69 | 70 | GT -> 71 | Nonempty y (List.sortWith comparison (x :: ys)) 72 | -------------------------------------------------------------------------------- /src/Compiler/Data/OneOrMore.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Data.OneOrMore exposing 2 | ( OneOrMore(..) 3 | , destruct 4 | , getFirstTwo 5 | , map 6 | , more 7 | , one 8 | ) 9 | 10 | -- ONE OR MORE 11 | 12 | 13 | type OneOrMore a 14 | = One a 15 | | More (OneOrMore a) (OneOrMore a) 16 | 17 | 18 | one : a -> OneOrMore a 19 | one = 20 | One 21 | 22 | 23 | more : OneOrMore a -> OneOrMore a -> OneOrMore a 24 | more = 25 | More 26 | 27 | 28 | 29 | -- MAP 30 | 31 | 32 | map : (a -> b) -> OneOrMore a -> OneOrMore b 33 | map func oneOrMore = 34 | case oneOrMore of 35 | One value -> 36 | One (func value) 37 | 38 | More left right -> 39 | More (map func left) (map func right) 40 | 41 | 42 | 43 | -- DESTRUCT 44 | 45 | 46 | destruct : (a -> List a -> b) -> OneOrMore a -> b 47 | destruct func oneOrMore = 48 | destructLeft func oneOrMore [] 49 | 50 | 51 | destructLeft : (a -> List a -> b) -> OneOrMore a -> List a -> b 52 | destructLeft func oneOrMore xs = 53 | case oneOrMore of 54 | One x -> 55 | func x xs 56 | 57 | More a b -> 58 | destructLeft func a (destructRight b xs) 59 | 60 | 61 | destructRight : OneOrMore a -> List a -> List a 62 | destructRight oneOrMore xs = 63 | case oneOrMore of 64 | One x -> 65 | x :: xs 66 | 67 | More a b -> 68 | destructRight a (destructRight b xs) 69 | 70 | 71 | 72 | -- GET FIRST TWO 73 | 74 | 75 | getFirstTwo : OneOrMore a -> OneOrMore a -> ( a, a ) 76 | getFirstTwo left right = 77 | case left of 78 | One x -> 79 | ( x, getFirstOne right ) 80 | 81 | More lleft lright -> 82 | getFirstTwo lleft lright 83 | 84 | 85 | getFirstOne : OneOrMore a -> a 86 | getFirstOne oneOrMore = 87 | case oneOrMore of 88 | One x -> 89 | x 90 | 91 | More left _ -> 92 | getFirstOne left 93 | -------------------------------------------------------------------------------- /src/Compiler/Elm/Compiler/Imports.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Elm.Compiler.Imports exposing (defaults) 2 | 3 | import Compiler.AST.Source as Src 4 | import Compiler.Data.Name as Name exposing (Name) 5 | import Compiler.Elm.ModuleName as ModuleName 6 | import Compiler.Reporting.Annotation as A 7 | import System.TypeCheck.IO as IO 8 | 9 | 10 | 11 | -- DEFAULTS 12 | 13 | 14 | defaults : List Src.Import 15 | defaults = 16 | [ import_ ModuleName.basics Nothing Src.Open 17 | , import_ ModuleName.debug Nothing closed 18 | , import_ ModuleName.list Nothing (operator "::") 19 | , import_ ModuleName.maybe Nothing (typeOpen Name.maybe) 20 | , import_ ModuleName.result Nothing (typeOpen Name.result) 21 | , import_ ModuleName.string Nothing (typeClosed Name.string) 22 | , import_ ModuleName.char Nothing (typeClosed Name.char) 23 | , import_ ModuleName.tuple Nothing closed 24 | , import_ ModuleName.platform Nothing (typeClosed Name.program) 25 | , import_ ModuleName.cmd (Just Name.cmd) (typeClosed Name.cmd) 26 | , import_ ModuleName.sub (Just Name.sub) (typeClosed Name.sub) 27 | ] 28 | 29 | 30 | import_ : IO.Canonical -> Maybe Name -> Src.Exposing -> Src.Import 31 | import_ (IO.Canonical _ name) maybeAlias exposing_ = 32 | Src.Import (A.At A.zero name) maybeAlias exposing_ 33 | 34 | 35 | 36 | -- EXPOSING 37 | 38 | 39 | closed : Src.Exposing 40 | closed = 41 | Src.Explicit [] 42 | 43 | 44 | typeOpen : Name -> Src.Exposing 45 | typeOpen name = 46 | Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ] 47 | 48 | 49 | typeClosed : Name -> Src.Exposing 50 | typeClosed name = 51 | Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ] 52 | 53 | 54 | operator : Name -> Src.Exposing 55 | operator op = 56 | Src.Explicit [ Src.Operator A.zero op ] 57 | -------------------------------------------------------------------------------- /src/Compiler/Elm/Magnitude.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Elm.Magnitude exposing 2 | ( Magnitude(..) 3 | , compare 4 | , toChars 5 | ) 6 | 7 | -- MAGNITUDE 8 | 9 | 10 | type Magnitude 11 | = PATCH 12 | | MINOR 13 | | MAJOR 14 | 15 | 16 | toChars : Magnitude -> String 17 | toChars magnitude = 18 | case magnitude of 19 | PATCH -> 20 | "PATCH" 21 | 22 | MINOR -> 23 | "MINOR" 24 | 25 | MAJOR -> 26 | "MAJOR" 27 | 28 | 29 | compare : Magnitude -> Magnitude -> Order 30 | compare m1 m2 = 31 | let 32 | toInt : Magnitude -> number 33 | toInt m = 34 | case m of 35 | PATCH -> 36 | 0 37 | 38 | MINOR -> 39 | 1 40 | 41 | MAJOR -> 42 | 2 43 | in 44 | Basics.compare (toInt m1) (toInt m2) 45 | -------------------------------------------------------------------------------- /src/Compiler/Elm/String.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Elm.String exposing 2 | ( Chunk(..) 3 | , fromChunks 4 | ) 5 | 6 | import Hex 7 | import Numeric.Integer as NI 8 | 9 | 10 | 11 | -- FROM CHUNKS 12 | 13 | 14 | type Chunk 15 | = Slice Int Int 16 | | Escape Char 17 | | CodePoint Int 18 | 19 | 20 | fromChunks : String -> List Chunk -> String 21 | fromChunks src chunks = 22 | writeChunks src "" 0 chunks 23 | 24 | 25 | writeChunks : String -> String -> Int -> List Chunk -> String 26 | writeChunks src mba offset chunks = 27 | case chunks of 28 | [] -> 29 | mba 30 | 31 | chunk :: otherChunks -> 32 | case chunk of 33 | Slice ptr len -> 34 | let 35 | newOffset : Int 36 | newOffset = 37 | offset + len 38 | in 39 | writeChunks src (mba ++ String.slice ptr (ptr + len) src) newOffset otherChunks 40 | 41 | Escape word -> 42 | let 43 | newOffset : Int 44 | newOffset = 45 | offset + 2 46 | in 47 | writeChunks src (mba ++ "\\" ++ String.fromChar word) newOffset otherChunks 48 | 49 | CodePoint code -> 50 | if code < 0xFFFF then 51 | let 52 | newOffset : Int 53 | newOffset = 54 | offset + 6 55 | in 56 | writeChunks src (mba ++ writeCode code) newOffset otherChunks 57 | 58 | else 59 | let 60 | ( hi, lo ) = 61 | NI.divMod (code - 0x00010000) 0x0400 62 | 63 | hiCode : String 64 | hiCode = 65 | writeCode (hi + 0xD800) 66 | 67 | lowCode : String 68 | lowCode = 69 | writeCode (lo + 0xDC00) 70 | 71 | newOffset : Int 72 | newOffset = 73 | offset + 12 74 | in 75 | writeChunks src (mba ++ hiCode ++ lowCode) newOffset otherChunks 76 | 77 | 78 | writeCode : Int -> String 79 | writeCode code = 80 | "\\u" ++ String.padLeft 4 '0' (String.toUpper (Hex.toString code)) 81 | -------------------------------------------------------------------------------- /src/Compiler/Generate/Html.elm: -------------------------------------------------------------------------------- 1 | module Compiler.Generate.Html exposing 2 | ( leadingLines 3 | , sandwich 4 | ) 5 | 6 | import Compiler.Data.Name exposing (Name) 7 | 8 | 9 | leadingLines : Int 10 | leadingLines = 11 | 2 12 | 13 | 14 | sandwich : Name -> String -> String 15 | sandwich moduleName javascript = 16 | """ 17 | 18 | 19 | 20 | """ ++ moduleName ++ """ 21 | 22 | 23 | 24 | 25 | 26 | 

27 | 
28 | 
46 | 
47 | 
48 | """
49 | 


--------------------------------------------------------------------------------
/src/Compiler/Generate/JavaScript/Functions.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Generate.JavaScript.Functions exposing (functions)
 2 | 
 3 | -- FUNCTIONS
 4 | 
 5 | 
 6 | functions : String
 7 | functions =
 8 |     """
 9 | 
10 | function F(arity, fun, wrapper) {
11 |   wrapper.a = arity;
12 |   wrapper.f = fun;
13 |   return wrapper;
14 | }
15 | 
16 | function F2(fun) {
17 |   return F(2, fun, function(a) { return function(b) { return fun(a,b); }; })
18 | }
19 | function F3(fun) {
20 |   return F(3, fun, function(a) {
21 |     return function(b) { return function(c) { return fun(a, b, c); }; };
22 |   });
23 | }
24 | function F4(fun) {
25 |   return F(4, fun, function(a) { return function(b) { return function(c) {
26 |     return function(d) { return fun(a, b, c, d); }; }; };
27 |   });
28 | }
29 | function F5(fun) {
30 |   return F(5, fun, function(a) { return function(b) { return function(c) {
31 |     return function(d) { return function(e) { return fun(a, b, c, d, e); }; }; }; };
32 |   });
33 | }
34 | function F6(fun) {
35 |   return F(6, fun, function(a) { return function(b) { return function(c) {
36 |     return function(d) { return function(e) { return function(f) {
37 |     return fun(a, b, c, d, e, f); }; }; }; }; };
38 |   });
39 | }
40 | function F7(fun) {
41 |   return F(7, fun, function(a) { return function(b) { return function(c) {
42 |     return function(d) { return function(e) { return function(f) {
43 |     return function(g) { return fun(a, b, c, d, e, f, g); }; }; }; }; }; };
44 |   });
45 | }
46 | function F8(fun) {
47 |   return F(8, fun, function(a) { return function(b) { return function(c) {
48 |     return function(d) { return function(e) { return function(f) {
49 |     return function(g) { return function(h) {
50 |     return fun(a, b, c, d, e, f, g, h); }; }; }; }; }; }; };
51 |   });
52 | }
53 | function F9(fun) {
54 |   return F(9, fun, function(a) { return function(b) { return function(c) {
55 |     return function(d) { return function(e) { return function(f) {
56 |     return function(g) { return function(h) { return function(i) {
57 |     return fun(a, b, c, d, e, f, g, h, i); }; }; }; }; }; }; }; };
58 |   });
59 | }
60 | 
61 | function A2(fun, a, b) {
62 |   return fun.a === 2 ? fun.f(a, b) : fun(a)(b);
63 | }
64 | function A3(fun, a, b, c) {
65 |   return fun.a === 3 ? fun.f(a, b, c) : fun(a)(b)(c);
66 | }
67 | function A4(fun, a, b, c, d) {
68 |   return fun.a === 4 ? fun.f(a, b, c, d) : fun(a)(b)(c)(d);
69 | }
70 | function A5(fun, a, b, c, d, e) {
71 |   return fun.a === 5 ? fun.f(a, b, c, d, e) : fun(a)(b)(c)(d)(e);
72 | }
73 | function A6(fun, a, b, c, d, e, f) {
74 |   return fun.a === 6 ? fun.f(a, b, c, d, e, f) : fun(a)(b)(c)(d)(e)(f);
75 | }
76 | function A7(fun, a, b, c, d, e, f, g) {
77 |   return fun.a === 7 ? fun.f(a, b, c, d, e, f, g) : fun(a)(b)(c)(d)(e)(f)(g);
78 | }
79 | function A8(fun, a, b, c, d, e, f, g, h) {
80 |   return fun.a === 8 ? fun.f(a, b, c, d, e, f, g, h) : fun(a)(b)(c)(d)(e)(f)(g)(h);
81 | }
82 | function A9(fun, a, b, c, d, e, f, g, h, i) {
83 |   return fun.a === 9 ? fun.f(a, b, c, d, e, f, g, h, i) : fun(a)(b)(c)(d)(e)(f)(g)(h)(i);
84 | }
85 | 
86 | """
87 | 


--------------------------------------------------------------------------------
/src/Compiler/Generate/Mode.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Generate.Mode exposing
 2 |     ( Mode(..)
 3 |     , ShortFieldNames
 4 |     , isDebug
 5 |     , shortenFieldNames
 6 |     )
 7 | 
 8 | import Compiler.AST.Optimized as Opt
 9 | import Compiler.Data.Name as Name
10 | import Compiler.Elm.Compiler.Type.Extract as Extract
11 | import Compiler.Generate.JavaScript.Name as JsName
12 | import Data.Map as Dict exposing (Dict)
13 | import Utils.Main as Utils
14 | 
15 | 
16 | 
17 | -- MODE
18 | 
19 | 
20 | type Mode
21 |     = Dev (Maybe Extract.Types)
22 |     | Prod ShortFieldNames
23 | 
24 | 
25 | isDebug : Mode -> Bool
26 | isDebug mode =
27 |     case mode of
28 |         Dev (Just _) ->
29 |             True
30 | 
31 |         Dev Nothing ->
32 |             False
33 | 
34 |         Prod _ ->
35 |             False
36 | 
37 | 
38 | 
39 | -- SHORTEN FIELD NAMES
40 | 
41 | 
42 | type alias ShortFieldNames =
43 |     Dict String Name.Name JsName.Name
44 | 
45 | 
46 | shortenFieldNames : Opt.GlobalGraph -> ShortFieldNames
47 | shortenFieldNames (Opt.GlobalGraph _ frequencies) =
48 |     Dict.foldr compare (\_ -> addToShortNames) Dict.empty <|
49 |         Dict.foldr compare addToBuckets Dict.empty frequencies
50 | 
51 | 
52 | addToBuckets : Name.Name -> Int -> Dict Int Int (List Name.Name) -> Dict Int Int (List Name.Name)
53 | addToBuckets field frequency buckets =
54 |     Utils.mapInsertWith identity (++) frequency [ field ] buckets
55 | 
56 | 
57 | addToShortNames : List Name.Name -> ShortFieldNames -> ShortFieldNames
58 | addToShortNames fields shortNames =
59 |     List.foldl addField shortNames fields
60 | 
61 | 
62 | addField : Name.Name -> ShortFieldNames -> ShortFieldNames
63 | addField field shortNames =
64 |     let
65 |         rename : JsName.Name
66 |         rename =
67 |             JsName.fromInt (Dict.size shortNames)
68 |     in
69 |     Dict.insert identity field rename shortNames
70 | 


--------------------------------------------------------------------------------
/src/Compiler/Json/String.elm:
--------------------------------------------------------------------------------
  1 | module Compiler.Json.String exposing
  2 |     ( fromComment
  3 |     , fromName
  4 |     , fromSnippet
  5 |     , isEmpty
  6 |     )
  7 | 
  8 | import Compiler.Data.Name as Name
  9 | import Compiler.Parse.Primitives as P
 10 | 
 11 | 
 12 | 
 13 | -- JSON STRINGS
 14 | 
 15 | 
 16 | isEmpty : String -> Bool
 17 | isEmpty =
 18 |     String.isEmpty
 19 | 
 20 | 
 21 | 
 22 | -- FROM
 23 | 
 24 | 
 25 | fromSnippet : P.Snippet -> String
 26 | fromSnippet (P.Snippet { fptr, offset, length }) =
 27 |     String.slice offset (offset + length) fptr
 28 | 
 29 | 
 30 | fromName : Name.Name -> String
 31 | fromName =
 32 |     identity
 33 | 
 34 | 
 35 | 
 36 | -- FROM COMMENT
 37 | 
 38 | 
 39 | fromComment : P.Snippet -> String
 40 | fromComment ((P.Snippet { fptr, offset, length }) as snippet) =
 41 |     let
 42 |         pos : Int
 43 |         pos =
 44 |             offset
 45 | 
 46 |         end : Int
 47 |         end =
 48 |             pos + length
 49 |     in
 50 |     fromChunks snippet (chompChunks fptr pos end pos [])
 51 | 
 52 | 
 53 | chompChunks : String -> Int -> Int -> Int -> List Chunk -> List Chunk
 54 | chompChunks src pos end start revChunks =
 55 |     if pos >= end then
 56 |         List.reverse (addSlice start end revChunks)
 57 | 
 58 |     else
 59 |         let
 60 |             word : Char
 61 |             word =
 62 |                 P.unsafeIndex src pos
 63 |         in
 64 |         case word of
 65 |             '\n' ->
 66 |                 chompChunks src (pos + 1) end (pos + 1) (Escape 'n' :: addSlice start pos revChunks)
 67 | 
 68 |             '"' ->
 69 |                 chompChunks src (pos + 1) end (pos + 1) (Escape '"' :: addSlice start pos revChunks)
 70 | 
 71 |             '\\' ->
 72 |                 chompChunks src (pos + 1) end (pos + 1) (Escape '\\' :: addSlice start pos revChunks)
 73 | 
 74 |             {- \r -}
 75 |             '\u{000D}' ->
 76 |                 let
 77 |                     newPos : Int
 78 |                     newPos =
 79 |                         pos + 1
 80 |                 in
 81 |                 chompChunks src newPos end newPos (addSlice start pos revChunks)
 82 | 
 83 |             _ ->
 84 |                 let
 85 |                     width : Int
 86 |                     width =
 87 |                         P.getCharWidth word
 88 | 
 89 |                     newPos : Int
 90 |                     newPos =
 91 |                         pos + width
 92 |                 in
 93 |                 chompChunks src newPos end start revChunks
 94 | 
 95 | 
 96 | addSlice : Int -> Int -> List Chunk -> List Chunk
 97 | addSlice start end revChunks =
 98 |     if start == end then
 99 |         revChunks
100 | 
101 |     else
102 |         Slice start (end - start) :: revChunks
103 | 
104 | 
105 | 
106 | -- FROM CHUNKS
107 | 
108 | 
109 | type Chunk
110 |     = Slice Int Int
111 |     | Escape Char
112 | 
113 | 
114 | fromChunks : P.Snippet -> List Chunk -> String
115 | fromChunks snippet chunks =
116 |     writeChunks snippet chunks
117 | 
118 | 
119 | writeChunks : P.Snippet -> List Chunk -> String
120 | writeChunks snippet chunks =
121 |     writeChunksHelp snippet chunks ""
122 | 
123 | 
124 | writeChunksHelp : P.Snippet -> List Chunk -> String -> String
125 | writeChunksHelp ((P.Snippet { fptr }) as snippet) chunks acc =
126 |     case chunks of
127 |         [] ->
128 |             acc
129 | 
130 |         chunk :: chunks_ ->
131 |             writeChunksHelp snippet
132 |                 chunks_
133 |                 (case chunk of
134 |                     Slice offset len ->
135 |                         acc ++ String.left len (String.dropLeft offset fptr)
136 | 
137 |                     Escape 'n' ->
138 |                         acc ++ String.fromChar '\n'
139 | 
140 |                     Escape '"' ->
141 |                         acc ++ String.fromChar '"'
142 | 
143 |                     Escape '\\' ->
144 |                         acc ++ String.fromChar '\\'
145 | 
146 |                     Escape word ->
147 |                         acc ++ String.fromList [ '\\', word ]
148 |                 )
149 | 


--------------------------------------------------------------------------------
/src/Compiler/Nitpick/Debug.elm:
--------------------------------------------------------------------------------
  1 | module Compiler.Nitpick.Debug exposing (hasDebugUses)
  2 | 
  3 | import Compiler.AST.Optimized as Opt
  4 | import Compiler.Data.Map.Utils as Map
  5 | import Compiler.Reporting.Annotation as A
  6 | import Data.Map as Dict
  7 | 
  8 | 
  9 | 
 10 | -- HAS DEBUG USES
 11 | 
 12 | 
 13 | hasDebugUses : Opt.LocalGraph -> Bool
 14 | hasDebugUses (Opt.LocalGraph _ graph _) =
 15 |     Map.any nodeHasDebug graph
 16 | 
 17 | 
 18 | nodeHasDebug : Opt.Node -> Bool
 19 | nodeHasDebug node =
 20 |     case node of
 21 |         Opt.Define expr _ ->
 22 |             hasDebug expr
 23 | 
 24 |         Opt.TrackedDefine _ expr _ ->
 25 |             hasDebug expr
 26 | 
 27 |         Opt.DefineTailFunc _ _ expr _ ->
 28 |             hasDebug expr
 29 | 
 30 |         Opt.Ctor _ _ ->
 31 |             False
 32 | 
 33 |         Opt.Enum _ ->
 34 |             False
 35 | 
 36 |         Opt.Box ->
 37 |             False
 38 | 
 39 |         Opt.Link _ ->
 40 |             False
 41 | 
 42 |         Opt.Cycle _ vs fs _ ->
 43 |             List.any (hasDebug << Tuple.second) vs || List.any defHasDebug fs
 44 | 
 45 |         Opt.Manager _ ->
 46 |             False
 47 | 
 48 |         Opt.Kernel _ _ ->
 49 |             False
 50 | 
 51 |         Opt.PortIncoming expr _ ->
 52 |             hasDebug expr
 53 | 
 54 |         Opt.PortOutgoing expr _ ->
 55 |             hasDebug expr
 56 | 
 57 | 
 58 | hasDebug : Opt.Expr -> Bool
 59 | hasDebug expression =
 60 |     case expression of
 61 |         Opt.Bool _ _ ->
 62 |             False
 63 | 
 64 |         Opt.Chr _ _ ->
 65 |             False
 66 | 
 67 |         Opt.Str _ _ ->
 68 |             False
 69 | 
 70 |         Opt.Int _ _ ->
 71 |             False
 72 | 
 73 |         Opt.Float _ _ ->
 74 |             False
 75 | 
 76 |         Opt.VarLocal _ ->
 77 |             False
 78 | 
 79 |         Opt.TrackedVarLocal _ _ ->
 80 |             False
 81 | 
 82 |         Opt.VarGlobal _ _ ->
 83 |             False
 84 | 
 85 |         Opt.VarEnum _ _ _ ->
 86 |             False
 87 | 
 88 |         Opt.VarBox _ _ ->
 89 |             False
 90 | 
 91 |         Opt.VarCycle _ _ _ ->
 92 |             False
 93 | 
 94 |         Opt.VarDebug _ _ _ _ ->
 95 |             True
 96 | 
 97 |         Opt.VarKernel _ _ _ ->
 98 |             False
 99 | 
100 |         Opt.List _ exprs ->
101 |             List.any hasDebug exprs
102 | 
103 |         Opt.Function _ expr ->
104 |             hasDebug expr
105 | 
106 |         Opt.TrackedFunction _ expr ->
107 |             hasDebug expr
108 | 
109 |         Opt.Call _ e es ->
110 |             hasDebug e || List.any hasDebug es
111 | 
112 |         Opt.TailCall _ args ->
113 |             List.any (hasDebug << Tuple.second) args
114 | 
115 |         Opt.If conds finally ->
116 |             List.any (\( c, e ) -> hasDebug c || hasDebug e) conds || hasDebug finally
117 | 
118 |         Opt.Let def body ->
119 |             defHasDebug def || hasDebug body
120 | 
121 |         Opt.Destruct _ expr ->
122 |             hasDebug expr
123 | 
124 |         Opt.Case _ _ d jumps ->
125 |             deciderHasDebug d || List.any (hasDebug << Tuple.second) jumps
126 | 
127 |         Opt.Accessor _ _ ->
128 |             False
129 | 
130 |         Opt.Access r _ _ ->
131 |             hasDebug r
132 | 
133 |         Opt.Update _ r fs ->
134 |             hasDebug r || List.any hasDebug (Dict.values A.compareLocated fs)
135 | 
136 |         Opt.Record fs ->
137 |             List.any hasDebug (Dict.values compare fs)
138 | 
139 |         Opt.TrackedRecord _ fs ->
140 |             List.any hasDebug (Dict.values A.compareLocated fs)
141 | 
142 |         Opt.Unit ->
143 |             False
144 | 
145 |         Opt.Tuple _ a b cs ->
146 |             hasDebug a || hasDebug b || List.any hasDebug cs
147 | 
148 |         Opt.Shader _ _ _ ->
149 |             False
150 | 
151 | 
152 | defHasDebug : Opt.Def -> Bool
153 | defHasDebug def =
154 |     case def of
155 |         Opt.Def _ _ expr ->
156 |             hasDebug expr
157 | 
158 |         Opt.TailDef _ _ _ expr ->
159 |             hasDebug expr
160 | 
161 | 
162 | deciderHasDebug : Opt.Decider Opt.Choice -> Bool
163 | deciderHasDebug decider =
164 |     case decider of
165 |         Opt.Leaf (Opt.Inline expr) ->
166 |             hasDebug expr
167 | 
168 |         Opt.Leaf (Opt.Jump _) ->
169 |             False
170 | 
171 |         Opt.Chain _ success failure ->
172 |             deciderHasDebug success || deciderHasDebug failure
173 | 
174 |         Opt.FanOut _ tests fallback ->
175 |             List.any (deciderHasDebug << Tuple.second) tests || deciderHasDebug fallback
176 | 


--------------------------------------------------------------------------------
/src/Compiler/Parse/Symbol.elm:
--------------------------------------------------------------------------------
  1 | module Compiler.Parse.Symbol exposing
  2 |     ( BadOperator(..)
  3 |     , badOperatorDecoder
  4 |     , badOperatorEncoder
  5 |     , binopCharSet
  6 |     , operator
  7 |     )
  8 | 
  9 | import Compiler.Data.Name exposing (Name)
 10 | import Compiler.Parse.Primitives as P exposing (Col, Parser, Row)
 11 | import Data.Set as EverySet exposing (EverySet)
 12 | import Utils.Bytes.Decode as BD
 13 | import Utils.Bytes.Encode as BE
 14 | 
 15 | 
 16 | 
 17 | -- OPERATOR
 18 | 
 19 | 
 20 | type BadOperator
 21 |     = BadDot
 22 |     | BadPipe
 23 |     | BadArrow
 24 |     | BadEquals
 25 |     | BadHasType
 26 | 
 27 | 
 28 | operator : (Row -> Col -> x) -> (BadOperator -> Row -> Col -> x) -> Parser x Name
 29 | operator toExpectation toError =
 30 |     P.Parser <|
 31 |         \(P.State src pos end indent row col) ->
 32 |             let
 33 |                 newPos : Int
 34 |                 newPos =
 35 |                     chompOps src pos end
 36 |             in
 37 |             if pos == newPos then
 38 |                 P.Eerr row col toExpectation
 39 | 
 40 |             else
 41 |                 case String.slice pos newPos src of
 42 |                     "." ->
 43 |                         P.Eerr row col (toError BadDot)
 44 | 
 45 |                     "|" ->
 46 |                         P.Cerr row col (toError BadPipe)
 47 | 
 48 |                     "->" ->
 49 |                         P.Cerr row col (toError BadArrow)
 50 | 
 51 |                     "=" ->
 52 |                         P.Cerr row col (toError BadEquals)
 53 | 
 54 |                     ":" ->
 55 |                         P.Cerr row col (toError BadHasType)
 56 | 
 57 |                     op ->
 58 |                         let
 59 |                             newCol : Col
 60 |                             newCol =
 61 |                                 col + (newPos - pos)
 62 | 
 63 |                             newState : P.State
 64 |                             newState =
 65 |                                 P.State src newPos end indent row newCol
 66 |                         in
 67 |                         P.Cok op newState
 68 | 
 69 | 
 70 | chompOps : String -> Int -> Int -> Int
 71 | chompOps src pos end =
 72 |     if pos < end && isBinopCharHelp (P.unsafeIndex src pos) then
 73 |         chompOps src (pos + 1) end
 74 | 
 75 |     else
 76 |         pos
 77 | 
 78 | 
 79 | isBinopCharHelp : Char -> Bool
 80 | isBinopCharHelp char =
 81 |     let
 82 |         code : Int
 83 |         code =
 84 |             Char.toCode char
 85 |     in
 86 |     EverySet.member identity code binopCharSet
 87 | 
 88 | 
 89 | binopCharSet : EverySet Int Int
 90 | binopCharSet =
 91 |     EverySet.fromList identity (List.map Char.toCode (String.toList "+-/*=.<>:&|^?%!"))
 92 | 
 93 | 
 94 | 
 95 | -- ENCODERS and DECODERS
 96 | 
 97 | 
 98 | badOperatorEncoder : BadOperator -> BE.Encoder
 99 | badOperatorEncoder badOperator =
100 |     BE.unsignedInt8
101 |         (case badOperator of
102 |             BadDot ->
103 |                 0
104 | 
105 |             BadPipe ->
106 |                 1
107 | 
108 |             BadArrow ->
109 |                 2
110 | 
111 |             BadEquals ->
112 |                 3
113 | 
114 |             BadHasType ->
115 |                 4
116 |         )
117 | 
118 | 
119 | badOperatorDecoder : BD.Decoder BadOperator
120 | badOperatorDecoder =
121 |     BD.unsignedInt8
122 |         |> BD.andThen
123 |             (\idx ->
124 |                 case idx of
125 |                     0 ->
126 |                         BD.succeed BadDot
127 | 
128 |                     1 ->
129 |                         BD.succeed BadPipe
130 | 
131 |                     2 ->
132 |                         BD.succeed BadArrow
133 | 
134 |                     3 ->
135 |                         BD.succeed BadEquals
136 | 
137 |                     4 ->
138 |                         BD.succeed BadHasType
139 | 
140 |                     _ ->
141 |                         BD.fail
142 |             )
143 | 


--------------------------------------------------------------------------------
/src/Compiler/Parse/SyntaxVersion.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Parse.SyntaxVersion exposing
 2 |     ( SyntaxVersion(..)
 3 |     , decoder
 4 |     , encoder
 5 |     , fileSyntaxVersion
 6 |     )
 7 | 
 8 | {-| Compiler.Parse.SyntaxVersion
 9 | -}
10 | 
11 | import Utils.Bytes.Decode as BD
12 | import Utils.Bytes.Encode as BE
13 | 
14 | 
15 | {-| The `SyntaxVersion` type is used to specify which syntax version to work
16 | with. It provides options to differentiate between the "legacy" Elm syntax,
17 | which the Guida language builds upon, and the new Guida-specific syntax.
18 | 
19 | This type is useful when building parsers that need to distinguish between
20 | the two syntactic styles and adapt behavior accordingly.
21 | 
22 | -}
23 | type SyntaxVersion
24 |     = Elm
25 |     | Guida
26 | 
27 | 
28 | {-| Returns the syntax version based on a filepath.
29 | -}
30 | fileSyntaxVersion : String -> SyntaxVersion
31 | fileSyntaxVersion path =
32 |     if String.endsWith ".elm" path then
33 |         Elm
34 | 
35 |     else
36 |         Guida
37 | 
38 | 
39 | 
40 | -- ENCODERS and DECODERS
41 | 
42 | 
43 | encoder : SyntaxVersion -> BE.Encoder
44 | encoder syntaxVersion =
45 |     BE.unsignedInt8
46 |         (case syntaxVersion of
47 |             Elm ->
48 |                 0
49 | 
50 |             Guida ->
51 |                 1
52 |         )
53 | 
54 | 
55 | decoder : BD.Decoder SyntaxVersion
56 | decoder =
57 |     BD.unsignedInt8
58 |         |> BD.andThen
59 |             (\idx ->
60 |                 case idx of
61 |                     0 ->
62 |                         BD.succeed Elm
63 | 
64 |                     1 ->
65 |                         BD.succeed Guida
66 | 
67 |                     _ ->
68 |                         BD.fail
69 |             )
70 | 


--------------------------------------------------------------------------------
/src/Compiler/Reporting/Annotation.elm:
--------------------------------------------------------------------------------
  1 | module Compiler.Reporting.Annotation exposing
  2 |     ( Located(..)
  3 |     , Position(..)
  4 |     , Region(..)
  5 |     , at
  6 |     , compareLocated
  7 |     , locatedDecoder
  8 |     , locatedEncoder
  9 |     , merge
 10 |     , mergeRegions
 11 |     , one
 12 |     , regionDecoder
 13 |     , regionEncoder
 14 |     , toRegion
 15 |     , toValue
 16 |     , traverse
 17 |     , zero
 18 |     )
 19 | 
 20 | import System.TypeCheck.IO as IO exposing (IO)
 21 | import Utils.Bytes.Decode as BD
 22 | import Utils.Bytes.Encode as BE
 23 | 
 24 | 
 25 | 
 26 | -- LOCATED
 27 | 
 28 | 
 29 | type Located a
 30 |     = At Region a -- PERF see if unpacking region is helpful
 31 | 
 32 | 
 33 | compareLocated : Located comparable -> Located comparable -> Order
 34 | compareLocated (At _ a) (At _ b) =
 35 |     compare a b
 36 | 
 37 | 
 38 | traverse : (a -> IO b) -> Located a -> IO (Located b)
 39 | traverse func (At region value) =
 40 |     IO.fmap (At region) (func value)
 41 | 
 42 | 
 43 | toValue : Located a -> a
 44 | toValue (At _ value) =
 45 |     value
 46 | 
 47 | 
 48 | merge : Located a -> Located b -> c -> Located c
 49 | merge (At r1 _) (At r2 _) value =
 50 |     At (mergeRegions r1 r2) value
 51 | 
 52 | 
 53 | 
 54 | -- POSITION
 55 | 
 56 | 
 57 | type Position
 58 |     = Position Int Int
 59 | 
 60 | 
 61 | at : Position -> Position -> a -> Located a
 62 | at start end a =
 63 |     At (Region start end) a
 64 | 
 65 | 
 66 | 
 67 | -- REGION
 68 | 
 69 | 
 70 | type Region
 71 |     = Region Position Position
 72 | 
 73 | 
 74 | toRegion : Located a -> Region
 75 | toRegion (At region _) =
 76 |     region
 77 | 
 78 | 
 79 | mergeRegions : Region -> Region -> Region
 80 | mergeRegions (Region start _) (Region _ end) =
 81 |     Region start end
 82 | 
 83 | 
 84 | zero : Region
 85 | zero =
 86 |     Region (Position 0 0) (Position 0 0)
 87 | 
 88 | 
 89 | one : Region
 90 | one =
 91 |     Region (Position 1 1) (Position 1 1)
 92 | 
 93 | 
 94 | 
 95 | -- ENCODERS and DECODERS
 96 | 
 97 | 
 98 | regionEncoder : Region -> BE.Encoder
 99 | regionEncoder (Region start end) =
100 |     BE.sequence
101 |         [ positionEncoder start
102 |         , positionEncoder end
103 |         ]
104 | 
105 | 
106 | regionDecoder : BD.Decoder Region
107 | regionDecoder =
108 |     BD.map2 Region
109 |         positionDecoder
110 |         positionDecoder
111 | 
112 | 
113 | positionEncoder : Position -> BE.Encoder
114 | positionEncoder (Position start end) =
115 |     BE.sequence
116 |         [ BE.int start
117 |         , BE.int end
118 |         ]
119 | 
120 | 
121 | positionDecoder : BD.Decoder Position
122 | positionDecoder =
123 |     BD.map2 Position
124 |         BD.int
125 |         BD.int
126 | 
127 | 
128 | locatedEncoder : (a -> BE.Encoder) -> Located a -> BE.Encoder
129 | locatedEncoder encoder (At region value) =
130 |     BE.sequence
131 |         [ regionEncoder region
132 |         , encoder value
133 |         ]
134 | 
135 | 
136 | locatedDecoder : BD.Decoder a -> BD.Decoder (Located a)
137 | locatedDecoder decoder =
138 |     BD.map2 At
139 |         regionDecoder
140 |         (BD.lazy (\_ -> decoder))
141 | 


--------------------------------------------------------------------------------
/src/Compiler/Reporting/Render/Type/Localizer.elm:
--------------------------------------------------------------------------------
  1 | module Compiler.Reporting.Render.Type.Localizer exposing
  2 |     ( Localizer
  3 |     , empty
  4 |     , fromModule
  5 |     , fromNames
  6 |     , localizerDecoder
  7 |     , localizerEncoder
  8 |     , toChars
  9 |     , toDoc
 10 |     )
 11 | 
 12 | import Compiler.AST.Source as Src
 13 | import Compiler.Data.Name as Name exposing (Name)
 14 | import Compiler.Elm.ModuleName as ModuleName
 15 | import Compiler.Reporting.Annotation as A
 16 | import Compiler.Reporting.Doc as D
 17 | import Data.Map as Dict exposing (Dict)
 18 | import Data.Set as EverySet exposing (EverySet)
 19 | import System.TypeCheck.IO as IO
 20 | import Utils.Bytes.Decode as BD
 21 | import Utils.Bytes.Encode as BE
 22 | 
 23 | 
 24 | 
 25 | -- LOCALIZER
 26 | 
 27 | 
 28 | type Localizer
 29 |     = Localizer (Dict String Name Import)
 30 | 
 31 | 
 32 | type alias Import =
 33 |     { alias : Maybe Name
 34 |     , exposing_ : Exposing
 35 |     }
 36 | 
 37 | 
 38 | type Exposing
 39 |     = All
 40 |     | Only (EverySet String Name)
 41 | 
 42 | 
 43 | empty : Localizer
 44 | empty =
 45 |     Localizer Dict.empty
 46 | 
 47 | 
 48 | 
 49 | -- LOCALIZE
 50 | 
 51 | 
 52 | toDoc : Localizer -> IO.Canonical -> Name -> D.Doc
 53 | toDoc localizer home name =
 54 |     D.fromChars (toChars localizer home name)
 55 | 
 56 | 
 57 | toChars : Localizer -> IO.Canonical -> Name -> String
 58 | toChars (Localizer localizer) ((IO.Canonical _ home) as moduleName) name =
 59 |     case Dict.get identity home localizer of
 60 |         Nothing ->
 61 |             home ++ "." ++ name
 62 | 
 63 |         Just import_ ->
 64 |             case import_.exposing_ of
 65 |                 All ->
 66 |                     name
 67 | 
 68 |                 Only set ->
 69 |                     if EverySet.member identity name set then
 70 |                         name
 71 | 
 72 |                     else if name == Name.list && moduleName == ModuleName.list then
 73 |                         "List"
 74 | 
 75 |                     else
 76 |                         Maybe.withDefault home import_.alias ++ "." ++ name
 77 | 
 78 | 
 79 | 
 80 | -- FROM NAMES
 81 | 
 82 | 
 83 | fromNames : Dict String Name a -> Localizer
 84 | fromNames names =
 85 |     Localizer (Dict.map (\_ _ -> { alias = Nothing, exposing_ = All }) names)
 86 | 
 87 | 
 88 | 
 89 | -- FROM MODULE
 90 | 
 91 | 
 92 | fromModule : Src.Module -> Localizer
 93 | fromModule ((Src.Module _ _ _ _ imports _ _ _ _ _) as modul) =
 94 |     Localizer <|
 95 |         Dict.fromList identity <|
 96 |             (( Src.getName modul, { alias = Nothing, exposing_ = All } ) :: List.map toPair imports)
 97 | 
 98 | 
 99 | toPair : Src.Import -> ( Name, Import )
100 | toPair (Src.Import (A.At _ name) alias_ exposing_) =
101 |     ( name
102 |     , Import alias_ (toExposing exposing_)
103 |     )
104 | 
105 | 
106 | toExposing : Src.Exposing -> Exposing
107 | toExposing exposing_ =
108 |     case exposing_ of
109 |         Src.Open ->
110 |             All
111 | 
112 |         Src.Explicit exposedList ->
113 |             Only (List.foldr addType EverySet.empty exposedList)
114 | 
115 | 
116 | addType : Src.Exposed -> EverySet String Name -> EverySet String Name
117 | addType exposed types =
118 |     case exposed of
119 |         Src.Lower _ ->
120 |             types
121 | 
122 |         Src.Upper (A.At _ name) _ ->
123 |             EverySet.insert identity name types
124 | 
125 |         Src.Operator _ _ ->
126 |             types
127 | 
128 | 
129 | 
130 | -- ENCODERS and DECODERS
131 | 
132 | 
133 | localizerEncoder : Localizer -> BE.Encoder
134 | localizerEncoder (Localizer localizer) =
135 |     BE.assocListDict compare BE.string importEncoder localizer
136 | 
137 | 
138 | localizerDecoder : BD.Decoder Localizer
139 | localizerDecoder =
140 |     BD.map Localizer (BD.assocListDict identity BD.string importDecoder)
141 | 
142 | 
143 | importEncoder : Import -> BE.Encoder
144 | importEncoder import_ =
145 |     BE.sequence
146 |         [ BE.maybe BE.string import_.alias
147 |         , exposingEncoder import_.exposing_
148 |         ]
149 | 
150 | 
151 | importDecoder : BD.Decoder Import
152 | importDecoder =
153 |     BD.map2 Import
154 |         (BD.maybe BD.string)
155 |         exposingDecoder
156 | 
157 | 
158 | exposingEncoder : Exposing -> BE.Encoder
159 | exposingEncoder exposing_ =
160 |     case exposing_ of
161 |         All ->
162 |             BE.unsignedInt8 0
163 | 
164 |         Only set ->
165 |             BE.sequence
166 |                 [ BE.unsignedInt8 1
167 |                 , BE.everySet compare BE.string set
168 |                 ]
169 | 
170 | 
171 | exposingDecoder : BD.Decoder Exposing
172 | exposingDecoder =
173 |     BD.unsignedInt8
174 |         |> BD.andThen
175 |             (\type_ ->
176 |                 case type_ of
177 |                     0 ->
178 |                         BD.succeed All
179 | 
180 |                     1 ->
181 |                         BD.map Only (BD.everySet identity BD.string)
182 | 
183 |                     _ ->
184 |                         BD.fail
185 |             )
186 | 


--------------------------------------------------------------------------------
/src/Compiler/Reporting/Report.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Reporting.Report exposing (Report(..))
 2 | 
 3 | import Compiler.Reporting.Annotation as A
 4 | import Compiler.Reporting.Doc as D
 5 | 
 6 | 
 7 | 
 8 | -- BUILD REPORTS
 9 | 
10 | 
11 | type Report
12 |     = Report String A.Region (List String) D.Doc
13 | 


--------------------------------------------------------------------------------
/src/Compiler/Reporting/Suggest.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Reporting.Suggest exposing
 2 |     ( distance
 3 |     , rank
 4 |     , sort
 5 |     )
 6 | 
 7 | import Levenshtein
 8 | 
 9 | 
10 | 
11 | -- DISTANCE
12 | 
13 | 
14 | distance : String -> String -> Int
15 | distance =
16 |     Levenshtein.distance
17 | 
18 | 
19 | 
20 | -- SORT
21 | 
22 | 
23 | sort : String -> (a -> String) -> List a -> List a
24 | sort target toString =
25 |     List.sortBy
26 |         (distance (String.toLower target)
27 |             << String.toLower
28 |             << toString
29 |         )
30 | 
31 | 
32 | 
33 | -- RANK
34 | 
35 | 
36 | rank : String -> (a -> String) -> List a -> List ( Int, a )
37 | rank target toString values =
38 |     let
39 |         toRank : a -> Int
40 |         toRank v =
41 |             distance (String.toLower target) (String.toLower (toString v))
42 | 
43 |         addRank : a -> ( Int, a )
44 |         addRank v =
45 |             ( toRank v, v )
46 |     in
47 |     List.sortBy Tuple.first (List.map addRank values)
48 | 


--------------------------------------------------------------------------------
/src/Compiler/Reporting/Warning.elm:
--------------------------------------------------------------------------------
  1 | module Compiler.Reporting.Warning exposing
  2 |     ( Context(..)
  3 |     , Warning(..)
  4 |     , toReport
  5 |     )
  6 | 
  7 | import Compiler.AST.Canonical as Can
  8 | import Compiler.AST.Utils.Type as Type
  9 | import Compiler.Data.Name exposing (Name)
 10 | import Compiler.Reporting.Annotation as A
 11 | import Compiler.Reporting.Doc as D
 12 | import Compiler.Reporting.Render.Code as Code
 13 | import Compiler.Reporting.Render.Type as RT
 14 | import Compiler.Reporting.Render.Type.Localizer as L
 15 | import Compiler.Reporting.Report exposing (Report(..))
 16 | 
 17 | 
 18 | 
 19 | -- ALL POSSIBLE WARNINGS
 20 | 
 21 | 
 22 | type Warning
 23 |     = UnusedImport A.Region Name
 24 |     | UnusedVariable A.Region Context Name
 25 |     | MissingTypeAnnotation A.Region Name Can.Type
 26 | 
 27 | 
 28 | type Context
 29 |     = Def
 30 |     | Pattern
 31 | 
 32 | 
 33 | 
 34 | -- TO REPORT
 35 | 
 36 | 
 37 | toReport : L.Localizer -> Code.Source -> Warning -> Report
 38 | toReport localizer source warning =
 39 |     case warning of
 40 |         UnusedImport region moduleName ->
 41 |             Report "unused import" region [] <|
 42 |                 Code.toSnippet source region Nothing <|
 43 |                     ( D.reflow ("Nothing from the `" ++ moduleName ++ "` module is used in this file.")
 44 |                     , D.fromChars "I recommend removing unused imports."
 45 |                     )
 46 | 
 47 |         UnusedVariable region context name ->
 48 |             let
 49 |                 title : String
 50 |                 title =
 51 |                     defOrPat context "unused definition" "unused variable"
 52 |             in
 53 |             Report title region [] <|
 54 |                 Code.toSnippet source region Nothing <|
 55 |                     ( D.reflow ("You are not using `" ++ name ++ "` anywhere.")
 56 |                     , D.stack
 57 |                         [ D.reflow <|
 58 |                             "Is there a typo? Maybe you intended to use `"
 59 |                                 ++ name
 60 |                                 ++ "` somewhere but typed another name instead?"
 61 |                         , D.reflow <|
 62 |                             defOrPat context
 63 |                                 "If you are sure there is no typo, remove the definition. This way future readers will not have to wonder why it is there!"
 64 |                                 ("If you are sure there is no typo, replace `"
 65 |                                     ++ name
 66 |                                     ++ "` with _ so future readers will not have to wonder why it is there!"
 67 |                                 )
 68 |                         ]
 69 |                     )
 70 | 
 71 |         MissingTypeAnnotation region name inferredType ->
 72 |             Report "missing type annotation" region [] <|
 73 |                 Code.toSnippet source region Nothing <|
 74 |                     ( D.reflow <|
 75 |                         case Type.deepDealias inferredType of
 76 |                             Can.TLambda _ _ ->
 77 |                                 "The `" ++ name ++ "` function has no type annotation."
 78 | 
 79 |                             _ ->
 80 |                                 "The `" ++ name ++ "` definition has no type annotation."
 81 |                     , D.stack
 82 |                         [ D.fromChars "I inferred the type annotation myself though! You can copy it into your code:"
 83 |                         , D.green <|
 84 |                             D.hang 4 <|
 85 |                                 D.sep
 86 |                                     [ D.fromName name |> D.a (D.fromChars " :")
 87 |                                     , RT.canToDoc localizer RT.None inferredType
 88 |                                     ]
 89 |                         ]
 90 |                     )
 91 | 
 92 | 
 93 | defOrPat : Context -> a -> a -> a
 94 | defOrPat context def pat =
 95 |     case context of
 96 |         Def ->
 97 |             def
 98 | 
 99 |         Pattern ->
100 |             pat
101 | 


--------------------------------------------------------------------------------
/src/Compiler/Type/Instantiate.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Type.Instantiate exposing
 2 |     ( FreeVars
 3 |     , fromSrcType
 4 |     )
 5 | 
 6 | import Compiler.AST.Canonical as Can
 7 | import Compiler.Data.Name exposing (Name)
 8 | import Compiler.Type.Type exposing (Type(..))
 9 | import Data.Map as Dict exposing (Dict)
10 | import System.TypeCheck.IO as IO exposing (IO)
11 | import Utils.Main as Utils
12 | 
13 | 
14 | 
15 | -- FREE VARS
16 | 
17 | 
18 | type alias FreeVars =
19 |     Dict String Name Type
20 | 
21 | 
22 | 
23 | -- FROM SOURCE TYPE
24 | 
25 | 
26 | fromSrcType : FreeVars -> Can.Type -> IO Type
27 | fromSrcType freeVars sourceType =
28 |     case sourceType of
29 |         Can.TLambda arg result ->
30 |             IO.pure FunN
31 |                 |> IO.apply (fromSrcType freeVars arg)
32 |                 |> IO.apply (fromSrcType freeVars result)
33 | 
34 |         Can.TVar name ->
35 |             IO.pure (Utils.find identity name freeVars)
36 | 
37 |         Can.TType home name args ->
38 |             IO.fmap (AppN home name)
39 |                 (IO.traverseList (fromSrcType freeVars) args)
40 | 
41 |         Can.TAlias home name args aliasedType ->
42 |             IO.traverseList (IO.traverseTuple (fromSrcType freeVars)) args
43 |                 |> IO.bind
44 |                     (\targs ->
45 |                         IO.fmap (AliasN home name targs)
46 |                             (case aliasedType of
47 |                                 Can.Filled realType ->
48 |                                     fromSrcType freeVars realType
49 | 
50 |                                 Can.Holey realType ->
51 |                                     fromSrcType (Dict.fromList identity targs) realType
52 |                             )
53 |                     )
54 | 
55 |         Can.TTuple a b maybeC ->
56 |             IO.pure TupleN
57 |                 |> IO.apply (fromSrcType freeVars a)
58 |                 |> IO.apply (fromSrcType freeVars b)
59 |                 |> IO.apply (IO.traverseList (fromSrcType freeVars) maybeC)
60 | 
61 |         Can.TUnit ->
62 |             IO.pure UnitN
63 | 
64 |         Can.TRecord fields maybeExt ->
65 |             IO.pure RecordN
66 |                 |> IO.apply (IO.traverseMap identity compare (fromSrcFieldType freeVars) fields)
67 |                 |> IO.apply
68 |                     (case maybeExt of
69 |                         Nothing ->
70 |                             IO.pure EmptyRecordN
71 | 
72 |                         Just ext ->
73 |                             IO.pure (Utils.find identity ext freeVars)
74 |                     )
75 | 
76 | 
77 | fromSrcFieldType : Dict String Name Type -> Can.FieldType -> IO Type
78 | fromSrcFieldType freeVars (Can.FieldType _ tipe) =
79 |     fromSrcType freeVars tipe
80 | 


--------------------------------------------------------------------------------
/src/Compiler/Type/Occurs.elm:
--------------------------------------------------------------------------------
 1 | module Compiler.Type.Occurs exposing (occurs)
 2 | 
 3 | import Compiler.Type.UnionFind as UF
 4 | import Data.Map as Dict
 5 | import System.TypeCheck.IO as IO exposing (IO)
 6 | 
 7 | 
 8 | 
 9 | -- OCCURS
10 | 
11 | 
12 | occurs : IO.Variable -> IO Bool
13 | occurs var =
14 |     occursHelp [] var False
15 | 
16 | 
17 | occursHelp : List IO.Variable -> IO.Variable -> Bool -> IO Bool
18 | occursHelp seen var foundCycle =
19 |     if List.member var seen then
20 |         IO.pure True
21 | 
22 |     else
23 |         UF.get var
24 |             |> IO.bind
25 |                 (\(IO.Descriptor content _ _ _) ->
26 |                     case content of
27 |                         IO.FlexVar _ ->
28 |                             IO.pure foundCycle
29 | 
30 |                         IO.FlexSuper _ _ ->
31 |                             IO.pure foundCycle
32 | 
33 |                         IO.RigidVar _ ->
34 |                             IO.pure foundCycle
35 | 
36 |                         IO.RigidSuper _ _ ->
37 |                             IO.pure foundCycle
38 | 
39 |                         IO.Structure term ->
40 |                             let
41 |                                 newSeen : List IO.Variable
42 |                                 newSeen =
43 |                                     var :: seen
44 |                             in
45 |                             case term of
46 |                                 IO.App1 _ _ args ->
47 |                                     IO.foldrM (occursHelp newSeen) foundCycle args
48 | 
49 |                                 IO.Fun1 a b ->
50 |                                     IO.bind (occursHelp newSeen a)
51 |                                         (occursHelp newSeen b foundCycle)
52 | 
53 |                                 IO.EmptyRecord1 ->
54 |                                     IO.pure foundCycle
55 | 
56 |                                 IO.Record1 fields ext ->
57 |                                     IO.bind (occursHelp newSeen ext) <|
58 |                                         IO.foldrM (occursHelp newSeen) foundCycle (Dict.values compare fields)
59 | 
60 |                                 IO.Unit1 ->
61 |                                     IO.pure foundCycle
62 | 
63 |                                 IO.Tuple1 a b cs ->
64 |                                     IO.bind (occursHelp newSeen a)
65 |                                         (IO.bind (occursHelp newSeen b)
66 |                                             (IO.foldrM (occursHelp newSeen) foundCycle cs)
67 |                                         )
68 | 
69 |                         IO.Alias _ _ args _ ->
70 |                             IO.foldrM (occursHelp (var :: seen)) foundCycle (List.map Tuple.second args)
71 | 
72 |                         IO.Error ->
73 |                             IO.pure foundCycle
74 |                 )
75 | 


--------------------------------------------------------------------------------
/src/Control/Monad/State/Strict.elm:
--------------------------------------------------------------------------------
 1 | module Control.Monad.State.Strict exposing
 2 |     ( StateT(..)
 3 |     , evalStateT
 4 |     , fmap
 5 |     , get
 6 |     , liftIO
 7 |     , put
 8 |     )
 9 | 
10 | {-| Lazy state monads, passing an updatable state through a computation.
11 | -}
12 | 
13 | import Json.Decode as Decode
14 | import Json.Encode as Encode
15 | import System.IO as IO exposing (IO)
16 | import Utils.Impure as Impure
17 | 
18 | 
19 | {-| newtype StateT s m a
20 | 
21 | A state transformer monad parameterized by:
22 | 
23 | s - The state.
24 | m - The inner monad. (== IO)
25 | 
26 | The return function leaves the state unchanged, while >>= uses the final state of the first computation as the initial state of the second.
27 | 
28 | Ref.: 
29 | 
30 | -}
31 | type StateT s a
32 |     = StateT (s -> IO ( a, s ))
33 | 
34 | 
35 | evalStateT : StateT s a -> s -> IO a
36 | evalStateT (StateT f) =
37 |     f >> IO.fmap Tuple.first
38 | 
39 | 
40 | liftIO : IO a -> StateT s a
41 | liftIO io =
42 |     StateT (\s -> IO.fmap (\a -> ( a, s )) io)
43 | 
44 | 
45 | apply : StateT s a -> StateT s (a -> b) -> StateT s b
46 | apply (StateT arg) (StateT func) =
47 |     StateT
48 |         (\s ->
49 |             arg s
50 |                 |> IO.bind
51 |                     (\( a, sa ) ->
52 |                         func sa
53 |                             |> IO.fmap (\( fb, sb ) -> ( fb a, sb ))
54 |                     )
55 |         )
56 | 
57 | 
58 | fmap : (a -> b) -> StateT s a -> StateT s b
59 | fmap func argStateT =
60 |     apply argStateT (pure func)
61 | 
62 | 
63 | pure : a -> StateT s a
64 | pure value =
65 |     StateT (\s -> IO.pure ( value, s ))
66 | 
67 | 
68 | get : StateT s IO.ReplState
69 | get =
70 |     liftIO
71 |         (Impure.task "getStateT"
72 |             []
73 |             Impure.EmptyBody
74 |             (Impure.DecoderResolver
75 |                 (Decode.map3 (\imports types decls -> IO.ReplState imports types decls)
76 |                     (Decode.field "imports" (Decode.dict Decode.string))
77 |                     (Decode.field "types" (Decode.dict Decode.string))
78 |                     (Decode.field "decls" (Decode.dict Decode.string))
79 |                 )
80 |             )
81 |         )
82 | 
83 | 
84 | put : IO.ReplState -> IO ()
85 | put (IO.ReplState imports types decls) =
86 |     Impure.task "putStateT"
87 |         []
88 |         (Impure.JsonBody
89 |             (Encode.object
90 |                 [ ( "imports", Encode.dict identity Encode.string imports )
91 |                 , ( "types", Encode.dict identity Encode.string types )
92 |                 , ( "decls", Encode.dict identity Encode.string decls )
93 |                 ]
94 |             )
95 |         )
96 |         (Impure.Always ())
97 | 


--------------------------------------------------------------------------------
/src/Control/Monad/State/TypeCheck/Strict.elm:
--------------------------------------------------------------------------------
  1 | module Control.Monad.State.TypeCheck.Strict exposing
  2 |     ( StateT(..)
  3 |     , apply
  4 |     , bind
  5 |     , evalStateT
  6 |     , fmap
  7 |     , gets
  8 |     , liftIO
  9 |     , modify
 10 |     , pure
 11 |     , runStateT
 12 |     , traverseList
 13 |     , traverseMap
 14 |     , traverseMaybe
 15 |     , traverseTuple
 16 |     )
 17 | 
 18 | {-| Lazy state monads, passing an updatable state through a computation.
 19 | -}
 20 | 
 21 | import Data.Map as Dict exposing (Dict)
 22 | import System.TypeCheck.IO as IO exposing (IO)
 23 | 
 24 | 
 25 | {-| newtype StateT s m a
 26 | 
 27 | A state transformer monad parameterized by:
 28 | 
 29 | s - The state.
 30 | m - The inner monad. (== IO)
 31 | 
 32 | The return function leaves the state unchanged, while >>= uses the final state of the first computation as the initial state of the second.
 33 | 
 34 | Ref.: 
 35 | 
 36 | -}
 37 | type StateT s a
 38 |     = StateT (s -> IO ( a, s ))
 39 | 
 40 | 
 41 | runStateT : StateT s a -> s -> IO ( a, s )
 42 | runStateT (StateT f) =
 43 |     f
 44 | 
 45 | 
 46 | evalStateT : StateT s a -> s -> IO a
 47 | evalStateT (StateT f) =
 48 |     f >> IO.fmap Tuple.first
 49 | 
 50 | 
 51 | liftIO : IO a -> StateT s a
 52 | liftIO io =
 53 |     StateT (\s -> IO.fmap (\a -> ( a, s )) io)
 54 | 
 55 | 
 56 | apply : StateT s a -> StateT s (a -> b) -> StateT s b
 57 | apply (StateT arg) (StateT func) =
 58 |     StateT
 59 |         (\s ->
 60 |             arg s
 61 |                 |> IO.bind
 62 |                     (\( a, sa ) ->
 63 |                         func sa
 64 |                             |> IO.fmap (\( fb, sb ) -> ( fb a, sb ))
 65 |                     )
 66 |         )
 67 | 
 68 | 
 69 | fmap : (a -> b) -> StateT s a -> StateT s b
 70 | fmap func argStateT =
 71 |     apply argStateT (pure func)
 72 | 
 73 | 
 74 | bind : (a -> StateT s b) -> StateT s a -> StateT s b
 75 | bind func (StateT arg) =
 76 |     StateT
 77 |         (\s ->
 78 |             arg s
 79 |                 |> IO.bind
 80 |                     (\( a, sa ) ->
 81 |                         case func a of
 82 |                             StateT fb ->
 83 |                                 fb sa
 84 |                     )
 85 |         )
 86 | 
 87 | 
 88 | pure : a -> StateT s a
 89 | pure value =
 90 |     StateT (\s -> IO.pure ( value, s ))
 91 | 
 92 | 
 93 | gets : (s -> a) -> StateT s a
 94 | gets f =
 95 |     StateT (\s -> IO.pure ( f s, s ))
 96 | 
 97 | 
 98 | modify : (s -> s) -> StateT s ()
 99 | modify f =
100 |     StateT (\s -> IO.pure ( (), f s ))
101 | 
102 | 
103 | traverseList : (a -> StateT s b) -> List a -> StateT s (List b)
104 | traverseList f =
105 |     List.foldr (\a -> bind (\c -> fmap (\va -> va :: c) (f a)))
106 |         (pure [])
107 | 
108 | 
109 | traverseTuple : (b -> StateT s c) -> ( a, b ) -> StateT s ( a, c )
110 | traverseTuple f ( a, b ) =
111 |     fmap (Tuple.pair a) (f b)
112 | 
113 | 
114 | traverseMap : (k -> k -> Order) -> (k -> comparable) -> (a -> StateT s b) -> Dict comparable k a -> StateT s (Dict comparable k b)
115 | traverseMap keyComparison toComparable f =
116 |     traverseMapWithKey keyComparison toComparable (\_ -> f)
117 | 
118 | 
119 | traverseMapWithKey : (k -> k -> Order) -> (k -> comparable) -> (k -> a -> StateT s b) -> Dict comparable k a -> StateT s (Dict comparable k b)
120 | traverseMapWithKey keyComparison toComparable f =
121 |     Dict.foldl keyComparison
122 |         (\k a -> bind (\c -> fmap (\va -> Dict.insert toComparable k va c) (f k a)))
123 |         (pure Dict.empty)
124 | 
125 | 
126 | traverseMaybe : (a -> StateT s b) -> Maybe a -> StateT s (Maybe b)
127 | traverseMaybe f a =
128 |     case Maybe.map f a of
129 |         Just b ->
130 |             fmap Just b
131 | 
132 |         Nothing ->
133 |             pure Nothing
134 | 


--------------------------------------------------------------------------------
/src/Data/IORef.elm:
--------------------------------------------------------------------------------
  1 | module Data.IORef exposing
  2 |     ( IORef(..)
  3 |     , modifyIORefDescriptor
  4 |     , modifyIORefMVector
  5 |     , newIORefDescriptor
  6 |     , newIORefMVector
  7 |     , newIORefPointInfo
  8 |     , newIORefWeight
  9 |     , readIORefDescriptor
 10 |     , readIORefMVector
 11 |     , readIORefPointInfo
 12 |     , readIORefWeight
 13 |     , writeIORefDescriptor
 14 |     , writeIORefMVector
 15 |     , writeIORefPointInfo
 16 |     , writeIORefWeight
 17 |     )
 18 | 
 19 | import Array exposing (Array)
 20 | import System.TypeCheck.IO as IO exposing (IO)
 21 | import Utils.Crash exposing (crash)
 22 | 
 23 | 
 24 | type IORef a
 25 |     = IORef Int
 26 | 
 27 | 
 28 | newIORefWeight : Int -> IO (IORef Int)
 29 | newIORefWeight value =
 30 |     \s -> ( { s | ioRefsWeight = Array.push value s.ioRefsWeight }, IORef (Array.length s.ioRefsWeight) )
 31 | 
 32 | 
 33 | newIORefPointInfo : IO.PointInfo -> IO (IORef IO.PointInfo)
 34 | newIORefPointInfo value =
 35 |     \s -> ( { s | ioRefsPointInfo = Array.push value s.ioRefsPointInfo }, IORef (Array.length s.ioRefsPointInfo) )
 36 | 
 37 | 
 38 | newIORefDescriptor : IO.Descriptor -> IO (IORef IO.Descriptor)
 39 | newIORefDescriptor value =
 40 |     \s -> ( { s | ioRefsDescriptor = Array.push value s.ioRefsDescriptor }, IORef (Array.length s.ioRefsDescriptor) )
 41 | 
 42 | 
 43 | newIORefMVector : Array (Maybe (List IO.Variable)) -> IO (IORef (Array (Maybe (List IO.Variable))))
 44 | newIORefMVector value =
 45 |     \s -> ( { s | ioRefsMVector = Array.push value s.ioRefsMVector }, IORef (Array.length s.ioRefsMVector) )
 46 | 
 47 | 
 48 | readIORefWeight : IORef Int -> IO Int
 49 | readIORefWeight (IORef ref) =
 50 |     \s ->
 51 |         case Array.get ref s.ioRefsWeight of
 52 |             Just value ->
 53 |                 ( s, value )
 54 | 
 55 |             Nothing ->
 56 |                 crash "Data.IORef.readIORefWeight: could not find entry"
 57 | 
 58 | 
 59 | readIORefPointInfo : IORef IO.PointInfo -> IO IO.PointInfo
 60 | readIORefPointInfo (IORef ref) =
 61 |     \s ->
 62 |         case Array.get ref s.ioRefsPointInfo of
 63 |             Just value ->
 64 |                 ( s, value )
 65 | 
 66 |             Nothing ->
 67 |                 crash "Data.IORef.readIORefPointInfo: could not find entry"
 68 | 
 69 | 
 70 | readIORefDescriptor : IORef IO.Descriptor -> IO IO.Descriptor
 71 | readIORefDescriptor (IORef ref) =
 72 |     \s ->
 73 |         case Array.get ref s.ioRefsDescriptor of
 74 |             Just value ->
 75 |                 ( s, value )
 76 | 
 77 |             Nothing ->
 78 |                 crash "Data.IORef.readIORefDescriptor: could not find entry"
 79 | 
 80 | 
 81 | readIORefMVector : IORef (Array (Maybe (List IO.Variable))) -> IO (Array (Maybe (List IO.Variable)))
 82 | readIORefMVector (IORef ref) =
 83 |     \s ->
 84 |         case Array.get ref s.ioRefsMVector of
 85 |             Just value ->
 86 |                 ( s, value )
 87 | 
 88 |             Nothing ->
 89 |                 crash "Data.IORef.readIORefMVector: could not find entry"
 90 | 
 91 | 
 92 | writeIORefWeight : IORef Int -> Int -> IO ()
 93 | writeIORefWeight (IORef ref) value =
 94 |     \s -> ( { s | ioRefsWeight = Array.set ref value s.ioRefsWeight }, () )
 95 | 
 96 | 
 97 | writeIORefPointInfo : IORef IO.PointInfo -> IO.PointInfo -> IO ()
 98 | writeIORefPointInfo (IORef ref) value =
 99 |     \s -> ( { s | ioRefsPointInfo = Array.set ref value s.ioRefsPointInfo }, () )
100 | 
101 | 
102 | writeIORefDescriptor : IORef IO.Descriptor -> IO.Descriptor -> IO ()
103 | writeIORefDescriptor (IORef ref) value =
104 |     \s -> ( { s | ioRefsDescriptor = Array.set ref value s.ioRefsDescriptor }, () )
105 | 
106 | 
107 | writeIORefMVector : IORef (Array (Maybe (List IO.Variable))) -> Array (Maybe (List IO.Variable)) -> IO ()
108 | writeIORefMVector (IORef ref) value =
109 |     \s -> ( { s | ioRefsMVector = Array.set ref value s.ioRefsMVector }, () )
110 | 
111 | 
112 | modifyIORefDescriptor : IORef IO.Descriptor -> (IO.Descriptor -> IO.Descriptor) -> IO ()
113 | modifyIORefDescriptor ioRef func =
114 |     readIORefDescriptor ioRef
115 |         |> IO.bind (\value -> writeIORefDescriptor ioRef (func value))
116 | 
117 | 
118 | modifyIORefMVector : IORef (Array (Maybe (List IO.Variable))) -> (Array (Maybe (List IO.Variable)) -> Array (Maybe (List IO.Variable))) -> IO ()
119 | modifyIORefMVector ioRef func =
120 |     readIORefMVector ioRef
121 |         |> IO.bind (\value -> writeIORefMVector ioRef (func value))
122 | 


--------------------------------------------------------------------------------
/src/Data/Vector.elm:
--------------------------------------------------------------------------------
 1 | module Data.Vector exposing
 2 |     ( forM_
 3 |     , imapM_
 4 |     , unsafeFreeze
 5 |     , unsafeInit
 6 |     , unsafeLast
 7 |     )
 8 | 
 9 | import Array exposing (Array)
10 | import Data.IORef as IORef exposing (IORef)
11 | import System.TypeCheck.IO as IO exposing (IO, Variable)
12 | import Utils.Crash exposing (crash)
13 | 
14 | 
15 | unsafeLast : IORef (Array (Maybe (List Variable))) -> IO (List Variable)
16 | unsafeLast ioRef =
17 |     IORef.readIORefMVector ioRef
18 |         |> IO.fmap
19 |             (\array ->
20 |                 case Array.get (Array.length array - 1) array of
21 |                     Just (Just value) ->
22 |                         value
23 | 
24 |                     Just Nothing ->
25 |                         crash "Data.Vector.unsafeLast: invalid value"
26 | 
27 |                     Nothing ->
28 |                         crash "Data.Vector.unsafeLast: empty array"
29 |             )
30 | 
31 | 
32 | unsafeInit : IORef (Array (Maybe a)) -> IORef (Array (Maybe a))
33 | unsafeInit =
34 |     identity
35 | 
36 | 
37 | imapM_ : (Int -> List Variable -> IO b) -> IORef (Array (Maybe (List IO.Variable))) -> IO ()
38 | imapM_ action ioRef =
39 |     IORef.readIORefMVector ioRef
40 |         |> IO.bind
41 |             (\value ->
42 |                 Array.foldl
43 |                     (\( i, maybeX ) ioAcc ->
44 |                         case maybeX of
45 |                             Just x ->
46 |                                 IO.bind
47 |                                     (\acc ->
48 |                                         IO.fmap (\newX -> Array.push (Just newX) acc)
49 |                                             (action i x)
50 |                                     )
51 |                                     ioAcc
52 | 
53 |                             Nothing ->
54 |                                 ioAcc
55 |                     )
56 |                     (IO.pure Array.empty)
57 |                     (Array.indexedMap Tuple.pair value)
58 |                     |> IO.fmap (\_ -> ())
59 |             )
60 | 
61 | 
62 | mapM_ : (List IO.Variable -> IO b) -> IORef (Array (Maybe (List IO.Variable))) -> IO ()
63 | mapM_ action ioRef =
64 |     imapM_ (\_ -> action) ioRef
65 | 
66 | 
67 | forM_ : IORef (Array (Maybe (List IO.Variable))) -> (List IO.Variable -> IO b) -> IO ()
68 | forM_ ioRef action =
69 |     mapM_ action ioRef
70 | 
71 | 
72 | unsafeFreeze : IORef (Array (Maybe a)) -> IO (IORef (Array (Maybe a)))
73 | unsafeFreeze =
74 |     IO.pure
75 | 


--------------------------------------------------------------------------------
/src/Data/Vector/Mutable.elm:
--------------------------------------------------------------------------------
 1 | module Data.Vector.Mutable exposing
 2 |     ( grow
 3 |     , length
 4 |     , modify
 5 |     , read
 6 |     , replicate
 7 |     , write
 8 |     )
 9 | 
10 | import Array exposing (Array)
11 | import Array.Extra as Array
12 | import Data.IORef as IORef exposing (IORef)
13 | import System.TypeCheck.IO as IO exposing (IO, Variable)
14 | import Utils.Crash exposing (crash)
15 | 
16 | 
17 | length : IORef (Array (Maybe (List Variable))) -> IO Int
18 | length =
19 |     IORef.readIORefMVector
20 |         >> IO.fmap Array.length
21 | 
22 | 
23 | replicate : Int -> List Variable -> IO (IORef (Array (Maybe (List Variable))))
24 | replicate n e =
25 |     IORef.newIORefMVector (Array.repeat n (Just e))
26 | 
27 | 
28 | grow : IORef (Array (Maybe (List Variable))) -> Int -> IO (IORef (Array (Maybe (List Variable))))
29 | grow ioRef length_ =
30 |     IORef.readIORefMVector ioRef
31 |         |> IO.bind
32 |             (\value ->
33 |                 IORef.writeIORefMVector ioRef
34 |                     (Array.append value (Array.repeat length_ Nothing))
35 |             )
36 |         |> IO.fmap (\_ -> ioRef)
37 | 
38 | 
39 | read : IORef (Array (Maybe (List Variable))) -> Int -> IO (List Variable)
40 | read ioRef i =
41 |     IORef.readIORefMVector ioRef
42 |         |> IO.fmap
43 |             (\array ->
44 |                 case Array.get i array of
45 |                     Just (Just value) ->
46 |                         value
47 | 
48 |                     Just Nothing ->
49 |                         crash "Data.Vector.read: invalid value"
50 | 
51 |                     Nothing ->
52 |                         crash "Data.Vector.read: could not find entry"
53 |             )
54 | 
55 | 
56 | write : IORef (Array (Maybe (List Variable))) -> Int -> List Variable -> IO ()
57 | write ioRef i x =
58 |     IORef.modifyIORefMVector ioRef
59 |         (Array.set i (Just x))
60 | 
61 | 
62 | modify : IORef (Array (Maybe (List Variable))) -> (List Variable -> List Variable) -> Int -> IO ()
63 | modify ioRef func index =
64 |     IORef.modifyIORefMVector ioRef
65 |         (Array.update index (Maybe.map func))
66 | 


--------------------------------------------------------------------------------
/src/Node/Format.elm:
--------------------------------------------------------------------------------
 1 | module Node.Format exposing (run)
 2 | 
 3 | import Elm.Syntax.File
 4 | import ElmSyntaxParserLenient
 5 | import ElmSyntaxPrint
 6 | 
 7 | 
 8 | 
 9 | -- RUN
10 | 
11 | 
12 | run : String -> Result String String
13 | run inputText =
14 |     case ElmSyntaxParserLenient.run ElmSyntaxParserLenient.module_ inputText of
15 |         Just modu ->
16 |             Ok (render modu)
17 | 
18 |         Nothing ->
19 |             -- FIXME missings errs
20 |             Err "Something went wrong..."
21 | 
22 | 
23 | 
24 | -- RENDER
25 | 
26 | 
27 | render : Elm.Syntax.File.File -> String
28 | render modul =
29 |     ElmSyntaxPrint.module_ modul
30 |         |> ElmSyntaxPrint.toString
31 | 


--------------------------------------------------------------------------------
/src/Node/Main.elm:
--------------------------------------------------------------------------------
 1 | module Node.Main exposing (main)
 2 | 
 3 | import Json.Decode as Decode
 4 | import Json.Encode as Encode
 5 | import Node.Format as Format
 6 | import System.IO as IO exposing (IO)
 7 | import Utils.Impure as Impure
 8 | 
 9 | 
10 | main : IO.Program
11 | main =
12 |     IO.run app
13 | 
14 | 
15 | app : IO ()
16 | app =
17 |     getArgs
18 |         |> IO.bind
19 |             (\args ->
20 |                 case args of
21 |                     FormatArgs path ->
22 |                         case Format.run path of
23 |                             Ok output ->
24 |                                 exitWithResponse (Encode.object [ ( "output", Encode.string output ) ])
25 | 
26 |                             Err error ->
27 |                                 exitWithResponse (Encode.object [ ( "error", Encode.string error ) ])
28 |             )
29 | 
30 | 
31 | getArgs : IO Args
32 | getArgs =
33 |     Impure.task "getArgs" [] Impure.EmptyBody (Impure.DecoderResolver argsDecoder)
34 | 
35 | 
36 | exitWithResponse : Encode.Value -> IO a
37 | exitWithResponse value =
38 |     Impure.task "exitWithResponse" [] (Impure.JsonBody value) Impure.Crash
39 | 
40 | 
41 | 
42 | -- ARGS
43 | 
44 | 
45 | type Args
46 |     = FormatArgs String
47 | 
48 | 
49 | argsDecoder : Decode.Decoder Args
50 | argsDecoder =
51 |     Decode.field "command" Decode.string
52 |         |> Decode.andThen
53 |             (\command ->
54 |                 case command of
55 |                     "format" ->
56 |                         Decode.map FormatArgs
57 |                             (Decode.field "content" Decode.string)
58 | 
59 |                     _ ->
60 |                         Decode.fail ("Unknown command: " ++ command)
61 |             )
62 | 


--------------------------------------------------------------------------------
/src/Prelude.elm:
--------------------------------------------------------------------------------
 1 | module Prelude exposing
 2 |     ( head
 3 |     , init
 4 |     , last
 5 |     )
 6 | 
 7 | import List.Extra as List
 8 | import Utils.Crash exposing (crash)
 9 | 
10 | 
11 | head : List a -> a
12 | head items =
13 |     case List.head items of
14 |         Just item ->
15 |             item
16 | 
17 |         Nothing ->
18 |             crash "*** Exception: Prelude.head: empty list"
19 | 
20 | 
21 | init : List a -> List a
22 | init items =
23 |     case List.init items of
24 |         Just initItems ->
25 |             initItems
26 | 
27 |         Nothing ->
28 |             crash "*** Exception: Prelude.init: empty list"
29 | 
30 | 
31 | last : List a -> a
32 | last items =
33 |     case List.last items of
34 |         Just item ->
35 |             item
36 | 
37 |         Nothing ->
38 |             crash "*** Exception: Prelude.last: empty list"
39 | 


--------------------------------------------------------------------------------
/src/System/Console/Ansi.elm:
--------------------------------------------------------------------------------
 1 | module System.Console.Ansi exposing
 2 |     ( BlinkSpeed(..)
 3 |     , Color(..)
 4 |     , ColorIntensity(..)
 5 |     , ConsoleIntensity(..)
 6 |     , ConsoleLayer(..)
 7 |     , SGR(..)
 8 |     , Underlining(..)
 9 |     )
10 | 
11 | -- | ANSI colors: come in various intensities, which are controlled by 'ColorIntensity'
12 | 
13 | 
14 | type Color
15 |     = Black
16 |     | Red
17 |     | Green
18 |     | Yellow
19 |     | Blue
20 |     | Magenta
21 |     | Cyan
22 |     | White
23 | 
24 | 
25 | 
26 | -- | ANSI colors come in two intensities
27 | 
28 | 
29 | type ColorIntensity
30 |     = Dull
31 |     | Vivid
32 | 
33 | 
34 | 
35 | -- | ANSI colors can be set on two different layers
36 | 
37 | 
38 | type ConsoleLayer
39 |     = Foreground
40 |     | Background
41 | 
42 | 
43 | 
44 | -- | ANSI blink speeds: values other than 'NoBlink' are not widely supported
45 | 
46 | 
47 | type BlinkSpeed
48 |     = SlowBlink -- ^ Less than 150 blinks per minute
49 |     | RapidBlink -- ^ More than 150 blinks per minute
50 |     | NoBlink
51 | 
52 | 
53 | 
54 | -- | ANSI text underlining
55 | 
56 | 
57 | type Underlining
58 |     = SingleUnderline
59 |     | DoubleUnderline -- ^ Not widely supported
60 |     | NoUnderline
61 | 
62 | 
63 | 
64 | -- | ANSI general console intensity: usually treated as setting the font style (e.g. 'BoldIntensity' causes text to be bold)
65 | 
66 | 
67 | type ConsoleIntensity
68 |     = BoldIntensity
69 |     | FaintIntensity -- ^ Not widely supported: sometimes treated as concealing text
70 |     | NormalIntensity
71 | 
72 | 
73 | 
74 | -- | ANSI Select Graphic Rendition command
75 | 
76 | 
77 | type SGR
78 |     = Reset
79 |     | SetConsoleIntensity ConsoleIntensity
80 |     | SetItalicized Bool -- ^ Not widely supported: sometimes treated as swapping foreground and background
81 |     | SetUnderlining Underlining
82 |     | SetBlinkSpeed BlinkSpeed
83 |     | SetVisible Bool -- ^ Not widely supported
84 |     | SetSwapForegroundBackground Bool
85 |     | SetColor ConsoleLayer ColorIntensity Color
86 | 


--------------------------------------------------------------------------------
/src/System/Exit.elm:
--------------------------------------------------------------------------------
 1 | module System.Exit exposing
 2 |     ( ExitCode(..)
 3 |     , exitFailure
 4 |     , exitSuccess
 5 |     , exitWith
 6 |     )
 7 | 
 8 | import System.IO exposing (IO)
 9 | import Utils.Impure as Impure
10 | 
11 | 
12 | type ExitCode
13 |     = ExitSuccess
14 |     | ExitFailure Int
15 | 
16 | 
17 | exitWith : ExitCode -> IO a
18 | exitWith exitCode =
19 |     let
20 |         code : Int
21 |         code =
22 |             case exitCode of
23 |                 ExitSuccess ->
24 |                     0
25 | 
26 |                 ExitFailure int ->
27 |                     int
28 |     in
29 |     Impure.task "exitWith"
30 |         []
31 |         (Impure.StringBody (String.fromInt code))
32 |         Impure.Crash
33 | 
34 | 
35 | exitFailure : IO a
36 | exitFailure =
37 |     exitWith (ExitFailure 1)
38 | 
39 | 
40 | exitSuccess : IO a
41 | exitSuccess =
42 |     exitWith ExitSuccess
43 | 


--------------------------------------------------------------------------------
/src/System/Process.elm:
--------------------------------------------------------------------------------
  1 | module System.Process exposing
  2 |     ( CmdSpec
  3 |     , CreateProcess
  4 |     , ProcessHandle
  5 |     , StdStream(..)
  6 |     , proc
  7 |     , waitForProcess
  8 |     , withCreateProcess
  9 |     )
 10 | 
 11 | import Json.Decode as Decode
 12 | import Json.Encode as Encode
 13 | import System.Exit as Exit
 14 | import System.IO as IO exposing (IO)
 15 | import Utils.Impure as Impure
 16 | 
 17 | 
 18 | type CmdSpec
 19 |     = RawCommand String (List String)
 20 | 
 21 | 
 22 | type alias CreateProcess =
 23 |     { cmdspec : CmdSpec
 24 |     , std_in : StdStream
 25 |     , std_out : StdStream
 26 |     , std_err : StdStream
 27 |     }
 28 | 
 29 | 
 30 | type StdStream
 31 |     = Inherit
 32 |     | UseHandle IO.Handle
 33 |     | CreatePipe
 34 |     | NoStream
 35 | 
 36 | 
 37 | type ProcessHandle
 38 |     = ProcessHandle Int
 39 | 
 40 | 
 41 | proc : String -> List String -> CreateProcess
 42 | proc cmd args =
 43 |     { cmdspec = RawCommand cmd args
 44 |     , std_in = Inherit
 45 |     , std_out = Inherit
 46 |     , std_err = Inherit
 47 |     }
 48 | 
 49 | 
 50 | withCreateProcess : CreateProcess -> (Maybe IO.Handle -> Maybe IO.Handle -> Maybe IO.Handle -> ProcessHandle -> IO Exit.ExitCode) -> IO Exit.ExitCode
 51 | withCreateProcess createProcess f =
 52 |     Impure.task "withCreateProcess"
 53 |         []
 54 |         (Impure.JsonBody
 55 |             (Encode.object
 56 |                 [ ( "cmdspec"
 57 |                   , case createProcess.cmdspec of
 58 |                         RawCommand cmd args ->
 59 |                             Encode.object
 60 |                                 [ ( "type", Encode.string "RawCommand" )
 61 |                                 , ( "cmd", Encode.string cmd )
 62 |                                 , ( "args", Encode.list Encode.string args )
 63 |                                 ]
 64 |                   )
 65 |                 , ( "stdin"
 66 |                   , case createProcess.std_in of
 67 |                         Inherit ->
 68 |                             Encode.string "inherit"
 69 | 
 70 |                         UseHandle (IO.Handle handle) ->
 71 |                             Encode.int handle
 72 | 
 73 |                         CreatePipe ->
 74 |                             Encode.string "pipe"
 75 | 
 76 |                         NoStream ->
 77 |                             Encode.string "ignore"
 78 |                   )
 79 |                 , ( "stdout"
 80 |                   , case createProcess.std_out of
 81 |                         Inherit ->
 82 |                             Encode.string "inherit"
 83 | 
 84 |                         UseHandle (IO.Handle handle) ->
 85 |                             Encode.int handle
 86 | 
 87 |                         CreatePipe ->
 88 |                             Encode.string "pipe"
 89 | 
 90 |                         NoStream ->
 91 |                             Encode.string "ignore"
 92 |                   )
 93 |                 , ( "stderr"
 94 |                   , case createProcess.std_err of
 95 |                         Inherit ->
 96 |                             Encode.string "inherit"
 97 | 
 98 |                         UseHandle (IO.Handle handle) ->
 99 |                             Encode.int handle
100 | 
101 |                         CreatePipe ->
102 |                             Encode.string "pipe"
103 | 
104 |                         NoStream ->
105 |                             Encode.string "ignore"
106 |                   )
107 |                 ]
108 |             )
109 |         )
110 |         (Impure.DecoderResolver
111 |             (Decode.map2 Tuple.pair
112 |                 (Decode.field "stdinHandle" (Decode.maybe Decode.int))
113 |                 (Decode.field "ph" Decode.int)
114 |             )
115 |         )
116 |         |> IO.bind
117 |             (\( stdinHandle, ph ) ->
118 |                 f (Maybe.map IO.Handle stdinHandle) Nothing Nothing (ProcessHandle ph)
119 |             )
120 | 
121 | 
122 | waitForProcess : ProcessHandle -> IO Exit.ExitCode
123 | waitForProcess (ProcessHandle ph) =
124 |     Impure.task "waitForProcess"
125 |         []
126 |         (Impure.StringBody (String.fromInt ph))
127 |         (Impure.DecoderResolver
128 |             (Decode.map
129 |                 (\int ->
130 |                     if int == 0 then
131 |                         Exit.ExitSuccess
132 | 
133 |                     else
134 |                         Exit.ExitFailure int
135 |                 )
136 |                 Decode.int
137 |             )
138 |         )
139 | 


--------------------------------------------------------------------------------
/src/Terminal/Terminal/Internal.elm:
--------------------------------------------------------------------------------
  1 | module Terminal.Terminal.Internal exposing
  2 |     ( ArgError(..)
  3 |     , Args(..)
  4 |     , Command(..)
  5 |     , CompleteArgs(..)
  6 |     , Error(..)
  7 |     , Expectation(..)
  8 |     , Flag(..)
  9 |     , FlagError(..)
 10 |     , Flags(..)
 11 |     , Parser(..)
 12 |     , RequiredArgs(..)
 13 |     , Summary(..)
 14 |     , toName
 15 |     )
 16 | 
 17 | import System.IO exposing (IO)
 18 | import Text.PrettyPrint.ANSI.Leijen exposing (Doc)
 19 | 
 20 | 
 21 | 
 22 | -- COMMAND
 23 | 
 24 | 
 25 | type Command
 26 |     = Command String Summary String Doc Args Flags (List String -> Result Error (IO ()))
 27 | 
 28 | 
 29 | toName : Command -> String
 30 | toName (Command name _ _ _ _ _ _) =
 31 |     name
 32 | 
 33 | 
 34 | {-| The information that shows when you run the executable with no arguments.
 35 | If you say it is `Common`, you need to tell people what it does. Try to keep
 36 | it to two or three lines. If you say it is `Uncommon` you can rely on `Details`
 37 | for a more complete explanation.
 38 | -}
 39 | type Summary
 40 |     = Common String
 41 |     | Uncommon
 42 | 
 43 | 
 44 | 
 45 | -- FLAGS
 46 | 
 47 | 
 48 | type Flags
 49 |     = FDone
 50 |     | FMore Flags Flag
 51 | 
 52 | 
 53 | type Flag
 54 |     = Flag String Parser String
 55 |     | OnOff String String
 56 | 
 57 | 
 58 | 
 59 | -- PARSERS
 60 | 
 61 | 
 62 | type Parser
 63 |     = Parser
 64 |         { singular : String
 65 |         , plural : String
 66 | 
 67 |         -- ,parser : String -> Maybe a
 68 |         , suggest : String -> IO (List String)
 69 |         , examples : String -> IO (List String)
 70 |         }
 71 | 
 72 | 
 73 | 
 74 | -- ARGS
 75 | 
 76 | 
 77 | type Args
 78 |     = Args (List CompleteArgs)
 79 | 
 80 | 
 81 | type CompleteArgs
 82 |     = Exactly RequiredArgs
 83 |     | Multiple RequiredArgs Parser
 84 | 
 85 | 
 86 | type RequiredArgs
 87 |     = Done
 88 |     | Required RequiredArgs Parser
 89 | 
 90 | 
 91 | 
 92 | -- ERROR
 93 | 
 94 | 
 95 | type Error
 96 |     = BadArgs (List ArgError)
 97 |     | BadFlag FlagError
 98 | 
 99 | 
100 | type ArgError
101 |     = ArgMissing Expectation
102 |     | ArgBad String Expectation
103 |     | ArgExtras (List String)
104 | 
105 | 
106 | type FlagError
107 |     = FlagWithValue String String
108 |     | FlagWithBadValue String String Expectation
109 |     | FlagWithNoValue String Expectation
110 |     | FlagUnknown String Flags
111 | 
112 | 
113 | type Expectation
114 |     = Expectation String (IO (List String))
115 | 


--------------------------------------------------------------------------------
/src/Utils/Bytes/Encode.elm:
--------------------------------------------------------------------------------
  1 | module Utils.Bytes.Encode exposing
  2 |     ( Encoder
  3 |     , assocListDict
  4 |     , bool
  5 |     , encode
  6 |     , everySet
  7 |     , float
  8 |     , int
  9 |     , jsonPair
 10 |     , list
 11 |     , maybe
 12 |     , nonempty
 13 |     , oneOrMore
 14 |     , result
 15 |     , sequence
 16 |     , string
 17 |     , unit
 18 |     , unsignedInt8
 19 |     )
 20 | 
 21 | import Bytes
 22 | import Bytes.Encode as BE
 23 | import Compiler.Data.NonEmptyList as NE
 24 | import Compiler.Data.OneOrMore exposing (OneOrMore(..))
 25 | import Data.Map as Dict exposing (Dict)
 26 | import Data.Set as EverySet exposing (EverySet)
 27 | 
 28 | 
 29 | endian : Bytes.Endianness
 30 | endian =
 31 |     Bytes.BE
 32 | 
 33 | 
 34 | type alias Encoder =
 35 |     BE.Encoder
 36 | 
 37 | 
 38 | unsignedInt8 : Int -> Encoder
 39 | unsignedInt8 =
 40 |     BE.unsignedInt8
 41 | 
 42 | 
 43 | sequence : List Encoder -> Encoder
 44 | sequence =
 45 |     BE.sequence
 46 | 
 47 | 
 48 | encode : Encoder -> Bytes.Bytes
 49 | encode =
 50 |     BE.encode
 51 | 
 52 | 
 53 | unit : () -> Encoder
 54 | unit () =
 55 |     BE.unsignedInt8 0
 56 | 
 57 | 
 58 | int : Int -> Encoder
 59 | int =
 60 |     toFloat >> BE.float64 endian
 61 | 
 62 | 
 63 | float : Float -> Encoder
 64 | float =
 65 |     BE.float64 endian
 66 | 
 67 | 
 68 | string : String -> Encoder
 69 | string str =
 70 |     sequence
 71 |         [ BE.unsignedInt32 endian (BE.getStringWidth str)
 72 |         , BE.string str
 73 |         ]
 74 | 
 75 | 
 76 | bool : Bool -> Encoder
 77 | bool value =
 78 |     BE.unsignedInt8
 79 |         (if value then
 80 |             1
 81 | 
 82 |          else
 83 |             0
 84 |         )
 85 | 
 86 | 
 87 | list : (a -> Encoder) -> List a -> Encoder
 88 | list encoder aList =
 89 |     BE.sequence
 90 |         (BE.unsignedInt32 endian (List.length aList)
 91 |             :: List.map encoder aList
 92 |         )
 93 | 
 94 | 
 95 | maybe : (a -> Encoder) -> Maybe a -> Encoder
 96 | maybe encoder maybeValue =
 97 |     case maybeValue of
 98 |         Just value ->
 99 |             BE.sequence
100 |                 [ BE.unsignedInt8 1
101 |                 , encoder value
102 |                 ]
103 | 
104 |         Nothing ->
105 |             BE.unsignedInt8 0
106 | 
107 | 
108 | nonempty : (a -> Encoder) -> NE.Nonempty a -> Encoder
109 | nonempty encoder (NE.Nonempty x xs) =
110 |     list encoder (x :: xs)
111 | 
112 | 
113 | result : (x -> Encoder) -> (a -> Encoder) -> Result x a -> Encoder
114 | result errEncoder successEncoder resultValue =
115 |     case resultValue of
116 |         Ok value ->
117 |             sequence
118 |                 [ BE.unsignedInt8 0
119 |                 , successEncoder value
120 |                 ]
121 | 
122 |         Err err ->
123 |             sequence
124 |                 [ BE.unsignedInt8 1
125 |                 , errEncoder err
126 |                 ]
127 | 
128 | 
129 | assocListDict : (k -> k -> Order) -> (k -> Encoder) -> (v -> Encoder) -> Dict c k v -> Encoder
130 | assocListDict keyComparison keyEncoder valueEncoder =
131 |     list (jsonPair keyEncoder valueEncoder) << List.reverse << Dict.toList keyComparison
132 | 
133 | 
134 | jsonPair : (a -> Encoder) -> (b -> Encoder) -> ( a, b ) -> Encoder
135 | jsonPair encoderA encoderB ( a, b ) =
136 |     BE.sequence
137 |         [ encoderA a
138 |         , encoderB b
139 |         ]
140 | 
141 | 
142 | everySet : (a -> a -> Order) -> (a -> Encoder) -> EverySet c a -> Encoder
143 | everySet keyComparison encoder =
144 |     list encoder << List.reverse << EverySet.toList keyComparison
145 | 
146 | 
147 | oneOrMore : (a -> Encoder) -> OneOrMore a -> Encoder
148 | oneOrMore encoder oneOrMore_ =
149 |     case oneOrMore_ of
150 |         One value ->
151 |             BE.sequence
152 |                 [ BE.unsignedInt8 0
153 |                 , encoder value
154 |                 ]
155 | 
156 |         More left right ->
157 |             BE.sequence
158 |                 [ BE.unsignedInt8 1
159 |                 , oneOrMore encoder left
160 |                 , oneOrMore encoder right
161 |                 ]
162 | 


--------------------------------------------------------------------------------
/src/Utils/Crash.elm:
--------------------------------------------------------------------------------
1 | module Utils.Crash exposing (crash)
2 | 
3 | 
4 | crash : String -> a
5 | crash str =
6 |     crash str
7 | 


--------------------------------------------------------------------------------
/tests/Parse/PrimitivesTests.elm:
--------------------------------------------------------------------------------
 1 | module Parse.PrimitivesTests exposing (suite)
 2 | 
 3 | import Compiler.Parse.Primitives as P
 4 | import Expect
 5 | import Test exposing (Test)
 6 | 
 7 | 
 8 | suite : Test
 9 | suite =
10 |     Test.describe "Parse.Primitives"
11 |         [ Test.describe "getCharWidth"
12 |             [ Test.test "Latin Small Letter A" <|
13 |                 \_ ->
14 |                     P.getCharWidth 'a'
15 |                         |> Expect.equal 1
16 |             , Test.test "Latin Capital Letter Z" <|
17 |                 \_ ->
18 |                     P.getCharWidth 'Z'
19 |                         |> Expect.equal 1
20 |             , Test.test "Horizontal Ellipsis" <|
21 |                 \_ ->
22 |                     P.getCharWidth '…'
23 |                         |> Expect.equal 1
24 |             , Test.test "Black Right-Pointing Small Triangle" <|
25 |                 \_ ->
26 |                     P.getCharWidth '▸'
27 |                         |> Expect.equal 1
28 |             , Test.test "Black Down-Pointing Small Triangle" <|
29 |                 \_ ->
30 |                     P.getCharWidth '▾'
31 |                         |> Expect.equal 1
32 |             , Test.test "Black Down-Pointing Triangle" <|
33 |                 \_ ->
34 |                     P.getCharWidth '▼'
35 |                         |> Expect.equal 1
36 |             , Test.test "Heavy Black Heart" <|
37 |                 \_ ->
38 |                     P.getCharWidth '❤'
39 |                         |> Expect.equal 1
40 |             , Test.test "Full Block" <|
41 |                 \_ ->
42 |                     P.getCharWidth '█'
43 |                         |> Expect.equal 1
44 |             , Test.test "Light Shade" <|
45 |                 \_ ->
46 |                     P.getCharWidth '░'
47 |                         |> Expect.equal 1
48 |             , Test.test "Ballot X" <|
49 |                 \_ ->
50 |                     P.getCharWidth '✗'
51 |                         |> Expect.equal 1
52 |             , Test.test "Check Mark" <|
53 |                 \_ ->
54 |                     P.getCharWidth '✓'
55 |                         |> Expect.equal 1
56 |             , Test.test "Em Dash" <|
57 |                 \_ ->
58 |                     P.getCharWidth '—'
59 |                         |> Expect.equal 1
60 |             , Test.test "Rainbow" <|
61 |                 \_ ->
62 |                     P.getCharWidth '🌈'
63 |                         |> Expect.equal 2
64 |             , Test.test "Fire" <|
65 |                 \_ ->
66 |                     P.getCharWidth '🔥'
67 |                         |> Expect.equal 2
68 |             ]
69 |         ]
70 | 


--------------------------------------------------------------------------------
/tests/Parse/StringTests.elm:
--------------------------------------------------------------------------------
 1 | module Parse.StringTests exposing (suite)
 2 | 
 3 | import Compiler.Parse.Primitives as P
 4 | import Compiler.Parse.String as S
 5 | import Expect
 6 | import Test exposing (Test)
 7 | 
 8 | 
 9 | suite : Test
10 | suite =
11 |     Test.describe "Parse.String"
12 |         [ Test.describe "singleString"
13 |             [ Test.test "🙈" <|
14 |                 \_ ->
15 |                     singleString "\"\\u{1F648}\""
16 |                         |> Expect.equal (Ok "\\uD83D\\uDE48")
17 |             , Test.test "\\u{0001}" <|
18 |                 \_ ->
19 |                     singleString "\"\\u{0001}\""
20 |                         |> Expect.equal (Ok "\\u0001")
21 |             , Test.test "\\u{FFFF}" <|
22 |                 \_ ->
23 |                     singleString "\"\\u{FFFF}\""
24 |                         |> Expect.equal (Ok "\\uD7FF\\uDFFF")
25 |             , Test.test "\\u{10000}" <|
26 |                 \_ ->
27 |                     singleString "\"\\u{10000}\""
28 |                         |> Expect.equal (Ok "\\uD800\\uDC00")
29 |             ]
30 |         ]
31 | 
32 | 
33 | singleString : String -> Result () String
34 | singleString =
35 |     P.fromByteString (S.string (\_ _ -> ()) (\_ _ _ -> ())) (\_ _ -> ())
36 | 


--------------------------------------------------------------------------------
/tests/repl.test.js:
--------------------------------------------------------------------------------
 1 | const child_process = require("node:child_process");
 2 | const path = require("node:path");
 3 | 
 4 | describe("repl", () => {
 5 |     test("1 + 1", (done) => {
 6 |         run("1 + 1", "\x1B[95m2\x1B[0m\x1B[90m : number\x1B[0m\n", done);
 7 |     }, 120_000);
 8 | 
 9 |     test("string", (done) => {
10 |         run("\"Hello, World!\"", "\x1B[93m\"Hello, World!\"\x1B[0m\x1B[90m : String\x1B[0m\n", done);
11 |     }, 120_000);
12 | });
13 | 
14 | const run = (input, output, done) => {
15 |     const repl = child_process.spawn("./bin/index.js", ["repl"], {
16 |         cwd: path.join(__dirname, ".."),
17 |         stdio: "pipe"
18 |     });
19 | 
20 |     repl.stdout.on("data", (data) => {
21 |         if (data.toString() === "> ") {
22 |             repl.stdin.write(input + "\n");
23 |         } else if (data.toString() === output) {
24 |             repl.kill();
25 |             done();
26 |         }
27 |     });
28 | }


--------------------------------------------------------------------------------
/tests/tuples.test.js:
--------------------------------------------------------------------------------
 1 | const path = require("path");
 2 | const childProcess = require("child_process");
 3 | 
 4 | describe("tuples", () => {
 5 |     test("allows 3+ tuples", () => {
 6 |         expect(() => {
 7 |             childProcess.execSync(
 8 |                 `../../bin/index.js make src/GuidaTupleN.guida`,
 9 |                 { cwd: path.join(__dirname, "..", "assets", "some-application") }
10 |             );
11 |         }).not.toThrow();
12 |     });
13 | });


--------------------------------------------------------------------------------
/try/README.md:
--------------------------------------------------------------------------------
 1 | # Guida Try
 2 | 
 3 | This is an example of how to use the browser version of the compiler.
 4 | 
 5 | ## How to run
 6 | 
 7 | To run this example, follow these steps:
 8 | 
 9 | 1. Start by building guida for the browser at the top level folder by running the following:
10 | 
11 | ```
12 | nvm use
13 | npm install
14 | npm run build:browser
15 | ```
16 | 
17 | 2. Move into this folder and install the dependecies:
18 | 
19 | ```
20 | cd try
21 | npm install
22 | ```
23 | 
24 | 3. Start the server with `npm run server`
25 | 4. Open http://127.0.0.1:8088


--------------------------------------------------------------------------------
/try/app.js:
--------------------------------------------------------------------------------
 1 | const guida = require("guida");
 2 | 
 3 | window.addEventListener("load", async () => {
 4 |     const app = await guida.init({ GUIDA_REGISTRY: "/proxy/https://package.elm-lang.org" });
 5 | 
 6 |     const code = document.getElementById("code");
 7 | 
 8 |     const mode = document.getElementById("mode");
 9 |     const sourcemaps = document.getElementById("sourcemaps-input");
10 |     const format = document.getElementById("format");
11 |     const run = document.getElementById("run");
12 | 
13 |     const dependency = document.getElementById("dependency");
14 |     const install = document.getElementById("install");
15 |     const uninstall = document.getElementById("uninstall");
16 | 
17 |     const preview = document.getElementById("preview");
18 | 
19 |     format.addEventListener("click", async () => {
20 |         const result = await app.format(code.value);
21 | 
22 |         if (Object.prototype.hasOwnProperty.call(result, "error")) {
23 |             console.error(JSON.parse(result.error));
24 |         } else {
25 |             code.value = result.output;
26 |         }
27 |     });
28 | 
29 |     run.addEventListener("click", async () => {
30 |         const result = await app.make(code.value, {
31 |             debug: mode.value === "debug",
32 |             optimize: mode.value === "prod",
33 |             sourcemaps: sourcemaps.checked
34 |         });
35 | 
36 |         if (Object.prototype.hasOwnProperty.call(result, "error")) {
37 |             console.error(result.error);
38 |         } else {
39 |             preview.srcdoc = result.output;
40 |         }
41 |     });
42 | 
43 |     install.addEventListener("click", async () => {
44 |         const result = await app.install(dependency.value);
45 | 
46 |         if (result && Object.prototype.hasOwnProperty.call(result, "error")) {
47 |             console.error(result.error);
48 |         }
49 |     });
50 | 
51 |     uninstall.addEventListener("click", async () => {
52 |         const result = await app.uninstall(dependency.value);
53 | 
54 |         if (result && Object.prototype.hasOwnProperty.call(result, "error")) {
55 |             console.error(result.error);
56 |         }
57 |     });
58 | });


--------------------------------------------------------------------------------
/try/package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "guida-try",
 3 |   "version": "1.0.0",
 4 |   "main": "index.js",
 5 |   "scripts": {
 6 |     "preserver": "esbuild app.js --bundle --platform=browser --outfile=public/app.js",
 7 |     "server": "./server.js"
 8 |   },
 9 |   "dependencies": {
10 |     "cors": "^2.8.5",
11 |     "esbuild": "^0.25.1",
12 |     "express": "^4.21.2",
13 |     "guida": "file:..",
14 |     "http-proxy-middleware": "^3.0.3"
15 |   }
16 | }


--------------------------------------------------------------------------------
/try/public/app.css:
--------------------------------------------------------------------------------
 1 | body {
 2 |     display: grid;
 3 |     grid-template:
 4 |         "code code code code preview" 1fr
 5 |         "mode sourcemaps format run preview" min-content
 6 |         "dependency dependency install uninstall preview" min-content
 7 |         / 1fr 2fr 1fr 1fr 5fr;
 8 |     align-items: stretch;
 9 |     justify-items: stretch;
10 |     height: 100vh;
11 |     margin: 0;
12 | }
13 | 
14 | #code {
15 |     grid-area: code;
16 |     padding: 10px;
17 |     overflow-y: auto;
18 |     resize: none;
19 | }
20 | 
21 | #mode {
22 |     grid-area: mode;
23 | }
24 | 
25 | #sourcemaps {
26 |     grid-area: sourcemaps;
27 | }
28 | 
29 | #format {
30 |     grid-area: format;
31 | }
32 | 
33 | #run {
34 |     grid-area: run;
35 | }
36 | 
37 | #dependency {
38 |     grid-area: dependency;
39 | }
40 | 
41 | #install {
42 |     grid-area: install;
43 | }
44 | 
45 | #uninstall {
46 |     grid-area: uninstall;
47 | }
48 | 
49 | #preview {
50 |     grid-area: preview;
51 |     overflow-y: auto;
52 | }


--------------------------------------------------------------------------------
/try/public/index.html:
--------------------------------------------------------------------------------
  1 | 
  2 | 
  3 | 
  4 | 
  5 |   
  6 |   Try Guida!
  7 |   
  8 |   
  9 |   
 10 | 
 11 | 
 12 | 
 13 |   
 82 |   
 87 |   
 91 |   
 92 |   
 93 | 
 94 |   
 95 |   
 96 |   
 97 | 
 98 |   
 99 | 
100 | 
101 | 


--------------------------------------------------------------------------------
/try/server.js:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env node
 2 | 
 3 | const express = require("express");
 4 | const cors = require("cors");
 5 | const { createProxyMiddleware } = require("http-proxy-middleware");
 6 | const path = require("path");
 7 | 
 8 | const app = express();
 9 | 
10 | app.use("/proxy/", cors());
11 | app.use("/proxy/", createProxyMiddleware({
12 |     router: (req) => new URL(req.url.substring(1)),
13 |     pathRewrite: (_path, req) => (new URL(req.url.substring(1))).pathname,
14 |     changeOrigin: true,
15 |     followRedirects: true,
16 |     logger: console
17 | }))
18 | 
19 | app.use(express.static(path.join(__dirname, "public")));
20 | 
21 | app.listen(8088, () => {
22 |     console.info("proxy server is running on http://127.0.0.1:8088");
23 | });


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