├── .github ├── FUNDING.yml └── workflows │ └── test.yml ├── .gitignore ├── CONTRIBUTORS ├── LICENSE ├── README.md ├── devbox.json ├── devbox.lock ├── gren.json ├── integration-tests ├── .gitignore ├── http-client │ ├── .gitignore │ ├── Makefile │ ├── bin │ │ └── .gitkeep │ ├── gren.json │ ├── package-lock.json │ ├── package.json │ ├── src │ │ └── Main.gren │ └── test │ │ └── requests.mjs ├── http-server │ ├── .gitignore │ ├── Makefile │ ├── README.md │ ├── gren.json │ ├── package-lock.json │ ├── package.json │ ├── public │ │ └── george.jpeg │ ├── src │ │ └── Main.gren │ └── test │ │ ├── fixtures.mjs │ │ └── requests.mjs ├── signals │ ├── .gitignore │ ├── Makefile │ ├── bin │ │ └── .gitkeep │ ├── gren.json │ ├── package-lock.json │ ├── package.json │ ├── src │ │ └── Main.gren │ └── test │ │ └── requests.mjs └── test.sh ├── src ├── ChildProcess.gren ├── FileSystem.gren ├── FileSystem │ ├── FileHandle.gren │ └── Path.gren ├── Gren │ └── Kernel │ │ ├── ChildProcess.js │ │ ├── FilePath.js │ │ ├── FileSystem.js │ │ ├── HttpClient.js │ │ ├── HttpServer.js │ │ ├── Node.js │ │ └── Terminal.js ├── HttpClient.gren ├── HttpServer.gren ├── HttpServer │ └── Response.gren ├── Init.gren ├── Internal │ └── Init.gren ├── Node.gren └── Terminal.gren └── tests ├── gren.json ├── run-tests.sh └── src ├── Main.gren └── Test └── FileSystemPath.gren /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | ko_fi: gren 2 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | 3 | on: 4 | pull_request: 5 | branches: [main] 6 | push: 7 | branches: [main] 8 | 9 | jobs: 10 | run-tests: 11 | strategy: 12 | matrix: 13 | os: [ubuntu-latest, macos-latest] 14 | 15 | runs-on: ${{ matrix.os }} 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - name: Install devbox 21 | uses: jetify-com/devbox-install-action@v0.12.0 22 | with: 23 | enable-cache: true 24 | 25 | - name: Verify formatting 26 | run: devbox run format:check 27 | 28 | - name: Run tests 29 | run: devbox run test 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .envrc 2 | .gren 3 | .DS_Store 4 | artifacts.dat 5 | docs.json 6 | tests/app 7 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Robin Heggelund Hansen (robinheghan) 2 | Justin Blake (blaix) -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Original work Copyright 2014-2022 Evan Czaplicki 2 | Modified work Copyright 2022-present The Gren CONTRIBUTORS 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 | # Gren on NodeJS 2 | 3 | This package allows you to create Gren programs that run on the NodeJS runtime. 4 | 5 | **I highly recommend working through the [guide](https://gren-lang.org/book/) to learn how to use Gren.** 6 | 7 | ## Creating a node application 8 | 9 | In addition to [installing gren](https://gren-lang.org/install), you'll need the current [node LTS](https://nodejs.org/en) release. 10 | 11 | Initialize a gren application that targets node: 12 | 13 | ``` 14 | gren init --platform=node 15 | ``` 16 | 17 | Create a `src/Main.gren` file: 18 | 19 | ```elm 20 | module Main exposing (main) 21 | 22 | import Node 23 | import Stream 24 | import Task 25 | 26 | main = 27 | Node.defineSimpleProgram 28 | (\env -> 29 | Stream.sendLine env.stdout "Hello, World!" 30 | |> Task.execute 31 | |> Node.endWithCmd 32 | ) 33 | ``` 34 | 35 | compile and run with 36 | 37 | ``` 38 | gren make src/Main.gren 39 | node app 40 | ``` 41 | 42 | See the [cat example](https://github.com/gren-lang/example-projects/tree/main/cat) for a more complex example. 43 | 44 | ## Applications, sub-systems and permissions 45 | 46 | This package is based around the idea of sub-systems. A sub-system provides access to functionality which interact with the outside world, like reading files or communicating with the terminal. 47 | 48 | A sub-system must be initialized before the application is running. The result of initializing a sub-system is a permission value which needs to be passed in to the functions that the sub-system provides. 49 | 50 | In other words, an application has to state up-front what permissions it requires. 51 | 52 | Below is an example of initializing the `Terminal` and `FileSystem` sub-systems: 53 | 54 | ```gren 55 | init 56 | : Environment 57 | -> Init.Task 58 | { model : Model 59 | , command : Cmd Msg 60 | } 61 | init _env = 62 | Init.await Terminal.initialize <| \termConfig -> 63 | Init.await FileSystem.initialize <| \fsPermission -> 64 | Node.startProgram 65 | { model = 66 | { terminalConnection = Maybe.map .permission termConfig 67 | , fsPermission = fsPermission 68 | } 69 | , command = 70 | Cmd.none 71 | } 72 | ``` 73 | 74 | Once the permission value for each sub-system is stored in the model, your application can then interact with the terminal and file system. 75 | 76 | Keep in mind that passing permissions to third-party code enables them to access these systems. Only give permissions to code you trust! 77 | -------------------------------------------------------------------------------- /devbox.json: -------------------------------------------------------------------------------- 1 | { 2 | "$schema": "https://raw.githubusercontent.com/jetify-com/devbox/0.13.5/.schema/devbox.schema.json", 3 | "packages": [ 4 | "nodejs@20", 5 | "github:gren-lang/nix/0.5.4", 6 | "nodePackages.prettier@latest" 7 | ], 8 | "shell": { 9 | "init_hook": ["echo 'Welcome to devbox!' > /dev/null"], 10 | "scripts": { 11 | "format": "prettier -w \"!**/*.json\" .", 12 | "format:check": "prettier -c \"!**/*.json\" .", 13 | "test": [ 14 | "cd tests/", 15 | "./run-tests.sh", 16 | "cd ../integration-tests", 17 | "./run-tests.sh" 18 | ], 19 | "test:unit": [ 20 | "cd tests/", 21 | "./run-tests.sh" 22 | ], 23 | "test:integration": [ 24 | "cd integration-tests/", 25 | "./run-tests.sh" 26 | ] 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /devbox.lock: -------------------------------------------------------------------------------- 1 | { 2 | "lockfile_version": "1", 3 | "packages": { 4 | "github:NixOS/nixpkgs/nixpkgs-unstable": { 5 | "last_modified": "2025-06-02T09:36:13Z", 6 | "resolved": "github:NixOS/nixpkgs/e4b09e47ace7d87de083786b404bf232eb6c89d8?lastModified=1748856973&narHash=sha256-RlTsJUvvr8ErjPBsiwrGbbHYW8XbB%2Foek0Gi78XdWKg%3D" 7 | }, 8 | "github:gren-lang/nix/0.5.4": { 9 | "last_modified": "2025-03-24T10:35:41Z", 10 | "resolved": "github:gren-lang/nix/35601dd5c34adce2bbc6740ccc19a55078eb27be?lastModified=1742812541&narHash=sha256-iJcZAefSQM67bMRlJPEXT0%2FkVUoEmcr9NYTUPLoAO%2FE%3D" 11 | }, 12 | "nodePackages.prettier@latest": { 13 | "last_modified": "2025-05-21T18:43:04Z", 14 | "resolved": "github:NixOS/nixpkgs/8c441601c43232976179eac52dde704c8bdf81ed#nodePackages.prettier", 15 | "source": "devbox-search", 16 | "version": "3.5.3", 17 | "systems": { 18 | "aarch64-darwin": { 19 | "outputs": [ 20 | { 21 | "name": "out", 22 | "path": "/nix/store/yspchsd3ww1ddz2r5783kw8y9j0vr3r8-prettier-3.5.3", 23 | "default": true 24 | } 25 | ], 26 | "store_path": "/nix/store/yspchsd3ww1ddz2r5783kw8y9j0vr3r8-prettier-3.5.3" 27 | }, 28 | "aarch64-linux": { 29 | "outputs": [ 30 | { 31 | "name": "out", 32 | "path": "/nix/store/ya3imag4wkxj3g5fws96rzyzv36m74w8-prettier-3.5.3", 33 | "default": true 34 | } 35 | ], 36 | "store_path": "/nix/store/ya3imag4wkxj3g5fws96rzyzv36m74w8-prettier-3.5.3" 37 | }, 38 | "x86_64-darwin": { 39 | "outputs": [ 40 | { 41 | "name": "out", 42 | "path": "/nix/store/f9q2y20qa56hjzxnia0q664m0rkwwqvm-prettier-3.5.3", 43 | "default": true 44 | } 45 | ], 46 | "store_path": "/nix/store/f9q2y20qa56hjzxnia0q664m0rkwwqvm-prettier-3.5.3" 47 | }, 48 | "x86_64-linux": { 49 | "outputs": [ 50 | { 51 | "name": "out", 52 | "path": "/nix/store/wry9vlk19pk7izrknb980icc8gihzllx-prettier-3.5.3", 53 | "default": true 54 | } 55 | ], 56 | "store_path": "/nix/store/wry9vlk19pk7izrknb980icc8gihzllx-prettier-3.5.3" 57 | } 58 | } 59 | }, 60 | "nodejs@20": { 61 | "last_modified": "2025-05-28T04:23:31Z", 62 | "plugin_version": "0.0.2", 63 | "resolved": "github:NixOS/nixpkgs/3d1f29646e4b57ed468d60f9d286cde23a8d1707#nodejs_20", 64 | "source": "devbox-search", 65 | "version": "20.19.2", 66 | "systems": { 67 | "aarch64-darwin": { 68 | "outputs": [ 69 | { 70 | "name": "out", 71 | "path": "/nix/store/94chw39vss6h3pbjhh8bygiz0q477gzd-nodejs-20.19.2", 72 | "default": true 73 | }, 74 | { 75 | "name": "dev", 76 | "path": "/nix/store/swzicw8mfidrka038zrmrx4lckk9k6zf-nodejs-20.19.2-dev" 77 | }, 78 | { 79 | "name": "libv8", 80 | "path": "/nix/store/5m1fsrkl8xbz34ys87ggcsns8grdp30g-nodejs-20.19.2-libv8" 81 | } 82 | ], 83 | "store_path": "/nix/store/94chw39vss6h3pbjhh8bygiz0q477gzd-nodejs-20.19.2" 84 | }, 85 | "aarch64-linux": { 86 | "outputs": [ 87 | { 88 | "name": "out", 89 | "path": "/nix/store/gxw447rjm20g8jrzm2ccsqynx4bq2n1l-nodejs-20.19.2", 90 | "default": true 91 | }, 92 | { 93 | "name": "dev", 94 | "path": "/nix/store/p05pi2gbvjvsr19si0fx17q1za84g9vg-nodejs-20.19.2-dev" 95 | }, 96 | { 97 | "name": "libv8", 98 | "path": "/nix/store/j5rq19i98ssznln4cgfjg30kbmharzby-nodejs-20.19.2-libv8" 99 | } 100 | ], 101 | "store_path": "/nix/store/gxw447rjm20g8jrzm2ccsqynx4bq2n1l-nodejs-20.19.2" 102 | }, 103 | "x86_64-darwin": { 104 | "outputs": [ 105 | { 106 | "name": "out", 107 | "path": "/nix/store/bw8rnmhwkvipgcxjja0wi5mrjk0gvvkb-nodejs-20.19.2", 108 | "default": true 109 | }, 110 | { 111 | "name": "libv8", 112 | "path": "/nix/store/kbwqyp27ljdc45lc2fv3j8vdd4m6l8py-nodejs-20.19.2-libv8" 113 | }, 114 | { 115 | "name": "dev", 116 | "path": "/nix/store/j5pww5w57s076b2mm5k4jm8grf2dviqa-nodejs-20.19.2-dev" 117 | } 118 | ], 119 | "store_path": "/nix/store/bw8rnmhwkvipgcxjja0wi5mrjk0gvvkb-nodejs-20.19.2" 120 | }, 121 | "x86_64-linux": { 122 | "outputs": [ 123 | { 124 | "name": "out", 125 | "path": "/nix/store/4qx33yfkway214mhlgq3ph4gnfdp32ah-nodejs-20.19.2", 126 | "default": true 127 | }, 128 | { 129 | "name": "libv8", 130 | "path": "/nix/store/cikzmcbxfz97ym2jf76j843sh3z0x6r2-nodejs-20.19.2-libv8" 131 | }, 132 | { 133 | "name": "dev", 134 | "path": "/nix/store/y85h8q99g1w8jdwiiz3i2zqmnl23rqhv-nodejs-20.19.2-dev" 135 | } 136 | ], 137 | "store_path": "/nix/store/4qx33yfkway214mhlgq3ph4gnfdp32ah-nodejs-20.19.2" 138 | } 139 | } 140 | } 141 | } 142 | } 143 | -------------------------------------------------------------------------------- /gren.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "platform": "node", 4 | "name": "gren-lang/node", 5 | "summary": "Run Gren on NodeJS", 6 | "license": "BSD-3-Clause", 7 | "version": "5.0.4", 8 | "exposed-modules": [ 9 | "Node", 10 | "Init", 11 | "Terminal", 12 | "ChildProcess", 13 | "FileSystem", 14 | "FileSystem.FileHandle", 15 | "FileSystem.Path", 16 | "HttpClient", 17 | "HttpServer", 18 | "HttpServer.Response" 19 | ], 20 | "gren-version": "0.5.0 <= v < 0.6.0", 21 | "dependencies": { 22 | "gren-lang/core": "local:../core", 23 | "gren-lang/url": "5.0.0 <= v < 6.0.0" 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /integration-tests/.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | -------------------------------------------------------------------------------- /integration-tests/http-client/.gitignore: -------------------------------------------------------------------------------- 1 | app 2 | .gren 3 | node_modules/ 4 | -------------------------------------------------------------------------------- /integration-tests/http-client/Makefile: -------------------------------------------------------------------------------- 1 | app: Makefile gren.json src/Main.gren 2 | gren make --optimize src/Main.gren --output=bin/app 3 | 4 | .PHONY: test 5 | test: app node_modules 6 | npm test 7 | 8 | node_modules: package.json package-lock.json 9 | npm install 10 | 11 | .PHONY: clean 12 | clean: 13 | rm -rf .gren 14 | rm -rf node_modules 15 | rm bin/app 16 | -------------------------------------------------------------------------------- /integration-tests/http-client/bin/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gren-lang/node/a77231fc9eb40583d9af2060a314dedb31b95a19/integration-tests/http-client/bin/.gitkeep -------------------------------------------------------------------------------- /integration-tests/http-client/gren.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "platform": "node", 4 | "source-directories": [ 5 | "src" 6 | ], 7 | "gren-version": "0.5.3", 8 | "dependencies": { 9 | "direct": { 10 | "gren-lang/core": "6.0.0", 11 | "gren-lang/node": "local:../.." 12 | }, 13 | "indirect": { 14 | "gren-lang/url": "5.0.0" 15 | } 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /integration-tests/http-client/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "scripts": { 3 | "test": "mocha" 4 | }, 5 | "dependencies": { 6 | "clet": "^1.0.1", 7 | "mocha": "^10.2.0", 8 | "mockttp": "^3.10.0" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /integration-tests/http-client/src/Main.gren: -------------------------------------------------------------------------------- 1 | module Main exposing (main) 2 | 3 | import Node 4 | import Init 5 | import Task 6 | import HttpClient 7 | import Stream 8 | import Json.Encode as Json 9 | import Json.Decode 10 | import Dict 11 | import Bytes exposing (Bytes) 12 | import Bytes.Encode 13 | import Bytes.Decode 14 | 15 | 16 | type alias Model = 17 | { stdout : Stream.Writable Bytes 18 | , httpPermission : HttpClient.Permission 19 | , streamReqChunks : Array Bytes 20 | , streamStatusCode : Int 21 | } 22 | 23 | 24 | type Msg 25 | = Response (Result HttpClient.Error (HttpClient.Response String)) 26 | | JsonResponse (Result HttpClient.Error (HttpClient.Response JsonBodyResponse)) 27 | | BytesResponse (Result HttpClient.Error (HttpClient.Response Bytes)) 28 | | StreamResponse HttpClient.StreamEvent 29 | 30 | 31 | type alias JsonBodyResponse = 32 | { response : String } 33 | 34 | 35 | main : Node.Program Model Msg 36 | main = 37 | Node.defineProgram 38 | { init = init 39 | , update = update 40 | , subscriptions = \_ -> Sub.none 41 | } 42 | 43 | 44 | init : Node.Environment -> Init.Task { model : Model, command : Cmd Msg } 45 | init env = 46 | Init.await HttpClient.initialize <| \httpPerm -> 47 | let 48 | reqChunks = 49 | [ "{ " 50 | , "\"message\": " 51 | , "\"Was chunked as bytes\"" 52 | , " }" 53 | ] 54 | |> Array.map Bytes.fromString 55 | in 56 | Node.startProgram 57 | { model = 58 | { stdout = env.stdout 59 | , httpPermission = httpPerm 60 | , streamReqChunks = reqChunks 61 | , streamStatusCode = 0 62 | } 63 | , command = 64 | when Array.get 2 env.args is 65 | Just "simple get" -> 66 | HttpClient.get "http://localhost:8080/mocked-path" 67 | |> HttpClient.expectString 68 | |> HttpClient.send httpPerm 69 | |> Task.attempt Response 70 | 71 | Just "post with body" -> 72 | HttpClient.post "http://localhost:8080/mocked-path" 73 | |> HttpClient.withBytesBody "application/json" 74 | -- Overly complicated, but it's for testing bytes support 75 | (Bytes.fromString "{ \"secret\": \"Hello, POST!\" }") 76 | |> HttpClient.expectJson 77 | ( Json.Decode.map (\s -> { response = s }) 78 | (Json.Decode.field "response" Json.Decode.string) 79 | ) 80 | |> HttpClient.send httpPerm 81 | |> Task.attempt JsonResponse 82 | 83 | Just "timeout" -> 84 | HttpClient.get "http://localhost:8080/mocked-path" 85 | |> HttpClient.expectString 86 | |> HttpClient.withTimeout 50 87 | |> HttpClient.send httpPerm 88 | |> Task.attempt Response 89 | 90 | Just "headers" -> 91 | HttpClient.post "http://localhost:8080/mocked-path" 92 | |> HttpClient.withHeader "X-Request-ID" "12345" 93 | |> HttpClient.withJsonBody 94 | ( Json.object 95 | [ { key = "message", value = Json.string "Check out my headers" } ] 96 | ) 97 | |> HttpClient.expectJson 98 | ( Json.Decode.map (\s -> { response = s }) 99 | (Json.Decode.field "response" Json.Decode.string) 100 | ) 101 | |> HttpClient.send httpPerm 102 | |> Task.attempt JsonResponse 103 | 104 | Just "bytes" -> 105 | HttpClient.get "http://localhost:8080/mocked-path" 106 | |> HttpClient.expectBytes 107 | |> HttpClient.send httpPerm 108 | |> Task.attempt BytesResponse 109 | 110 | Just "stream" -> 111 | HttpClient.post "http://localhost:8080/mocked-path" 112 | |> HttpClient.expectBytes 113 | |> HttpClient.stream httpPerm StreamResponse 114 | 115 | _ -> 116 | Stream.writeLineAsBytes "Invalid start argument" env.stdout 117 | |> Task.andThen (\_ -> Task.succeed {}) 118 | |> Task.onError (\_ -> Task.succeed {}) 119 | |> Task.execute 120 | } 121 | 122 | 123 | update : Msg -> Model -> { model : Model, command : Cmd Msg } 124 | update msg model = 125 | when msg is 126 | Response (Ok response) -> 127 | { model = model 128 | , command = 129 | Stream.writeLineAsBytes (String.fromInt response.statusCode ++ ": " ++ response.data) model.stdout 130 | |> Task.andThen (\_ -> Task.succeed {}) 131 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 132 | |> Task.execute 133 | } 134 | 135 | Response (Err err) -> 136 | { model = model 137 | , command = 138 | Stream.writeLineAsBytes (HttpClient.errorToString err) model.stdout 139 | |> Task.andThen (\_ -> Task.succeed {}) 140 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 141 | |> Task.execute 142 | } 143 | 144 | JsonResponse (Ok response) -> 145 | { model = model 146 | , command = 147 | Stream.writeLineAsBytes (String.fromInt response.statusCode ++ ": " ++ response.data.response) model.stdout 148 | |> Task.andThen (\_ -> Task.succeed {}) 149 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 150 | |> Task.execute 151 | } 152 | 153 | JsonResponse (Err err) -> 154 | { model = model 155 | , command = 156 | Stream.writeLineAsBytes (HttpClient.errorToString err) model.stdout 157 | |> Task.andThen (\_ -> Task.succeed {}) 158 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 159 | |> Task.execute 160 | } 161 | 162 | BytesResponse (Ok response) -> 163 | let 164 | decoder = 165 | Bytes.Decode.map2 (\i1 i2 -> { i1 = i1, i2 = i2}) 166 | (Bytes.Decode.unsignedInt32 Bytes.BE) 167 | (Bytes.Decode.unsignedInt32 Bytes.BE) 168 | in 169 | when Bytes.Decode.decode decoder response.data is 170 | Just { i1, i2 } -> 171 | { model = model 172 | , command = 173 | Stream.writeLineAsBytes (String.fromInt response.statusCode ++ ": " ++ String.fromInt i1 ++ " & " ++ String.fromInt i2) model.stdout 174 | |> Task.andThen (\_ -> Task.succeed {}) 175 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 176 | |> Task.execute 177 | } 178 | 179 | Nothing -> 180 | { model = model 181 | , command = 182 | Stream.writeLineAsBytes "Failed to decode byte sequence" model.stdout 183 | |> Task.andThen (\_ -> Task.succeed {}) 184 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 185 | |> Task.execute 186 | } 187 | 188 | 189 | BytesResponse (Err err) -> 190 | { model = model 191 | , command = 192 | Stream.writeLineAsBytes (HttpClient.errorToString err) model.stdout 193 | |> Task.andThen (\_ -> Task.succeed {}) 194 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 195 | |> Task.execute 196 | } 197 | 198 | StreamResponse progress -> 199 | when progress is 200 | HttpClient.SentChunk req -> 201 | when Array.popFirst model.streamReqChunks is 202 | Nothing -> 203 | -- We are done sending stuff 204 | { model = model 205 | , command = HttpClient.startReceive req 206 | } 207 | 208 | Just { first = nextChunk, rest = remainingChunks } -> 209 | { model = { model | streamReqChunks = remainingChunks } 210 | , command = HttpClient.sendChunk req nextChunk 211 | } 212 | 213 | HttpClient.ReceivedChunk { request, response } -> 214 | -- We received some data, but we're not interested in the result 215 | -- let 216 | -- _ = 217 | -- Bytes.Decode.decode (Bytes.Decode.string (Bytes.width chunk.data)) chunk.data 218 | -- |> Debug.log "Body" 219 | 220 | -- _ = Debug.log "chunk" chunk 221 | -- in 222 | { model = { model | streamStatusCode = response.statusCode } 223 | , command = Cmd.none 224 | } 225 | 226 | HttpClient.Error err -> 227 | { model = model 228 | , command = 229 | Stream.writeLineAsBytes (HttpClient.errorToString err) model.stdout 230 | |> Task.andThen (\_ -> Task.succeed {}) 231 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 232 | |> Task.execute 233 | } 234 | 235 | HttpClient.Aborted -> 236 | { model = model 237 | , command = 238 | Stream.writeLineAsBytes "Aborted" model.stdout 239 | |> Task.andThen (\_ -> Task.succeed {}) 240 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 241 | |> Task.execute 242 | } 243 | 244 | HttpClient.Done -> 245 | { model = model 246 | , command = 247 | Stream.writeLineAsBytes (String.fromInt model.streamStatusCode ++ ": Streaming done!") model.stdout 248 | |> Task.andThen (\_ -> Task.succeed {}) 249 | |> Task.onError (\_ -> Task.succeed {}) -- ignore error 250 | |> Task.execute 251 | } 252 | 253 | -------------------------------------------------------------------------------- /integration-tests/http-client/test/requests.mjs: -------------------------------------------------------------------------------- 1 | import * as path from "node:path"; 2 | import { runner, KEYS } from "clet"; 3 | import * as mockttp from "mockttp"; 4 | 5 | const server = mockttp.getLocal(); 6 | /* Enable for debugging 7 | server.on("request", (data) => { 8 | console.log(data); 9 | }); 10 | */ 11 | 12 | const baseDir = path.resolve("bin"); 13 | 14 | describe("Requests", () => { 15 | before(() => server.start(8080)); 16 | 17 | after(() => server.stop()); 18 | 19 | it("Simple Get", async () => { 20 | await server.forGet("/mocked-path").thenReply(200, "A mocked response"); 21 | 22 | await runner() 23 | .cwd(baseDir) 24 | .fork("app", ["simple get"], {}) 25 | .stdout("200: A mocked response"); 26 | }); 27 | 28 | it("JSON Post Echo", async () => { 29 | await server 30 | .forPost("/mocked-path") 31 | .withHeaders({ 32 | "Content-Type": "application/json", 33 | "Content-Length": "28", 34 | }) 35 | .withJsonBody({ secret: "Hello, POST!" }) 36 | .thenJson(200, { response: "Access Granted!" }); 37 | 38 | await runner() 39 | .cwd(baseDir) 40 | .fork("app", ["post with body"], {}) 41 | .stdout("200: Access Granted!"); 42 | }); 43 | 44 | it("Timeout", async () => { 45 | await server.forGet("/mocked-path").thenTimeout(); 46 | 47 | await runner().cwd(baseDir).fork("app", ["timeout"], {}).stdout("Timeout"); 48 | }); 49 | 50 | it("Custom headers", async () => { 51 | await server 52 | .forPost("/mocked-path") 53 | .withHeaders({ 54 | "Content-Type": "application/json", 55 | "X-Request-ID": "12345", 56 | }) 57 | .withJsonBody({ message: "Check out my headers" }) 58 | .thenJson(200, { response: "Nice headers" }); 59 | 60 | await runner() 61 | .cwd(baseDir) 62 | .fork("app", ["headers"]) 63 | .stdout("200: Nice headers"); 64 | }); 65 | 66 | it("Byte response", async () => { 67 | const dataView = new DataView(new ArrayBuffer(8)); 68 | dataView.setUint32(0, 42); 69 | dataView.setUint32(4, 24); 70 | 71 | await server 72 | .forGet("/mocked-path") 73 | .thenReply(200, new Uint8Array(dataView.buffer)); 74 | 75 | await runner() 76 | .cwd(baseDir) 77 | .fork("app", ["bytes"], {}) 78 | .stdout("200: 42 & 24"); 79 | }); 80 | 81 | it("Streaming request", async () => { 82 | await server 83 | .forPost("/mocked-path") 84 | .withJsonBody({ message: "Was chunked as bytes" }) 85 | .thenJson(200, { response: "Nice headers" }); 86 | 87 | await runner() 88 | .cwd(baseDir) 89 | .fork("app", ["stream"]) 90 | .stdout("200: Streaming done!"); 91 | }); 92 | }); 93 | -------------------------------------------------------------------------------- /integration-tests/http-server/.gitignore: -------------------------------------------------------------------------------- 1 | .gren/ 2 | app 3 | node_modules/ 4 | /test-results/ 5 | /playwright-report/ 6 | /playwright/.cache/ 7 | -------------------------------------------------------------------------------- /integration-tests/http-server/Makefile: -------------------------------------------------------------------------------- 1 | app: Makefile gren.json src/Main.gren 2 | gren make --optimize src/Main.gren --output=app 3 | 4 | .PHONY: test 5 | test: app node_modules 6 | npm test 7 | 8 | node_modules: package.json package-lock.json 9 | npm install 10 | 11 | .PHONY: clean 12 | clean: 13 | rm -rf .gren 14 | rm -rf node_modules 15 | rm app 16 | -------------------------------------------------------------------------------- /integration-tests/http-server/README.md: -------------------------------------------------------------------------------- 1 | # Example HTTP Server 2 | 3 | Run server on : `make serve` 4 | 5 | Run tests: `make test` 6 | -------------------------------------------------------------------------------- /integration-tests/http-server/gren.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "platform": "node", 4 | "source-directories": [ 5 | "src" 6 | ], 7 | "gren-version": "0.5.3", 8 | "dependencies": { 9 | "direct": { 10 | "gren-lang/core": "6.0.0", 11 | "gren-lang/node": "local:../.." 12 | }, 13 | "indirect": { 14 | "gren-lang/url": "5.0.0" 15 | } 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /integration-tests/http-server/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "scripts": { 3 | "test": "mocha --require test/fixtures.mjs" 4 | }, 5 | "dependencies": { 6 | "clet": "^1.0.1", 7 | "mocha": "^10.2.0", 8 | "supertest": "^7.0.0" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /integration-tests/http-server/public/george.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gren-lang/node/a77231fc9eb40583d9af2060a314dedb31b95a19/integration-tests/http-server/public/george.jpeg -------------------------------------------------------------------------------- /integration-tests/http-server/src/Main.gren: -------------------------------------------------------------------------------- 1 | module Main exposing (main) 2 | 3 | import Node 4 | import Bytes exposing (Bytes) 5 | import Dict 6 | import Stream 7 | import Node exposing (Environment, Program) 8 | import FileSystem 9 | import FileSystem.Path as Path 10 | import HttpServer as Http exposing (ServerError(..), Method(..)) 11 | import HttpServer.Response as Response exposing (Response) 12 | import Init 13 | import Json.Decode as Decode 14 | import Task exposing (Task) 15 | 16 | 17 | main : Program Model Msg 18 | main = 19 | Node.defineProgram 20 | { init = init 21 | , update = update 22 | , subscriptions = subscriptions 23 | } 24 | 25 | 26 | type alias Model = 27 | { stdout : Stream.Writable Bytes 28 | , stderr : Stream.Writable Bytes 29 | , server : Maybe Http.Server 30 | , fsPermission : FileSystem.Permission 31 | } 32 | 33 | 34 | type Msg 35 | = CreateServerResult (Result Http.ServerError Http.Server) 36 | | GotRequest { request : Http.Request, response : Response } 37 | | GotJpeg { response : Response, result : (Result FileSystem.Error Bytes) } 38 | 39 | 40 | init : Environment -> Init.Task { model : Model, command : Cmd Msg } 41 | init env = 42 | Init.await FileSystem.initialize <| \fileSystemPermission -> 43 | Init.await Http.initialize <| \serverPermission -> 44 | Node.startProgram 45 | { model = 46 | { stdout = env.stdout 47 | , stderr = env.stderr 48 | , server = Nothing 49 | , fsPermission = fileSystemPermission 50 | } 51 | , command = 52 | Task.attempt CreateServerResult <| 53 | Http.createServer serverPermission 54 | { host = "0.0.0.0" 55 | , port_ = 3000 56 | } 57 | } 58 | 59 | 60 | update : Msg -> Model -> { model : Model, command : Cmd Msg } 61 | update msg model = 62 | when msg is 63 | CreateServerResult result -> 64 | when result is 65 | Ok server -> 66 | { model = { model | server = Just server } 67 | , command = 68 | Stream.writeLineAsBytes "Server started" model.stdout 69 | |> Task.map (\_ -> {}) 70 | |> Task.onError (\_ -> Task.succeed {}) 71 | |> Task.execute 72 | } 73 | Err (ServerError { code, message }) -> 74 | { model = model 75 | , command = 76 | Stream.writeLineAsBytes ("Server failed to start: " ++ code ++ "\n" ++ message) model.stderr 77 | |> Task.map (\_ -> {}) 78 | |> Task.onError (\_ -> Task.succeed {}) 79 | |> Task.execute 80 | } 81 | 82 | GotRequest { request = req, response = res } -> 83 | { model = model 84 | , command = 85 | if req.url.path == "/george.jpeg" then 86 | FileSystem.readFile model.fsPermission (Path.fromPosixString "./public/george.jpeg") 87 | |> Task.attempt (\fileOp -> GotJpeg { response = res, result = fileOp }) 88 | else 89 | htmlResponse req res 90 | } 91 | 92 | GotJpeg { response, result = (Ok bytes) } -> 93 | { model = model 94 | , command = 95 | response 96 | |> Response.setHeader "Content-Type" "image/jpeg" 97 | |> Response.setStatus 200 98 | |> Response.setBodyAsBytes bytes 99 | |> Response.send 100 | } 101 | 102 | GotJpeg { response, result = (Err _) } -> 103 | { model = model 104 | , command = 105 | response 106 | |> Response.setHeader "Content-Type" "text/plain" 107 | |> Response.setStatus 404 108 | |> Response.setBody "Not found" 109 | |> Response.send 110 | } 111 | 112 | 113 | htmlResponse : Http.Request -> Response -> Cmd Msg 114 | htmlResponse req res = 115 | let 116 | { body, status } = when { method = req.method, path = req.url.path } is 117 | { method = GET, path = "/" } -> 118 | { body = "Welcome!" 119 | , status = 200 120 | } 121 | 122 | { method = GET, path = "/hello" } -> 123 | { body = "Hello to you too!" 124 | , status = 200 125 | } 126 | 127 | { method = POST, path = "/name" } -> 128 | { body = "Hello, " ++ 129 | ( req 130 | |> Http.bodyFromJson (Decode.dict Decode.string) 131 | |> Result.withDefault Dict.empty 132 | |> Dict.get "name" 133 | |> Maybe.withDefault "Oops! Can't decode body." 134 | ) 135 | , status = 200 136 | } 137 | 138 | { method = POST } -> 139 | { body = "You posted: " ++ 140 | ( req 141 | |> Http.bodyAsString 142 | |> Maybe.withDefault "Oops! Can't decode body." 143 | ) 144 | , status = 200 145 | } 146 | 147 | _ -> 148 | { body = "Not found: " ++ (Http.requestInfo req) 149 | , status = 404 150 | } 151 | in 152 | res 153 | |> Response.setStatus status 154 | |> Response.setHeader "Content-type" "text/html" 155 | |> Response.setHeader "X-Custom-Header" "hey there" 156 | |> Response.setBody body 157 | |> Response.send 158 | 159 | 160 | subscriptions : Model -> Sub Msg 161 | subscriptions model = 162 | when model.server is 163 | Just server -> 164 | Http.onRequest server <| \req res -> GotRequest { request = req, response = res } 165 | 166 | Nothing -> 167 | Sub.none 168 | -------------------------------------------------------------------------------- /integration-tests/http-server/test/fixtures.mjs: -------------------------------------------------------------------------------- 1 | import * as path from "node:path"; 2 | import * as childProc from "node:child_process"; 3 | 4 | let proc; 5 | 6 | export function mochaGlobalSetup() { 7 | const appPath = path.resolve(import.meta.dirname, "../app"); 8 | proc = childProc.fork(appPath); 9 | return new Promise((resolve) => { 10 | setTimeout(() => { 11 | resolve({}); 12 | }, 100); 13 | }); 14 | } 15 | 16 | export function mochaGlobalTeardown() { 17 | proc.kill(); 18 | } 19 | -------------------------------------------------------------------------------- /integration-tests/http-server/test/requests.mjs: -------------------------------------------------------------------------------- 1 | import request from "supertest"; 2 | import * as assert from "node:assert"; 3 | 4 | const url = "http://localhost:3000"; 5 | 6 | describe("Requests", () => { 7 | it("responding with custom body", async () => { 8 | const res1 = await request(url).get("/"); 9 | 10 | assert.equal(res1.status, 200); 11 | assert.equal(res1.text, "Welcome!"); 12 | 13 | const res2 = await request(url).get("/hello"); 14 | 15 | assert.equal(res2.status, 200); 16 | assert.equal(res2.text, "Hello to you too!"); 17 | }); 18 | 19 | it("responding with custom status", async () => { 20 | const res1 = await request(url).get("/"); 21 | assert.equal(res1.status, 200); 22 | 23 | const res2 = await request(url).get("/not/found"); 24 | assert.equal(res2.status, 404); 25 | }); 26 | 27 | it("setting custom headers", async () => { 28 | const res = await request(url).get("/"); 29 | const headerValue = res.headers["x-custom-header"]; 30 | assert.equal(headerValue, "hey there"); 31 | }); 32 | 33 | it("responding to non-GET requests", async () => { 34 | const res1 = await request(url).post("/").send("some data"); 35 | assert.equal(res1.headers["content-type"], "text/html"); 36 | assert.equal(res1.text, "You posted: some data"); 37 | 38 | const res2 = await request(url).put("/howdy"); 39 | assert.equal(res2.headers["content-type"], "text/html"); 40 | assert.equal(res2.text, "Not found: PUT http://localhost:3000/howdy"); 41 | }); 42 | 43 | // Can't actually test this because node:http doesn't support custom methods. 44 | // See https://github.com/nodejs/node-v0.x-archive/issues/3192 45 | // and https://github.com/nodejs/http-parser/issues/309 46 | // test("unknown http method", async ({ request }) => { 47 | // let response = await request.fetch("/hello", { method: "FAKE" }); 48 | // await expect(await response.text()).toContain("UNKNOWN(FAKE) /howdy"); 49 | // }); 50 | 51 | it("handling json", async () => { 52 | const response = await request(url).post("/name").send({ name: "Jane" }); 53 | assert.equal(response.text, "Hello, Jane"); 54 | }); 55 | 56 | it("responding to stream requests", async () => { 57 | const response = await request(url) 58 | .post("/") 59 | .field("test.txt", Buffer.from("abc123"), { mimeType: "text/plain" }); 60 | 61 | assert.equal(response.status, 200); 62 | assert.match(response.text, /test.txt/); 63 | assert.match(response.text, /abc123/); 64 | }); 65 | 66 | it("handling unicode", async () => { 67 | const response = await request(url).post("/").send("snow ❄ flake"); 68 | 69 | assert.equal(response.headers["content-type"], "text/html"); 70 | assert.equal(response.text, "You posted: snow ❄ flake"); 71 | }); 72 | 73 | it("responding with bytes", async () => { 74 | const response = await request(url).get("/george.jpeg"); 75 | 76 | assert.equal(response.status, 200); 77 | assert.equal(response.headers["content-type"], "image/jpeg"); 78 | }); 79 | }); 80 | -------------------------------------------------------------------------------- /integration-tests/signals/.gitignore: -------------------------------------------------------------------------------- 1 | app 2 | .gren 3 | node_modules/ 4 | -------------------------------------------------------------------------------- /integration-tests/signals/Makefile: -------------------------------------------------------------------------------- 1 | app: Makefile gren.json src/Main.gren 2 | gren make --optimize src/Main.gren --output=bin/app 3 | 4 | .PHONY: test 5 | test: app node_modules 6 | npm test 7 | 8 | node_modules: package.json package-lock.json 9 | npm install 10 | 11 | .PHONY: clean 12 | clean: 13 | rm -rf .gren 14 | rm -rf node_modules 15 | rm bin/app 16 | -------------------------------------------------------------------------------- /integration-tests/signals/bin/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gren-lang/node/a77231fc9eb40583d9af2060a314dedb31b95a19/integration-tests/signals/bin/.gitkeep -------------------------------------------------------------------------------- /integration-tests/signals/gren.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "platform": "node", 4 | "source-directories": [ 5 | "src" 6 | ], 7 | "gren-version": "0.5.3", 8 | "dependencies": { 9 | "direct": { 10 | "gren-lang/core": "6.0.0", 11 | "gren-lang/node": "local:../.." 12 | }, 13 | "indirect": { 14 | "gren-lang/url": "5.0.0" 15 | } 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /integration-tests/signals/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "scripts": { 3 | "test": "mocha" 4 | }, 5 | "dependencies": { 6 | "clet": "^1.0.1", 7 | "mocha": "^10.2.0", 8 | "mockttp": "^3.10.0" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /integration-tests/signals/src/Main.gren: -------------------------------------------------------------------------------- 1 | module Main exposing (main) 2 | 3 | import Node 4 | import Init 5 | import Task 6 | import HttpClient 7 | import Stream 8 | import Json.Encode as Json 9 | import Json.Decode 10 | import Dict 11 | import Bytes exposing (Bytes) 12 | import Bytes.Encode 13 | import Bytes.Decode 14 | import Process 15 | 16 | 17 | type alias Model = 18 | { stdout : Stream.Writable Bytes 19 | , listenEmptyEventLoop : Bool 20 | , listenSigInt : Bool 21 | , listenSigTerm : Bool 22 | } 23 | 24 | 25 | type Msg 26 | = EmptyEventLoop 27 | | SigInt 28 | | SigTerm 29 | 30 | 31 | main : Node.Program Model Msg 32 | main = 33 | Node.defineProgram 34 | { init = init 35 | , update = update 36 | , subscriptions = 37 | \model -> 38 | Sub.batch 39 | [ if model.listenEmptyEventLoop then 40 | Node.onEmptyEventLoop EmptyEventLoop 41 | 42 | else 43 | Sub.none 44 | , if model.listenSigInt then 45 | Node.onSignalInterrupt SigInt 46 | 47 | else 48 | Sub.none 49 | , if model.listenSigTerm then 50 | Node.onSignalTerminate SigTerm 51 | 52 | else 53 | Sub.none 54 | ] 55 | } 56 | 57 | 58 | init : Node.Environment -> Init.Task { model : Model, command : Cmd Msg } 59 | init env = 60 | let 61 | defaultModel = 62 | { stdout = env.stdout 63 | , listenEmptyEventLoop = False 64 | , listenSigInt = False 65 | , listenSigTerm = False 66 | } 67 | in 68 | Node.startProgram <| 69 | when Array.get 2 env.args is 70 | Just "EmptyEventLoop" -> 71 | { model = { defaultModel | listenEmptyEventLoop = True } 72 | , command = Cmd.none 73 | } 74 | 75 | Just "SIGINT" -> 76 | { model = { defaultModel | listenSigInt = True } 77 | , command = 78 | Process.sleep 50000 79 | |> Task.execute 80 | } 81 | 82 | Just "SIGTERM" -> 83 | { model = { defaultModel | listenSigTerm = True } 84 | , command = 85 | Process.sleep 50000 86 | |> Task.execute 87 | } 88 | 89 | _ -> 90 | { model = defaultModel 91 | , command = 92 | Stream.writeLineAsBytes "Invalid start argument" env.stdout 93 | |> Task.andThen (\_ -> Task.succeed {}) 94 | |> Task.onError (\_ -> Task.succeed {}) 95 | |> Task.execute 96 | } 97 | 98 | 99 | update : Msg -> Model -> { model : Model, command : Cmd Msg } 100 | update msg model = 101 | when msg is 102 | EmptyEventLoop -> 103 | { model = model 104 | , command = 105 | Stream.writeLineAsBytes "EmptyEventLoop" model.stdout 106 | |> Task.andThen (\_ -> Node.exitWithCode 100) 107 | |> Task.andThen (\_ -> Task.succeed {}) 108 | |> Task.onError (\_ -> Task.succeed {}) 109 | |> Task.execute 110 | } 111 | 112 | SigInt -> 113 | { model = model 114 | , command = 115 | Stream.writeLineAsBytes "SIGINT" model.stdout 116 | |> Task.andThen (\_ -> Node.exitWithCode 101) 117 | |> Task.andThen (\_ -> Task.succeed {}) 118 | |> Task.onError (\_ -> Task.succeed {}) 119 | |> Task.execute 120 | } 121 | 122 | SigTerm -> 123 | { model = model 124 | , command = 125 | Stream.writeLineAsBytes "SIGTERM" model.stdout 126 | |> Task.andThen (\_ -> Node.exitWithCode 102) 127 | |> Task.andThen (\_ -> Task.succeed {}) 128 | |> Task.onError (\_ -> Task.succeed {}) 129 | |> Task.execute 130 | } 131 | -------------------------------------------------------------------------------- /integration-tests/signals/test/requests.mjs: -------------------------------------------------------------------------------- 1 | import * as path from "node:path"; 2 | import * as fs from "node:fs"; 3 | import { runner } from "clet"; 4 | 5 | const baseDir = path.resolve("bin"); 6 | 7 | describe("Signals", () => { 8 | it("Empty Event Loop", async () => { 9 | await runner() 10 | .cwd(baseDir) 11 | .fork("app", ["EmptyEventLoop"], {}) 12 | .stdout("EmptyEventLoop") 13 | .code(100); 14 | }); 15 | 16 | // TODO: How to test SIGINT and SIGTERM? 17 | }); 18 | -------------------------------------------------------------------------------- /integration-tests/test.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | 5 | echo -e "Running http-server tests...\n\n" 6 | pushd http-server 7 | make test || exit 1 8 | popd 9 | 10 | echo -e "Running http-client tests...\n\n" 11 | pushd http-client 12 | make test || exit 1 13 | popd 14 | 15 | echo -e "Running signals tests...\n\n" 16 | pushd signals 17 | make test || exit 1 18 | popd 19 | -------------------------------------------------------------------------------- /src/ChildProcess.gren: -------------------------------------------------------------------------------- 1 | effect module ChildProcess where { command = MyCmd } exposing 2 | ( Permission 3 | , initialize 4 | -- 5 | , RunOptions 6 | , defaultRunOptions 7 | , Shell(..) 8 | , WorkingDirectory(..) 9 | , EnvironmentVariables(..) 10 | , RunDuration(..) 11 | -- 12 | , FailedRun 13 | , SuccessfulRun 14 | , run 15 | -- 16 | , SpawnOptions 17 | , StreamIO 18 | , Connection(..) 19 | , defaultSpawnOptions 20 | , spawn 21 | ) 22 | 23 | 24 | {-| A running program is a process. A process spawned from another process is known as a child process. 25 | 26 | This module allow you to spawn child processes. 27 | 28 | ## Initialization 29 | 30 | @docs Permission, initialize 31 | 32 | ## Running processes 33 | 34 | @docs RunOptions, defaultRunOptions, Shell, WorkingDirectory, EnvironmentVariables, RunDuration 35 | @docs FailedRun, SuccessfulRun, run 36 | 37 | ## Spawning processes 38 | 39 | @docs SpawnOptions, StreamIO, Connection, defaultSpawnOptions, spawn 40 | -} 41 | 42 | 43 | import Gren.Kernel.ChildProcess 44 | import Bytes exposing (Bytes) 45 | import Dict exposing (Dict) 46 | import Task exposing (Task) 47 | import Init 48 | import Internal.Init 49 | import Process 50 | import Stream 51 | 52 | 53 | {-| This value represents the permission to spawn child processes. 54 | 55 | Only code you trust should have access to this value. 56 | -} 57 | type Permission 58 | = Permission 59 | 60 | 61 | {-| Initialize the `ChildProcess` subsystem, which gains you the permission to 62 | spawn child processes. 63 | -} 64 | initialize : Init.Task Permission 65 | initialize = 66 | Task.succeed Permission 67 | |> Internal.Init.Task 68 | 69 | 70 | -- OPTIONS 71 | 72 | 73 | {-| Options to customize the execution of a child process created with [run](#run). 74 | 75 | * `shell` is the shell to run the process in (if any) 76 | * `workingDirectory` specifies the working directory of the process 77 | * `environmentVariables` specifies the environment variables the process has access to 78 | * `maximumBytesWrittenToStreams` specifies an upper bound of bytes that can be returned from the process 79 | * `runDuration` specifies a maximum amount of time a process is allowed to run before exiting 80 | -} 81 | type alias RunOptions = 82 | { shell : Shell 83 | , workingDirectory : WorkingDirectory 84 | , environmentVariables : EnvironmentVariables 85 | , maximumBytesWrittenToStreams : Int 86 | , runDuration : RunDuration 87 | } 88 | 89 | 90 | {-| A nice default set of options for the [run](#run) function 91 | -} 92 | defaultRunOptions : RunOptions 93 | defaultRunOptions = 94 | { shell = DefaultShell 95 | , workingDirectory = InheritWorkingDirectory 96 | , environmentVariables = InheritEnvironmentVariables 97 | , maximumBytesWrittenToStreams = 1024 * 1024 -- 1Mb 98 | , runDuration = NoLimit 99 | } 100 | 101 | 102 | {-| Which shell should the child process run in? 103 | 104 | * `NoShell` executes the process directly, without any shell. A little bit more efficient, but you lose some convinience as shell behaviour (like glob patterns) isn't available for arguments 105 | * `DefaultShell` executes the process in the default shell for the currently running system 106 | * `CustomShell` executes the process in the specified shell. 107 | -} 108 | type Shell 109 | = NoShell 110 | | DefaultShell 111 | | CustomShell String 112 | 113 | 114 | {-| What should be the working directory of the process? 115 | 116 | * `InheritWorkingDirectory` inherits the working directory from its parent 117 | * `SetWorkingDirectory` sets the working directory to the specified value (doesn't affect parent) 118 | -} 119 | type WorkingDirectory 120 | = InheritWorkingDirectory 121 | | SetWorkingDirectory String 122 | 123 | 124 | {-| What should be the environment variables of the process? 125 | 126 | * `InheritEnvironmentVariables` inherits the environment variables from its parent 127 | * `MergeWithEnvironmentVariables` inherits the environment variables from its parent, with the specified modifications 128 | * `ReplaceEnvironmentVariables` sets the environment variables to the specified dictionary 129 | -} 130 | type EnvironmentVariables 131 | = InheritEnvironmentVariables 132 | | MergeWithEnvironmentVariables (Dict String String) 133 | | ReplaceEnvironmentVariables (Dict String String) 134 | 135 | 136 | {-| How long is the process allowed to run before it's forcefully terminated? 137 | 138 | * `NoLimit` means it can run forever 139 | * `Milliseconds` sets the limit to the specified number of milliseconds 140 | -} 141 | type RunDuration 142 | = NoLimit 143 | | Milliseconds Int 144 | 145 | 146 | -- RUN 147 | 148 | 149 | {-| Return value when a process terminates due to an error 150 | 151 | The exit code provides some hint of what went wrong, but what it means depends on the program which was run. 152 | -} 153 | type alias FailedRun = 154 | { exitCode: Int 155 | , stdout : Bytes 156 | , stderr : Bytes 157 | } 158 | 159 | 160 | {-| Return value when a process terminates without error 161 | -} 162 | type alias SuccessfulRun = 163 | { stdout : Bytes 164 | , stderr : Bytes 165 | } 166 | 167 | 168 | {-| Execute a process with a given name, arguments and options, and wait for it to terminate. 169 | 170 | run permission "cat" [ "my_file" ] defaultRunOptions 171 | 172 | -} 173 | run : Permission -> String -> Array String -> RunOptions -> Task FailedRun SuccessfulRun 174 | run _ program arguments opts = 175 | Gren.Kernel.ChildProcess.run 176 | { program = program 177 | , arguments = arguments 178 | , shell = 179 | when opts.shell is 180 | NoShell -> 181 | { choice = 0 182 | , value = "" 183 | } 184 | 185 | DefaultShell -> 186 | { choice = 1 187 | , value = "" 188 | } 189 | 190 | CustomShell value -> 191 | { choice = 2 192 | , value = value 193 | } 194 | , workingDirectory = 195 | when opts.workingDirectory is 196 | InheritWorkingDirectory -> 197 | { inherit = True 198 | , override = "" 199 | } 200 | 201 | SetWorkingDirectory value -> 202 | { inherit = False 203 | , override = value 204 | } 205 | , environmentVariables = 206 | when opts.environmentVariables is 207 | InheritEnvironmentVariables -> 208 | { option = 0 209 | , value = Dict.empty 210 | } 211 | 212 | MergeWithEnvironmentVariables value -> 213 | { option = 1 214 | , value = value 215 | } 216 | 217 | ReplaceEnvironmentVariables value -> 218 | { option = 2 219 | , value = value 220 | } 221 | , maximumBytesWrittenToStreams = opts.maximumBytesWrittenToStreams 222 | , runDuration = 223 | when opts.runDuration is 224 | NoLimit -> 225 | 0 226 | 227 | Milliseconds ms -> 228 | max 0 ms 229 | } 230 | 231 | 232 | -- SPAWN 233 | 234 | 235 | {-| Options to customize the execution of a child process created with [spawn](#spawn). 236 | 237 | * `shell` is the shell to run the process in (if any) 238 | * `workingDirectory` specifies the working directory of the process 239 | * `environmentVariables` specifies the environment variables the process has access to 240 | * `runDuration` specifies a maximum amount of time a process is allowed to run before exiting 241 | * `connection` let's you specify how the new process is connected to the application, 242 | and which message to receive when the process starts 243 | * `onExit` is the message that is triggered when the process exits. The message receives the exit code. 244 | -} 245 | type alias SpawnOptions msg = 246 | { shell : Shell 247 | , workingDirectory : WorkingDirectory 248 | , environmentVariables : EnvironmentVariables 249 | , runDuration : RunDuration 250 | , connection : Connection msg 251 | , onExit : Int -> msg 252 | } 253 | 254 | 255 | {-| Record expected by spawn kernel call. 256 | -} 257 | type alias KernelSpawnConfig msg = 258 | { program : String 259 | , arguments : Array String 260 | , shell : 261 | { choice : Int 262 | , value : String 263 | } 264 | , workingDirectory : 265 | { inherit : Bool 266 | , override : String 267 | } 268 | , environmentVariables : 269 | { option : Int 270 | , value : Dict String String 271 | } 272 | , runDuration : Int 273 | , connection : 274 | { kind : Int 275 | , onInit : { processId : Process.Id, streams : StreamIO } -> msg 276 | } 277 | , onExit : Int -> msg 278 | } 279 | 280 | 281 | {-| Streams that can be used to communicate with a spawned child process. 282 | -} 283 | type alias StreamIO = 284 | { input : Stream.Writable Bytes 285 | , output : Stream.Readable Bytes 286 | , error : Stream.Readable Bytes 287 | } 288 | 289 | 290 | {-| What relation should the newly spawned process have with the running application? 291 | 292 | * `Integrated` means that the spawned process shares the stdin, stdout and stderr streams. 293 | * `External` means that a new streams are created for stdin, stdout and stderr and passed to the application, which can use those streams for communicating with the new process. 294 | * `Ignored` means the same as `External`, but anything written to stdin, stdout and stderr is discarded/ignored. 295 | * `Detached` means the same as `Ignored`, but that the application will exit even if the child process hasn't finished executing. 296 | -} 297 | type Connection msg 298 | = Integrated (Process.Id -> msg) 299 | | External ({ processId : Process.Id, streams : StreamIO } -> msg) 300 | | Ignored (Process.Id -> msg) 301 | | Detached (Process.Id -> msg) 302 | 303 | 304 | {-| A nice default set of options for the [spawn](#spawn) function. 305 | -} 306 | defaultSpawnOptions : Connection msg -> (Int -> msg) -> SpawnOptions msg 307 | defaultSpawnOptions connection onExit = 308 | { shell = DefaultShell 309 | , workingDirectory = InheritWorkingDirectory 310 | , environmentVariables = InheritEnvironmentVariables 311 | , runDuration = NoLimit 312 | , connection = connection 313 | , onExit = onExit 314 | } 315 | 316 | 317 | {-| Spawn a process with a given name, arguments and options, and let it run in the background. 318 | This is mostly helpful for starting long-running processes. 319 | 320 | spawn permission "tail" [ "my_file" ] mySpawnOptions 321 | 322 | -} 323 | spawn : Permission -> String -> Array String -> SpawnOptions msg -> Cmd msg 324 | spawn _ program arguments opts = 325 | command <| Spawn <| kernelSpawnConfig program arguments opts 326 | 327 | 328 | kernelSpawnConfig : String -> Array String -> SpawnOptions msg -> KernelSpawnConfig msg 329 | kernelSpawnConfig program arguments opts = 330 | { program = program 331 | , arguments = arguments 332 | , shell = 333 | when opts.shell is 334 | NoShell -> 335 | { choice = 0 336 | , value = "" 337 | } 338 | 339 | DefaultShell -> 340 | { choice = 1 341 | , value = "" 342 | } 343 | 344 | CustomShell value -> 345 | { choice = 2 346 | , value = value 347 | } 348 | , workingDirectory = 349 | when opts.workingDirectory is 350 | InheritWorkingDirectory -> 351 | { inherit = True 352 | , override = "" 353 | } 354 | 355 | SetWorkingDirectory value -> 356 | { inherit = False 357 | , override = value 358 | } 359 | , environmentVariables = 360 | when opts.environmentVariables is 361 | InheritEnvironmentVariables -> 362 | { option = 0 363 | , value = Dict.empty 364 | } 365 | 366 | MergeWithEnvironmentVariables value -> 367 | { option = 1 368 | , value = value 369 | } 370 | 371 | ReplaceEnvironmentVariables value -> 372 | { option = 2 373 | , value = value 374 | } 375 | , runDuration = 376 | when opts.runDuration is 377 | NoLimit -> 378 | 0 379 | 380 | Milliseconds ms -> 381 | max 0 ms 382 | , connection = 383 | when opts.connection is 384 | Integrated toMsg -> 385 | { kind = 0 386 | , onInit = (\{ processId } -> toMsg processId) 387 | } 388 | 389 | External toMsg -> 390 | { kind = 1 391 | , onInit = toMsg 392 | } 393 | 394 | Ignored toMsg -> 395 | { kind = 2 396 | , onInit = (\{ processId } -> toMsg processId) 397 | } 398 | 399 | Detached toMsg -> 400 | { kind = 3 401 | , onInit = (\{ processId } -> toMsg processId) 402 | } 403 | , onExit = opts.onExit 404 | } 405 | 406 | 407 | mapKernelSpawnConfig : (msg -> msg2) -> KernelSpawnConfig msg -> KernelSpawnConfig msg2 408 | mapKernelSpawnConfig mapper config = 409 | { program = config.program 410 | , arguments = config.arguments 411 | , shell = config.shell 412 | , workingDirectory = config.workingDirectory 413 | , environmentVariables = config.environmentVariables 414 | , runDuration = config.runDuration 415 | , connection = 416 | { kind = config.connection.kind 417 | , onInit = mapper << config.connection.onInit 418 | } 419 | , onExit = mapper << config.onExit 420 | } 421 | 422 | -- COMMANDS 423 | 424 | 425 | type MyCmd msg 426 | = Spawn (KernelSpawnConfig msg) 427 | 428 | 429 | cmdMap : (a -> b) -> MyCmd a -> MyCmd b 430 | cmdMap func cmd = 431 | when cmd is 432 | Spawn config -> 433 | Spawn <| mapKernelSpawnConfig func config 434 | 435 | 436 | init : Task Never {} 437 | init = 438 | Task.succeed {} 439 | 440 | 441 | onEffects : Platform.Router msg Never -> Array (MyCmd msg) -> {} -> Task Never {} 442 | onEffects router commands state = 443 | when Array.popFirst commands is 444 | Nothing -> 445 | Task.succeed state 446 | 447 | Just { first, rest } -> 448 | when first is 449 | Spawn config -> 450 | Gren.Kernel.ChildProcess.spawn 451 | (Platform.sendToApp router << config.connection.onInit) 452 | (Platform.sendToApp router << config.onExit) 453 | config 454 | |> Process.spawn 455 | |> Task.andThen 456 | (\_ -> onEffects router rest {}) 457 | 458 | 459 | onSelfMsg : Platform.Router msg Never -> Never -> {} -> Task Never {} 460 | onSelfMsg _ _ _ = 461 | Task.succeed {} 462 | -------------------------------------------------------------------------------- /src/FileSystem/FileHandle.gren: -------------------------------------------------------------------------------- 1 | module FileSystem.FileHandle exposing 2 | ( FileHandle 3 | , ReadableFileHandle 4 | , WriteableFileHandle 5 | , ReadWriteableFileHandle 6 | , ReadPermission 7 | , WritePermission 8 | , makeReadOnly 9 | , makeWriteOnly 10 | -- 11 | , openForRead 12 | , OpenForWriteBehaviour(..) 13 | , openForWrite 14 | , openForReadAndWrite 15 | , close 16 | -- 17 | , metadata 18 | , changeAccess 19 | , changeOwner 20 | , changeTimes 21 | -- 22 | , read 23 | , readFromOffset 24 | -- 25 | , write 26 | , writeFromOffset 27 | , truncate 28 | , sync 29 | , syncData 30 | ) 31 | 32 | 33 | {-| This module provides access to files through FileHandles. A [FileHandle](#FileHandle) represents an open file. 34 | If you know you're going to perform repeated operations on a file, it will be more efficient through a [FileHandle](#FileHandle). 35 | 36 | The Error is the same as the one returned from the FileSystem module, but `errorPath` will always 37 | return an empty path. 38 | 39 | @docs FileHandle, ReadableFileHandle, WriteableFileHandle, ReadWriteableFileHandle, ReadPermission, WritePermission, makeReadOnly, makeWriteOnly 40 | 41 | ## File open/close 42 | 43 | @docs openForRead, OpenForWriteBehaviour, openForWrite, openForReadAndWrite, close 44 | 45 | ## File metadata 46 | 47 | @docs metadata, changeAccess, changeOwner, changeTimes 48 | 49 | ## Read from file 50 | 51 | @docs read, readFromOffset 52 | 53 | ## Write to file 54 | 55 | @docs write, writeFromOffset, truncate, sync, syncData 56 | -} 57 | 58 | 59 | import Gren.Kernel.FileSystem 60 | import Bytes exposing (Bytes) 61 | import Task exposing (Task) 62 | import FileSystem.Path exposing (Path) 63 | import FileSystem exposing (Permission) 64 | import Init 65 | import Internal.Init 66 | import Time 67 | 68 | 69 | {-| A file handle is used to perform operations on a file, like reading and writing. 70 | 71 | Having a file handle gives you access to perform certain operations, so make sure you 72 | only pass a file handle to code you can trust. 73 | 74 | The [FileHandle](#FileHandle) type also contains the read and write access permissions as part of its 75 | type. 76 | -} 77 | type FileHandle readAccess writeAccess 78 | -- Note: Actual implementation in kernel code 79 | = FileHandle 80 | 81 | 82 | {-| A type that represents the permission to read from a file. 83 | -} 84 | type ReadPermission = ReadPermission 85 | 86 | 87 | {-| A type that represents the permission to write to a file. 88 | -} 89 | type WritePermission = WritePermission 90 | 91 | 92 | {-| An alias for a [FileHandle](#FileHandle) that can be used in read operations. 93 | -} 94 | type alias ReadableFileHandle a = FileHandle ReadPermission a 95 | 96 | 97 | {-| An alias for a [FileHandle](#FileHandle) that can be used in write operations. 98 | -} 99 | type alias WriteableFileHandle a = FileHandle a WritePermission 100 | 101 | 102 | {-| An alias for a [FileHandle](#FileHandle) that can be used for both read and write operations. 103 | -} 104 | type alias ReadWriteableFileHandle = FileHandle ReadPermission WritePermission 105 | 106 | 107 | {-| This lets you downgrade a [ReadWriteableFileHandle](#ReadWriteableFileHandle) to a [FileHandle](#FileHandle) that only has read permission. 108 | 109 | Comes in handy when you want full access to a file in some parts of your code, but limited access in other parts 110 | of your code. 111 | -} 112 | makeReadOnly : ReadWriteableFileHandle -> FileHandle ReadPermission Never 113 | makeReadOnly = 114 | Gren.Kernel.FileSystem.coerce 115 | 116 | 117 | {-| This let's you downgrade a [ReadWriteableFileHandle](#ReadWriteableFileHandle) to a [FileHandle](#FileHandle) that only has write permission. 118 | 119 | Comes in handy when you want full access to a file in some parts of your code, but limited access in other parts 120 | of your code. 121 | -} 122 | makeWriteOnly : ReadWriteableFileHandle -> FileHandle Never WritePermission 123 | makeWriteOnly = 124 | Gren.Kernel.FileSystem.coerce 125 | 126 | 127 | -- OPEN 128 | 129 | 130 | {-| Open the file at the provided path with read permissions. 131 | -} 132 | openForRead : Permission -> Path -> Task FileSystem.Error (FileHandle ReadPermission Never) 133 | openForRead _ path = 134 | openImpl "r" path 135 | 136 | 137 | {-| There are several ways to open a file for writing. 138 | 139 | * `EnsureEmpty` will create an empty file if it doesn't exist, or remove all contents of a file if it does exist. 140 | * `ExpectExisting` will fail the task if it doesn't exist. 141 | * `ExpectNotExisting` will fail the task if the file does exist. 142 | -} 143 | type OpenForWriteBehaviour 144 | = EnsureEmpty 145 | | ExpectExisting 146 | | ExpectNotExisting 147 | 148 | 149 | {-| Open a file at the provided path with write permissions. 150 | -} 151 | openForWrite : Permission -> OpenForWriteBehaviour -> Path -> Task FileSystem.Error (FileHandle Never WritePermission) 152 | openForWrite _ behaviour path = 153 | let 154 | access = 155 | when behaviour is 156 | EnsureEmpty -> "w" 157 | ExpectExisting -> "r+" 158 | ExpectNotExisting -> "wx" 159 | in 160 | openImpl access path 161 | 162 | 163 | {-| Open a file for at the provided path with both read and write permissions. 164 | -} 165 | openForReadAndWrite : Permission -> OpenForWriteBehaviour -> Path -> Task FileSystem.Error ReadWriteableFileHandle 166 | openForReadAndWrite _ behaviour path = 167 | let 168 | access = 169 | when behaviour is 170 | EnsureEmpty -> "w+" 171 | ExpectExisting -> "r+" 172 | ExpectNotExisting -> "wx+" 173 | in 174 | openImpl access path 175 | 176 | 177 | openImpl : String -> Path -> Task FileSystem.Error (FileHandle a b) 178 | openImpl = 179 | Gren.Kernel.FileSystem.open 180 | 181 | 182 | {-| Close a file. All operations performed against the given [FileHandle](#FileHandle) will fail. 183 | -} 184 | close : FileHandle a b -> Task FileSystem.Error {} 185 | close = 186 | Gren.Kernel.FileSystem.close 187 | 188 | 189 | -- METADATA 190 | 191 | 192 | {-| Retrieve [Metadata](FileSystem#Metadata) about the file represented by the [FileHandle](#FileHandle). 193 | -} 194 | metadata : ReadableFileHandle a -> Task FileSystem.Error (ReadableFileHandle FileSystem.Metadata) 195 | metadata = 196 | Gren.Kernel.FileSystem.fstat 197 | 198 | 199 | {-| Change how different users can access a file. 200 | -} 201 | changeAccess 202 | : { owner : Array FileSystem.AccessPermission 203 | , group : Array FileSystem.AccessPermission 204 | , others : Array FileSystem.AccessPermission 205 | } 206 | -> WriteableFileHandle a 207 | -> Task FileSystem.Error (WriteableFileHandle a) 208 | changeAccess permissions fh = 209 | let 210 | mode = 211 | (String.fromInt <| FileSystem.accessPermissionsToInt permissions.owner) 212 | ++ (String.fromInt <| FileSystem.accessPermissionsToInt permissions.group) 213 | ++ (String.fromInt <| FileSystem.accessPermissionsToInt permissions.others) 214 | in 215 | Gren.Kernel.FileSystem.fchmod mode fh 216 | 217 | 218 | {-| Change who owns the file. You'll need the ID of the new user and group who will own the file. 219 | -} 220 | changeOwner : { userID : Int, groupID : Int } -> WriteableFileHandle a -> Task FileSystem.Error (WriteableFileHandle a) 221 | changeOwner = 222 | Gren.Kernel.FileSystem.fchown 223 | 224 | 225 | {-| This will let you set the timestamp for when the file was last accessed, and last modified. 226 | The times will be rounded down to the closest second. 227 | -} 228 | changeTimes 229 | : { lastAccessed : Time.Posix 230 | , lastModified : Time.Posix 231 | } 232 | -> WriteableFileHandle a 233 | -> Task FileSystem.Error (WriteableFileHandle a) 234 | changeTimes { lastAccessed, lastModified } fh = 235 | Gren.Kernel.FileSystem.futimes 236 | (Time.posixToMillis lastAccessed // 1000) 237 | (Time.posixToMillis lastModified // 1000) 238 | fh 239 | 240 | 241 | -- READING 242 | 243 | 244 | {-| Read all bytes in a file. 245 | -} 246 | read : ReadableFileHandle a -> Task FileSystem.Error Bytes 247 | read fh = 248 | readFromOffset fh { offset = 0, length = -1 } 249 | 250 | 251 | {-| Read `length` number of bytes from a file, starting at `offset` bytes. 252 | -} 253 | readFromOffset : ReadableFileHandle a -> { offset : Int, length : Int } -> Task FileSystem.Error Bytes 254 | readFromOffset = 255 | Gren.Kernel.FileSystem.readFromOffset 256 | 257 | 258 | -- WRITING 259 | 260 | 261 | {-| Write the provided bytes into the file. If the file is not empty, bytes will be overwritten. 262 | -} 263 | write : WriteableFileHandle a -> Bytes -> Task FileSystem.Error (WriteableFileHandle a) 264 | write fh bytes = 265 | writeFromOffset fh 0 bytes 266 | 267 | 268 | {-| Write bytes into a specific location of a file. 269 | -} 270 | writeFromOffset : WriteableFileHandle a -> Int -> Bytes -> Task FileSystem.Error (WriteableFileHandle a) 271 | writeFromOffset = 272 | Gren.Kernel.FileSystem.writeFromOffset 273 | 274 | 275 | {-| Make sure that a file is of the given size. If the file is larger than the given size, excess bytes 276 | are discarded. If the file is smaller than the given size, zeroes will be added until it is of the given 277 | size. 278 | -} 279 | truncate : Int -> WriteableFileHandle a -> Task FileSystem.Error (WriteableFileHandle a) 280 | truncate = 281 | Gren.Kernel.FileSystem.ftruncate 282 | 283 | 284 | {-| Usually when you make changes to a file, the changes aren't actually written to disk right away. 285 | The changes are likely placed in an OS-level buffer, and flushed to disk when the OS decides its time 286 | to do so. 287 | 288 | This task, when executed, will force changes to be written to disk. 289 | -} 290 | sync : WriteableFileHandle a -> Task FileSystem.Error (WriteableFileHandle a) 291 | sync = 292 | Gren.Kernel.FileSystem.fsync 293 | 294 | 295 | {-| Same as [sync](#sync), except it only forces the contents of the file to be written. Changes to a 296 | file's metadata are not synced. This operation might be a little faster than a full sync, at the risk 297 | of loosing changes to metadata. 298 | -} 299 | syncData : WriteableFileHandle a -> Task FileSystem.Error (WriteableFileHandle a) 300 | syncData = 301 | Gren.Kernel.FileSystem.fdatasync 302 | -------------------------------------------------------------------------------- /src/FileSystem/Path.gren: -------------------------------------------------------------------------------- 1 | module FileSystem.Path exposing 2 | ( Path 3 | -- 4 | , empty 5 | , fromPosixString 6 | , toPosixString 7 | , fromWin32String 8 | , toWin32String 9 | -- 10 | , filenameWithExtension 11 | , parentPath 12 | -- 13 | , append 14 | , appendPosixString 15 | , appendWin32String 16 | , prepend 17 | , prependPosixString 18 | , prependWin32String 19 | , join 20 | ) 21 | 22 | 23 | {-| A path represents the location of a file or directory in a filesystem. 24 | 25 | @docs Path 26 | 27 | ## Constructors 28 | 29 | @docs empty, fromPosixString, toPosixString, fromWin32String, toWin32String 30 | 31 | ## Query 32 | 33 | @docs filenameWithExtension, parentPath 34 | 35 | ## Manipulation 36 | 37 | @docs append, appendPosixString, appendWin32String, prepend, prependPosixString, prependWin32String, join 38 | -} 39 | 40 | 41 | import Task exposing (Task) 42 | import Gren.Kernel.FilePath 43 | 44 | 45 | {-| A cross-platform representation of a filesystem path. 46 | 47 | If `root` is empty, it means that the path is relative to the working directory. 48 | On posix-compatible systems (Linux, Mac...), the root value is "/" if not empty. 49 | On Windows, the root refers to the specific disk that the path applies to. 50 | 51 | `filename` (and `extension`) refers to the last part of a path. It can still 52 | represent a directory. 53 | 54 | -} 55 | type alias Path = 56 | { root : String 57 | , directory : Array String 58 | , filename : String 59 | , extension : String 60 | } 61 | 62 | 63 | {-| The empty [Path](#Path). Normally treated as the current directory. 64 | -} 65 | empty : Path 66 | empty = 67 | { root = "" 68 | , directory = [] 69 | , filename = "" 70 | , extension = "" 71 | } 72 | 73 | 74 | {-| Build a [Path](#Path) from a `String`. The `String` should represent a Posix-compatible path. 75 | -} 76 | fromPosixString : String -> Path 77 | fromPosixString = 78 | Gren.Kernel.FilePath.fromPosix 79 | 80 | 81 | {-| String representation of a [Path](#Path) for Posix systems. 82 | -} 83 | toPosixString : Path -> String 84 | toPosixString = 85 | Gren.Kernel.FilePath.toPosix 86 | 87 | 88 | {-| Build a [Path](#Path) from a `String`. The `String` should represent a Windows-compatible path. 89 | -} 90 | fromWin32String : String -> Path 91 | fromWin32String = 92 | Gren.Kernel.FilePath.fromWin32 93 | 94 | 95 | {-| `String` representation of a [Path](#Path) for Windows. 96 | -} 97 | toWin32String : Path -> String 98 | toWin32String = 99 | Gren.Kernel.FilePath.toWin32 100 | 101 | 102 | {-| Return the filename and file extension for a [Path](#Path). 103 | 104 | "/home/me/file.md" 105 | |> fromPosixString 106 | |> filenameWithExtension 107 | -- returns "file.md" 108 | -} 109 | filenameWithExtension : Path -> String 110 | filenameWithExtension path = 111 | if String.isEmpty path.extension then 112 | path.filename 113 | 114 | else 115 | path.filename ++ "." ++ path.extension 116 | 117 | 118 | {-| Return a [Path](#Path) that represents the directory which holds the given [Path](#Path) 119 | 120 | "/home/me/file.md" 121 | |> fromPosixString 122 | |> parentPath 123 | -- returns (Just "/home/me") 124 | -} 125 | parentPath : Path -> Maybe Path 126 | parentPath path = 127 | when Array.popLast path.directory is 128 | Nothing -> 129 | if filenameWithExtension path == "" then 130 | Nothing 131 | 132 | else 133 | Just 134 | { path 135 | | filename = "" 136 | , extension = "" 137 | } 138 | 139 | Just { last, initial } -> 140 | let 141 | { filename, extension } = 142 | when String.split "." last is 143 | [ file, ext ] -> 144 | { filename = file 145 | , extension = ext 146 | } 147 | 148 | _ -> 149 | { filename = last 150 | , extension = "" 151 | } 152 | in 153 | Just 154 | { path 155 | | directory = initial 156 | , filename = filename 157 | , extension = extension 158 | } 159 | 160 | 161 | {-| Join two paths by appending the first [Path](#Path) onto the second. 162 | -} 163 | append : Path -> Path -> Path 164 | append left right = 165 | prepend right left 166 | 167 | 168 | {-| Convenience function. Converts String with [fromPosixString](#fromPosixString) before appending. 169 | -} 170 | appendPosixString : String -> Path -> Path 171 | appendPosixString str path = 172 | prepend path (fromPosixString str) 173 | 174 | 175 | {-| Convenience function. Converts String with [fromWin32String](#fromWin32String) before appending. 176 | -} 177 | appendWin32String : String -> Path -> Path 178 | appendWin32String str path = 179 | prepend path (fromWin32String str) 180 | 181 | 182 | {-| Join two paths by prepending the first [Path](#Path) onto the second. 183 | -} 184 | prepend : Path -> Path -> Path 185 | prepend left right = 186 | { left 187 | | directory = 188 | left.directory 189 | |> Array.pushLast (filenameWithExtension left) 190 | |> Array.append right.directory 191 | |> Array.keepIf (\dir -> dir /= "") 192 | , filename = right.filename 193 | , extension = right.extension 194 | } 195 | 196 | 197 | {-| Convenience function. Converts String with [fromPosixString](#fromPosixString) before prepending. 198 | -} 199 | prependPosixString : String -> Path -> Path 200 | prependPosixString str path = 201 | prepend (fromPosixString str) path 202 | 203 | 204 | {-| Convenience function. Converts String with [fromWin32String](#fromWin32String) before prepending. 205 | -} 206 | prependWin32String : String -> Path -> Path 207 | prependWin32String str path = 208 | prepend (fromWin32String str) path 209 | 210 | 211 | {-| Join all paths in an `Array`. 212 | -} 213 | join : Array Path -> Path 214 | join paths = 215 | when Array.popFirst paths is 216 | Just { first, rest } -> 217 | Array.foldl append first rest 218 | 219 | Nothing -> 220 | empty 221 | -------------------------------------------------------------------------------- /src/Gren/Kernel/ChildProcess.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Gren.Kernel.Scheduler exposing (binding, succeed, fail, rawSpawn) 4 | import Gren.Kernel.Utils exposing (update) 5 | import Dict exposing (foldl) 6 | import ChildProcess exposing (FailedRun, SuccessfulRun) 7 | import Maybe exposing (Just, Nothing) 8 | 9 | */ 10 | 11 | var bufferNs = require("node:buffer"); 12 | var process = require("node:process"); 13 | var stream = require("node:stream"); 14 | 15 | var _ChildProcess_module = function () { 16 | return require("node:child_process"); 17 | }; 18 | 19 | var _ChildProcess_run = function (options) { 20 | return __Scheduler_binding(function (callback) { 21 | var childProcess = _ChildProcess_module(); 22 | 23 | var workingDir = options.__$workingDirectory; 24 | var env = options.__$environmentVariables; 25 | var shell = options.__$shell; 26 | 27 | childProcess.execFile( 28 | options.__$program, 29 | options.__$arguments, 30 | { 31 | encoding: "buffer", 32 | timeout: options.__$runDuration, 33 | cwd: _ChildProcess_handleCwd(workingDir), 34 | env: _ChildProcess_handleEnv(env), 35 | timeout: options.__$runDuration, 36 | maxBuffer: options.__$maximumBytesWrittenToStreams, 37 | shell: _ChildProcess_handleShell(shell), 38 | }, 39 | function (err, stdout, stderr) { 40 | if (err == null) { 41 | callback( 42 | __Scheduler_succeed({ 43 | __$stdout: new DataView( 44 | stdout.buffer, 45 | stdout.byteOffset, 46 | stdout.byteLength, 47 | ), 48 | __$stderr: new DataView( 49 | stderr.buffer, 50 | stderr.byteOffset, 51 | stderr.byteLength, 52 | ), 53 | }), 54 | ); 55 | } else { 56 | callback( 57 | __Scheduler_fail({ 58 | __$exitCode: 59 | typeof err.errno === "undefined" ? err.code : err.errno, 60 | __$stdout: new DataView( 61 | stdout.buffer, 62 | stdout.byteOffset, 63 | stdout.byteLength, 64 | ), 65 | __$stderr: new DataView( 66 | stderr.buffer, 67 | stderr.byteOffset, 68 | stderr.byteLength, 69 | ), 70 | }), 71 | ); 72 | } 73 | }, 74 | ); 75 | }); 76 | }; 77 | 78 | var _ChildProcess_spawn = F3(function (sendInitToApp, sendExitToApp, options) { 79 | return __Scheduler_binding(function (callback) { 80 | var subproc = _ChildProcess_getSubProc(options); 81 | 82 | __Scheduler_rawSpawn( 83 | sendInitToApp({ 84 | __$processId: __Scheduler_rawSpawn( 85 | __Scheduler_binding(function (callback) { 86 | return function () { 87 | subproc.kill(); 88 | }; 89 | }), 90 | ), 91 | __$streams: 92 | options.__$connection.__$kind !== 1 93 | ? {} 94 | : { 95 | __$input: stream.Writable.toWeb(subproc.stdin), 96 | __$output: stream.Readable.toWeb(subproc.stdout), 97 | __$error: stream.Readable.toWeb(subproc.stderr), 98 | }, 99 | }), 100 | ); 101 | 102 | subproc.on("exit", function (code) { 103 | __Scheduler_rawSpawn(sendExitToApp(code)); 104 | }); 105 | }); 106 | }); 107 | 108 | function _ChildProcess_getSubProc(options) { 109 | var childProcess = _ChildProcess_module(); 110 | 111 | var workingDir = options.__$workingDirectory; 112 | var env = options.__$environmentVariables; 113 | var shell = options.__$shell; 114 | 115 | var subproc = childProcess.spawn(options.__$program, options.__$arguments, { 116 | cwd: _ChildProcess_handleCwd(workingDir), 117 | env: _ChildProcess_handleEnv(env), 118 | timeout: options.__$runDuration, 119 | shell: _ChildProcess_handleShell(shell), 120 | stdio: 121 | options.__$connection.__$kind === 0 122 | ? "inherit" 123 | : options.__$connection.__$kind === 1 124 | ? "pipe" 125 | : "ignore", 126 | detached: 127 | options.__$connection.__$kind === 3 && process.platform === "win32", 128 | }); 129 | 130 | if (options.__$connection.__$kind === 3) { 131 | subproc.unref(); 132 | } 133 | 134 | return subproc; 135 | } 136 | 137 | function _ChildProcess_handleCwd(cwd) { 138 | return cwd.__$inherit ? process.cwd() : cwd.__$override; 139 | } 140 | 141 | function _ChildProcess_handleEnv(env) { 142 | return env.__$option === 0 143 | ? process.env 144 | : env.__$option === 1 145 | ? __Utils_update(process.env, _ChildProcess_dictToObj(env.__$value)) 146 | : _ChildProcess_dictToObj(env.__$value); 147 | } 148 | 149 | function _ChildProcess_handleShell(shell) { 150 | return shell.__$choice === 0 151 | ? false 152 | : shell.__$choice === 1 153 | ? true 154 | : shell.__$value; 155 | } 156 | 157 | function _ChildProcess_dictToObj(dict) { 158 | return A3( 159 | __Dict_foldl, 160 | F3(function (key, value, acc) { 161 | acc[key] = value; 162 | return acc; 163 | }), 164 | {}, 165 | dict, 166 | ); 167 | } 168 | -------------------------------------------------------------------------------- /src/Gren/Kernel/FilePath.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | */ 4 | 5 | var path = require("node:path"); 6 | var process = require("node:process"); 7 | 8 | var _FilePath_fromPosix = function (str) { 9 | return _FilePath_parse(path.posix, str); 10 | }; 11 | 12 | var _FilePath_fromWin32 = function (str) { 13 | return _FilePath_parse(path.win32, str); 14 | }; 15 | 16 | var _FilePath_fromString = function (str) { 17 | return _FilePath_parse(path, str); 18 | }; 19 | 20 | var _FilePath_parse = function (pathMod, str) { 21 | const result = pathMod.parse(pathMod.normalize(str)); 22 | 23 | const root = result.root; 24 | 25 | let dirStr = result.dir.startsWith(root) 26 | ? result.dir.substring(root.length) 27 | : result.dir; 28 | 29 | if (str.startsWith(`.${path.sep}`)) { 30 | dirStr = `.${path.sep}` + dirStr; 31 | } 32 | 33 | const filename = 34 | result.name === "." && result.ext.length === 0 ? "" : result.name; 35 | 36 | return { 37 | __$directory: 38 | dirStr === "" 39 | ? [] 40 | : dirStr.split(pathMod.sep).filter((dir) => dir.length > 0), 41 | __$extension: result.ext.length > 0 ? result.ext.substring(1) : "", 42 | __$filename: filename, 43 | __$root: result.root, 44 | }; 45 | }; 46 | 47 | var _FilePath_toPosix = function (filePath) { 48 | if (_FilePath_isEmpty(filePath)) { 49 | return "."; 50 | } 51 | 52 | if (filePath.__$root !== "" && filePath.__$root !== "/") { 53 | filePath = { ...filePath, __$root: "/" }; 54 | } 55 | 56 | return _FilePath_format(path.posix, filePath); 57 | }; 58 | 59 | var _FilePath_toWin32 = function (filePath) { 60 | if (_FilePath_isEmpty(filePath)) { 61 | return "."; 62 | } 63 | 64 | return _FilePath_format(path.win32, filePath); 65 | }; 66 | 67 | var _FilePath_toString = function (filePath) { 68 | if (process.platform.toLowerCase() === "win32") { 69 | return _FilePath_toWin32(filePath); 70 | } 71 | 72 | return _FilePath_toPosix(filePath); 73 | }; 74 | 75 | var _FilePath_isEmpty = function (filePath) { 76 | return ( 77 | filePath.__$root === "" && 78 | filePath.__$directory.length === 0 && 79 | filePath.__$filename === "" && 80 | filePath.__$extension === "" 81 | ); 82 | }; 83 | 84 | var _FilePath_format = function (pathMod, filePath) { 85 | const filename = 86 | filePath.__$extension.length > 0 87 | ? filePath.__$filename + "." + filePath.__$extension 88 | : filePath.__$filename; 89 | 90 | let pathArray = null; 91 | if (filename === "") { 92 | pathArray = filePath.__$directory; 93 | } else { 94 | pathArray = filePath.__$directory.concat(filename); 95 | } 96 | 97 | return filePath.__$root + pathArray.join(pathMod.sep); 98 | }; 99 | -------------------------------------------------------------------------------- /src/Gren/Kernel/FileSystem.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Gren.Kernel.Scheduler exposing (binding, succeed, fail, rawSpawn) 4 | import Gren.Kernel.FilePath exposing (toString, fromString) 5 | import FileSystem exposing (Error, File, Directory, Socket, Symlink, Device, Pipe, Read, Write, Execute, Changed, Moved) 6 | import Maybe exposing (Just, Nothing) 7 | import Time exposing (millisToPosix) 8 | 9 | */ 10 | 11 | var fs = require("node:fs"); 12 | var bufferNs = require("node:buffer"); 13 | var process = require("node:process"); 14 | var path = require("node:path"); 15 | var os = require("node:os"); 16 | var stream = require("node:stream"); 17 | 18 | var _FileSystem_coerce = function (fh) { 19 | return fh; 20 | }; 21 | 22 | var _FileSystem_open = F2(function (access, path) { 23 | return __Scheduler_binding(function (callback) { 24 | fs.open(__FilePath_toString(path), access, function (err, fd) { 25 | if (err != null) { 26 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 27 | } else { 28 | callback(__Scheduler_succeed({ __$path: path, __$fd: fd })); 29 | } 30 | }); 31 | }); 32 | }); 33 | 34 | var _FileSystem_constructError = function (path, err) { 35 | return __FileSystem_Error({ 36 | __$path: path, 37 | __$code: err.code || "", 38 | __$message: err.message || "", 39 | }); 40 | }; 41 | 42 | var _FileSystem_close = function (fh) { 43 | return __Scheduler_binding(function (callback) { 44 | fs.close(fh.__$fd, function (err) { 45 | if (err != null) { 46 | callback(__Scheduler_fail(_FileSystem_constructError(fh.__$path, err))); 47 | } else { 48 | callback(__Scheduler_succeed({})); 49 | } 50 | }); 51 | }); 52 | }; 53 | 54 | var _FileSystem_readFromOffset = F2(function (fh, options) { 55 | var requestedLength = 56 | options.__$length < 0 || options.__$length > bufferNs.constants.MAX_LENGTH 57 | ? bufferNs.constants.MAX_LENGTH 58 | : options.__$length; 59 | 60 | var fileOffset = options.__$offset < 0 ? 0 : options.__$offset; 61 | 62 | return __Scheduler_binding(function (callback) { 63 | var initialBufferSize = 64 | requestedLength === bufferNs.constants.MAX_LENGTH 65 | ? 16 * 1024 66 | : requestedLength; 67 | var buffer = Buffer.allocUnsafe(initialBufferSize); 68 | 69 | _FileSystem_readHelper( 70 | fh, 71 | buffer, 72 | 0, 73 | fileOffset, 74 | buffer.byteLength, 75 | requestedLength, 76 | callback, 77 | ); 78 | }); 79 | }); 80 | 81 | var _FileSystem_readHelper = function ( 82 | fh, 83 | buffer, 84 | bufferOffset, 85 | fileOffset, 86 | maxReadLength, 87 | requestedReadLength, 88 | callback, 89 | ) { 90 | fs.read( 91 | fh.__$fd, 92 | buffer, 93 | bufferOffset, 94 | maxReadLength, 95 | fileOffset, 96 | function (err, bytesRead, _buff) { 97 | if (err != null) { 98 | callback(__Scheduler_fail(_FileSystem_constructError(fh.__$path, err))); 99 | return; 100 | } 101 | 102 | var newBufferOffset = bufferOffset + bytesRead; 103 | 104 | if (bytesRead === 0 || newBufferOffset >= requestedReadLength) { 105 | callback( 106 | __Scheduler_succeed( 107 | new DataView(buffer.buffer, buffer.byteOffset, newBufferOffset), 108 | ), 109 | ); 110 | return; 111 | } 112 | 113 | var newMaxReadLength = maxReadLength - bytesRead; 114 | if (newMaxReadLength <= 0) { 115 | var oldBuffer = buffer; 116 | buffer = Buffer.allocUnsafe(oldBuffer.byteLength * 1.5); 117 | oldBuffer.copy(buffer); 118 | 119 | newMaxReadLength = buffer.byteLength - oldBuffer.byteLength; 120 | } 121 | 122 | _FileSystem_readHelper( 123 | fh, 124 | buffer, 125 | newBufferOffset, 126 | fileOffset + bytesRead, 127 | newMaxReadLength, 128 | requestedReadLength, 129 | callback, 130 | ); 131 | }, 132 | ); 133 | }; 134 | 135 | var _FileSystem_writeFromOffset = F3(function (fh, options, bytes) { 136 | return __Scheduler_binding(function (callback) { 137 | _FileSystem_writeHelper( 138 | fh, 139 | bytes, 140 | 0, 141 | bytes.byteLength, 142 | options.__$offset, 143 | callback, 144 | ); 145 | }); 146 | }); 147 | 148 | var _FileSystem_writeHelper = function ( 149 | fh, 150 | buffer, 151 | bufferOffset, 152 | length, 153 | fileOffset, 154 | callback, 155 | ) { 156 | fs.write( 157 | fh.__$fd, 158 | buffer, 159 | bufferOffset, 160 | length, 161 | fileOffset, 162 | function (err, bytesWritten, buffer) { 163 | if (err != null) { 164 | callback(__Scheduler_fail(_FileSystem_constructError(fh.__$path, err))); 165 | return; 166 | } 167 | 168 | if (bytesWritten === length) { 169 | callback(__Scheduler_succeed(fh)); 170 | return; 171 | } 172 | 173 | var newBufferOffset = bufferOffset + bytesWritten; 174 | var newFileOffset = fileOffset + bytesWritten; 175 | 176 | _FileSystem_writeHelper( 177 | fh, 178 | buffer, 179 | newBufferOffset, 180 | length - bytesWritten, 181 | newFileOffset, 182 | callback, 183 | ); 184 | }, 185 | ); 186 | }; 187 | 188 | var _FileSystem_remove = F2(function (options, path) { 189 | var rmOpts = { 190 | recursive: options.__$recursive, 191 | }; 192 | 193 | return __Scheduler_binding(function (callback) { 194 | fs.rm(__FilePath_toString(path), rmOpts, function (err) { 195 | if (err != null) { 196 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 197 | } else { 198 | callback(__Scheduler_succeed(path)); 199 | } 200 | }); 201 | }); 202 | }); 203 | 204 | var _FileSystem_makeDirectory = F2(function (options, path) { 205 | return __Scheduler_binding(function (callback) { 206 | fs.mkdir( 207 | __FilePath_toString(path), 208 | { recursive: options.__$recursive }, 209 | function (err) { 210 | if (err != null) { 211 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 212 | } else { 213 | callback(__Scheduler_succeed(path)); 214 | } 215 | }, 216 | ); 217 | }); 218 | }); 219 | 220 | // List of dir contents as DirEntry values holding filename string 221 | var _FileSystem_listDirectory = function (path) { 222 | return __Scheduler_binding(function (callback) { 223 | fs.readdir( 224 | __FilePath_toString(path), 225 | { withFileTypes: true }, 226 | function (err, content) { 227 | if (err != null) { 228 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 229 | } else { 230 | callback( 231 | __Scheduler_succeed( 232 | content.map((f) => ({ 233 | __$path: __FilePath_fromString(f.name), 234 | __$entityType: _FileSystem_toEntityType(f), 235 | })), 236 | ), 237 | ); 238 | } 239 | }, 240 | ); 241 | }); 242 | }; 243 | 244 | var _FileSystem_toEntityType = function (dirEnt) { 245 | if (dirEnt.isFile()) { 246 | return __FileSystem_File; 247 | } else if (dirEnt.isDirectory()) { 248 | return __FileSystem_Directory; 249 | } else if (dirEnt.isFIFO()) { 250 | return __FileSystem_Pipe; 251 | } else if (dirEnt.isSocket()) { 252 | return __FileSystem_Socket; 253 | } else if (dirEnt.isSymbolicLink()) { 254 | return __FileSystem_Symlink; 255 | } else { 256 | return __FileSystem_Device; 257 | } 258 | }; 259 | 260 | var _FileSystem_fchmod = F2(function (mode, fd) { 261 | return __Scheduler_binding(function (callback) { 262 | fs.fchmod(fd.__$fd, mode, function (err) { 263 | if (err) { 264 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 265 | } else { 266 | callback(__Scheduler_succeed(fd)); 267 | } 268 | }); 269 | }); 270 | }); 271 | 272 | var _FileSystem_fchown = F2(function (ids, fd) { 273 | return __Scheduler_binding(function (callback) { 274 | fs.fchown(fd.__$fd, ids.__$userID, ids.__$groupID, function (err) { 275 | if (err) { 276 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 277 | } else { 278 | callback(__Scheduler_succeed(fd)); 279 | } 280 | }); 281 | }); 282 | }); 283 | 284 | var _FileSystem_fdatasync = function (fd) { 285 | return __Scheduler_binding(function (callback) { 286 | fs.fdatasync(fd.__$fd, function (err) { 287 | if (err) { 288 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 289 | } else { 290 | callback(__Scheduler_succeed(fd)); 291 | } 292 | }); 293 | }); 294 | }; 295 | 296 | var _FileSystem_fsync = function (fd) { 297 | return __Scheduler_binding(function (callback) { 298 | fs.fsync(fd.__$fd, function (err) { 299 | if (err) { 300 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 301 | } else { 302 | callback(__Scheduler_succeed(fd)); 303 | } 304 | }); 305 | }); 306 | }; 307 | 308 | var _FileSystem_fstat = function (fd) { 309 | return __Scheduler_binding(function (callback) { 310 | fs.fstat(fd.__$fd, function (err, stats) { 311 | if (err) { 312 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 313 | } else { 314 | callback(__Scheduler_succeed(_FileSystem_statToGrenRecord(stats))); 315 | } 316 | }); 317 | }); 318 | }; 319 | 320 | var _FileSystem_ftruncate = F2(function (len, fd) { 321 | return __Scheduler_binding(function (callback) { 322 | fs.ftruncate(fd.__$fd, len, function (err) { 323 | if (err) { 324 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 325 | } else { 326 | callback(__Scheduler_succeed(fd)); 327 | } 328 | }); 329 | }); 330 | }); 331 | 332 | var _FileSystem_futimes = F3(function (atime, mtime, fd) { 333 | return __Scheduler_binding(function (callback) { 334 | fs.futimes(fd.__$fd, atime, mtime, function (err) { 335 | if (err) { 336 | callback(__Scheduler_fail(_FileSystem_constructError(fd.__$path, err))); 337 | } else { 338 | callback(__Scheduler_succeed(fd)); 339 | } 340 | }); 341 | }); 342 | }); 343 | 344 | var _FileSystem_access = F2(function (permissions, path) { 345 | var mode = fs.constants.F_OK; 346 | 347 | if (permissions.includes(__FileSystem_Read)) { 348 | mode = mode | fs.constants.R_OK; 349 | } 350 | 351 | if (permissions.includes(__FileSystem_Write)) { 352 | mode = mode | fs.constants.W_OK; 353 | } 354 | 355 | if (permissions.includes(__FileSystem_Execute)) { 356 | mode = mode | fs.constants.X_OK; 357 | } 358 | 359 | return __Scheduler_binding(function (callback) { 360 | fs.access(__FilePath_toString(path), mode, function (err) { 361 | if (err != null) { 362 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 363 | } else { 364 | callback(__Scheduler_succeed(path)); 365 | } 366 | }); 367 | }); 368 | }); 369 | 370 | var _FileSystem_appendFile = F2(function (data, path) { 371 | return __Scheduler_binding(function (callback) { 372 | fs.appendFile(__FilePath_toString(path), data, function (err) { 373 | if (err != null) { 374 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 375 | } else { 376 | callback(__Scheduler_succeed(path)); 377 | } 378 | }); 379 | }); 380 | }); 381 | 382 | var _FileSystem_chmod = F2(function (mode, path) { 383 | return __Scheduler_binding(function (callback) { 384 | fs.chmod(__FilePath_toString(path), mode, function (err) { 385 | if (err != null) { 386 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 387 | } else { 388 | callback(__Scheduler_succeed(path)); 389 | } 390 | }); 391 | }); 392 | }); 393 | 394 | var _FileSystem_chown = F2(function (ids, path) { 395 | return __Scheduler_binding(function (callback) { 396 | fs.chown( 397 | __FilePath_toString(path), 398 | ids.__$userID, 399 | ids.__$groupID, 400 | function (err) { 401 | if (err) { 402 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 403 | } else { 404 | callback(__Scheduler_succeed(path)); 405 | } 406 | }, 407 | ); 408 | }); 409 | }); 410 | 411 | var _FileSystem_lchown = F2(function (ids, path) { 412 | return __Scheduler_binding(function (callback) { 413 | fs.lchown( 414 | __FilePath_toString(path), 415 | ids.__$userID, 416 | ids.__$groupID, 417 | function (err) { 418 | if (err) { 419 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 420 | } else { 421 | callback(__Scheduler_succeed(path)); 422 | } 423 | }, 424 | ); 425 | }); 426 | }); 427 | 428 | var _FileSystem_copyFile = F2(function (src, dest) { 429 | return __Scheduler_binding(function (callback) { 430 | fs.copyFile( 431 | __FilePath_toString(src), 432 | __FilePath_toString(dest), 433 | 0, 434 | function (err) { 435 | if (err) { 436 | callback(__Scheduler_fail(_FileSystem_constructError(dest, err))); 437 | } else { 438 | callback(__Scheduler_succeed(dest)); 439 | } 440 | }, 441 | ); 442 | }); 443 | }); 444 | 445 | var _FileSystem_link = F2(function (src, dest) { 446 | return __Scheduler_binding(function (callback) { 447 | fs.link( 448 | __FilePath_toString(src), 449 | __FilePath_toString(dest), 450 | function (err) { 451 | if (err) { 452 | callback(__Scheduler_fail(_FileSystem_constructError(dest, err))); 453 | } else { 454 | callback(__Scheduler_succeed(dest)); 455 | } 456 | }, 457 | ); 458 | }); 459 | }); 460 | 461 | var _FileSystem_symlink = F2(function (src, dest) { 462 | return __Scheduler_binding(function (callback) { 463 | fs.symlink( 464 | __FilePath_toString(src), 465 | __FilePath_toString(dest), 466 | function (err) { 467 | if (err) { 468 | callback(__Scheduler_fail(_FileSystem_constructError(dest, err))); 469 | } else { 470 | callback(__Scheduler_succeed(dest)); 471 | } 472 | }, 473 | ); 474 | }); 475 | }); 476 | 477 | var _FileSystem_unlink = function (src) { 478 | return __Scheduler_binding(function (callback) { 479 | fs.unlink(__FilePath_toString(src), function (err) { 480 | if (err) { 481 | callback(__Scheduler_fail(_FileSystem_constructError(src, err))); 482 | } else { 483 | callback(__Scheduler_succeed(src)); 484 | } 485 | }); 486 | }); 487 | }; 488 | 489 | var _FileSystem_mkdtemp = function (prefix) { 490 | return __Scheduler_binding(function (callback) { 491 | fs.mkdtemp(path.join(os.tmpdir(), prefix), function (err, dir) { 492 | if (err) { 493 | callback( 494 | __Scheduler_fail( 495 | _FileSystem_constructError(__FilePath_fromString(dir), err), 496 | ), 497 | ); 498 | } else { 499 | callback(__Scheduler_succeed(__FilePath_fromString(dir))); 500 | } 501 | }); 502 | }); 503 | }; 504 | 505 | var _FileSystem_readFile = function (path) { 506 | return __Scheduler_binding(function (callback) { 507 | fs.readFile(__FilePath_toString(path), function (err, data) { 508 | if (err) { 509 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 510 | } else { 511 | callback( 512 | __Scheduler_succeed( 513 | new DataView(data.buffer, data.byteOffset, data.byteLength), 514 | ), 515 | ); 516 | } 517 | }); 518 | }); 519 | }; 520 | 521 | var _FileSystem_readFileStream = F2(function (opts, path) { 522 | return __Scheduler_binding(function (callback) { 523 | try { 524 | var fstream = fs.createReadStream(__FilePath_toString(path), { 525 | start: opts.__$start, 526 | end: opts.__$end === -1 ? undefined : opts.__$end, 527 | }); 528 | callback(__Scheduler_succeed(stream.Readable.toWeb(fstream))); 529 | } catch (err) { 530 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 531 | } 532 | }); 533 | }); 534 | 535 | var _FileSystem_readLink = function (path) { 536 | return __Scheduler_binding(function (callback) { 537 | fs.readlink(__FilePath_toString(path), function (err, linkedPath) { 538 | if (err) { 539 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 540 | } else { 541 | callback(__Scheduler_succeed(__FilePath_fromString(linkedPath))); 542 | } 543 | }); 544 | }); 545 | }; 546 | 547 | var _FileSystem_rename = F2(function (oldPath, newPath) { 548 | return __Scheduler_binding(function (callback) { 549 | fs.rename( 550 | __FilePath_toString(oldPath), 551 | __FilePath_toString(newPath), 552 | function (err) { 553 | if (err) { 554 | callback(__Scheduler_fail(_FileSystem_constructError(newPath, err))); 555 | } else { 556 | callback(__Scheduler_succeed(newPath)); 557 | } 558 | }, 559 | ); 560 | }); 561 | }); 562 | 563 | var _FileSystem_realpath = function (path) { 564 | return __Scheduler_binding(function (callback) { 565 | fs.realpath(__FilePath_toString(path), function (err, resolvedPath) { 566 | if (err) { 567 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 568 | } else { 569 | callback(__Scheduler_succeed(__FilePath_fromString(resolvedPath))); 570 | } 571 | }); 572 | }); 573 | }; 574 | 575 | var _FileSystem_stat = function (path) { 576 | return __Scheduler_binding(function (callback) { 577 | fs.stat(__FilePath_toString(path), function (err, stats) { 578 | if (err) { 579 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 580 | } else { 581 | callback(__Scheduler_succeed(_FileSystem_statToGrenRecord(stats))); 582 | } 583 | }); 584 | }); 585 | }; 586 | 587 | var _FileSystem_lstat = function (path) { 588 | return __Scheduler_binding(function (callback) { 589 | fs.lstat(__FilePath_toString(path), function (err, stats) { 590 | if (err) { 591 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 592 | } else { 593 | callback(__Scheduler_succeed(_FileSystem_statToGrenRecord(stats))); 594 | } 595 | }); 596 | }); 597 | }; 598 | 599 | var _FileSystem_statToGrenRecord = function (stats) { 600 | return { 601 | __$entityType: _FileSystem_toEntityType(stats), 602 | __$blockSize: stats.blksize, 603 | __$blocks: stats.blocks, 604 | __$byteSize: stats.size, 605 | __$created: __Time_millisToPosix(Math.floor(stats.birthtimeMs)), 606 | __$deviceID: stats.dev, 607 | __$groupID: stats.gid, 608 | __$lastAccessed: __Time_millisToPosix(Math.floor(stats.atimeMs)), 609 | __$lastChanged: __Time_millisToPosix(Math.floor(stats.ctimeMs)), 610 | __$lastModified: __Time_millisToPosix(Math.floor(stats.mtimeMs)), 611 | __$userID: stats.uid, 612 | }; 613 | }; 614 | 615 | var _FileSystem_truncate = F2(function (len, path) { 616 | return __Scheduler_binding(function (callback) { 617 | fs.truncate(__FilePath_toString(path), len, function (err) { 618 | if (err) { 619 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 620 | } else { 621 | callback(__Scheduler_succeed(path)); 622 | } 623 | }); 624 | }); 625 | }); 626 | 627 | var _FileSystem_utimes = F3(function (atime, mtime, path) { 628 | return __Scheduler_binding(function (callback) { 629 | fs.utimes(__FilePath_toString(path), atime, mtime, function (err) { 630 | if (err) { 631 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 632 | } else { 633 | callback(__Scheduler_succeed(path)); 634 | } 635 | }); 636 | }); 637 | }); 638 | 639 | var _FileSystem_lutimes = F3(function (atime, mtime, path) { 640 | return __Scheduler_binding(function (callback) { 641 | fs.lutimes(__FilePath_toString(path), atime, mtime, function (err) { 642 | if (err) { 643 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 644 | } else { 645 | callback(__Scheduler_succeed(path)); 646 | } 647 | }); 648 | }); 649 | }); 650 | 651 | var _FileSystem_writeFile = F2(function (data, path) { 652 | return __Scheduler_binding(function (callback) { 653 | fs.writeFile(__FilePath_toString(path), data, function (err) { 654 | if (err) { 655 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 656 | } else { 657 | callback(__Scheduler_succeed(path)); 658 | } 659 | }); 660 | }); 661 | }); 662 | 663 | var _FileSystem_writeFileStream = F2(function (pos, path) { 664 | return __Scheduler_binding(function (callback) { 665 | try { 666 | var fstream = fs.createWriteStream(__FilePath_toString(path), { 667 | flags: pos === 0 ? "w" : pos === -1 ? "a" : "r+", 668 | start: pos === 0 ? undefined : pos, 669 | }); 670 | callback(__Scheduler_succeed(stream.Writable.toWeb(fstream))); 671 | } catch (err) { 672 | callback(__Scheduler_fail(_FileSystem_constructError(path, err))); 673 | } 674 | }); 675 | }); 676 | 677 | var _FileSystem_watch = F3(function (path, isRecursive, sendToSelf) { 678 | return __Scheduler_binding(function (_callback) { 679 | var watcher = null; 680 | 681 | try { 682 | watcher = fs.watch( 683 | path, 684 | { recursive: isRecursive }, 685 | function (eventType, filename) { 686 | var maybePath = filename 687 | ? __Maybe_Just(__FilePath_fromString(filename)) 688 | : __Maybe_Nothing; 689 | 690 | if (eventType === "rename") { 691 | __Scheduler_rawSpawn(sendToSelf(__FileSystem_Moved(maybePath))); 692 | } else if (eventType === "change") { 693 | __Scheduler_rawSpawn(sendToSelf(__FileSystem_Changed(maybePath))); 694 | } 695 | 696 | // other change types are ignored 697 | }, 698 | ); 699 | } catch (e) { 700 | // ignore errors 701 | } 702 | 703 | return function () { 704 | if (watcher) { 705 | watcher.close(); 706 | } 707 | }; 708 | }); 709 | }); 710 | var _FileSystem_homeDir = __Scheduler_binding(function (callback) { 711 | callback(__Scheduler_succeed(__FilePath_fromString(os.homedir()))); 712 | }); 713 | 714 | var _FileSystem_currentWorkingDirectory = __Scheduler_binding( 715 | function (callback) { 716 | callback(__Scheduler_succeed(__FilePath_fromString(process.cwd()))); 717 | }, 718 | ); 719 | 720 | var _FileSystem_tmpDir = __Scheduler_binding(function (callback) { 721 | callback(__Scheduler_succeed(__FilePath_fromString(os.tmpdir()))); 722 | }); 723 | 724 | var _FileSystem_devNull = __Scheduler_binding(function (callback) { 725 | callback(__Scheduler_succeed(__FilePath_fromString(os.devNull))); 726 | }); 727 | -------------------------------------------------------------------------------- /src/Gren/Kernel/HttpClient.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Gren.Kernel.Scheduler exposing (binding, succeed, fail, rawSpawn) 4 | import HttpClient exposing (BadUrl, Timeout, BadStatus, BadHeaders, UnexpectedResponseBody, UnknownError, SentChunk, ReceivedChunk, Error, Aborted, Done) 5 | import Json.Decode as Decode exposing (decodeString, errorToString) 6 | import Result exposing (isOk) 7 | import Maybe exposing (isJust) 8 | import Dict exposing (empty, set, foldl) 9 | import Platform exposing (sendToApp) 10 | 11 | */ 12 | 13 | var buffer = require("node:buffer").Buffer; 14 | 15 | function _HttpClient_clientForProtocol(config) { 16 | if (config.__$url.startsWith("http://")) { 17 | return require("node:http"); 18 | } 19 | 20 | return require("node:https"); 21 | } 22 | 23 | var _HttpClient_request = function (config) { 24 | return __Scheduler_binding(function (callback) { 25 | let req = null; 26 | try { 27 | const client = _HttpClient_clientForProtocol(config); 28 | req = client.request(config.__$url, { 29 | method: config.__$method, 30 | headers: A3( 31 | __Dict_foldl, 32 | _HttpClient_dictToObject, 33 | {}, 34 | config.__$headers, 35 | ), 36 | timeout: config.__$timeout, 37 | }); 38 | } catch (e) { 39 | if (e.code === "ERR_INVALID_HTTP_TOKEN") { 40 | return callback(__Scheduler_fail(__HttpClient_BadHeaders)); 41 | } else if (e.code === "ERR_INVALID_URL") { 42 | return callback(__Scheduler_fail(__HttpClient_BadUrl(config.__$url))); 43 | } else { 44 | return callback( 45 | __Scheduler_fail( 46 | __HttpClient_UnknownError("problem with request: " + e.message), 47 | ), 48 | ); 49 | } 50 | } 51 | 52 | req.on("timeout", () => { 53 | req.destroy(_HttpClient_CustomTimeoutError); 54 | }); 55 | 56 | req.on("error", (e) => { 57 | if (e === _HttpClient_CustomTimeoutError) { 58 | return callback(__Scheduler_fail(__HttpClient_Timeout)); 59 | } 60 | 61 | return callback( 62 | __Scheduler_fail( 63 | __HttpClient_UnknownError("problem with request: " + e.message), 64 | ), 65 | ); 66 | }); 67 | 68 | req.on("response", (res) => { 69 | const expectType = config.__$expectType; 70 | const expectString = expectType === "STRING" || expectType === "JSON"; 71 | 72 | if (expectString) { 73 | res.setEncoding("utf8"); 74 | } 75 | 76 | let rawData = []; 77 | 78 | res.on("data", (chunk) => { 79 | rawData.push(chunk); 80 | }); 81 | 82 | res.on("error", (e) => { 83 | return callback( 84 | __Scheduler_fail( 85 | __HttpClient_UnknownError("problem with request: " + e.message), 86 | ), 87 | ); 88 | }); 89 | 90 | res.on("end", () => { 91 | if (res.statusCode < 200 || res.statusCode >= 300) { 92 | const finalBuffer = expectString 93 | ? buffer.from(rawData.join("")) 94 | : buffer.concat(rawData); 95 | 96 | return callback( 97 | __Scheduler_fail( 98 | __HttpClient_BadStatus( 99 | _HttpClient_formatResponse( 100 | res, 101 | new DataView( 102 | finalBuffer.buffer, 103 | finalBuffer.byteOffset, 104 | finalBuffer.byteLength, 105 | ), 106 | ), 107 | ), 108 | ), 109 | ); 110 | } 111 | 112 | switch (expectType) { 113 | case "NOTHING": 114 | if (rawData.length === 0) { 115 | return callback( 116 | __Scheduler_succeed(_HttpClient_formatResponse(res, {})), 117 | ); 118 | } else { 119 | return callback( 120 | __Scheduler_fail( 121 | __HttpClient_UnexpectedResponseBody( 122 | "Received response body where I expected none.", 123 | ), 124 | ), 125 | ); 126 | } 127 | 128 | case "ANYTHING": 129 | return callback( 130 | __Scheduler_succeed(_HttpClient_formatResponse(res, {})), 131 | ); 132 | 133 | case "STRING": 134 | return callback( 135 | __Scheduler_succeed( 136 | _HttpClient_formatResponse(res, rawData.join("")), 137 | ), 138 | ); 139 | 140 | case "JSON": 141 | const jsonResult = A2( 142 | __Decode_decodeString, 143 | config.__$expect.a, 144 | rawData.join(""), 145 | ); 146 | if (__Result_isOk(jsonResult)) { 147 | return callback( 148 | __Scheduler_succeed( 149 | _HttpClient_formatResponse(res, jsonResult.a), 150 | ), 151 | ); 152 | } else { 153 | return callback( 154 | __Scheduler_fail( 155 | __HttpClient_UnexpectedResponseBody( 156 | __Decode_errorToString(jsonResult.a), 157 | ), 158 | ), 159 | ); 160 | } 161 | 162 | case "BYTES": 163 | const finalBuffer = buffer.concat(rawData); 164 | 165 | return callback( 166 | __Scheduler_succeed( 167 | _HttpClient_formatResponse( 168 | res, 169 | new DataView( 170 | finalBuffer.buffer, 171 | finalBuffer.byteOffset, 172 | finalBuffer.byteLength, 173 | ), 174 | ), 175 | ), 176 | ); 177 | } 178 | }); 179 | }); 180 | 181 | const body = _HttpClient_extractRequestBody(config); 182 | 183 | if (body != null) { 184 | req.end(body); 185 | } else { 186 | req.end(); 187 | } 188 | }); 189 | }; 190 | 191 | var _HttpClient_stream = F4(function (cleanup, sendToApp, request, config) { 192 | return __Scheduler_binding(function (callback) { 193 | function send(msg) { 194 | return __Scheduler_rawSpawn(sendToApp(msg)); 195 | } 196 | 197 | let req = null; 198 | try { 199 | const client = _HttpClient_clientForProtocol(config); 200 | req = client.request(config.__$url, { 201 | method: config.__$method, 202 | headers: A3( 203 | __Dict_foldl, 204 | _HttpClient_dictToObject, 205 | {}, 206 | config.__$headers, 207 | ), 208 | timeout: config.__$timeout, 209 | }); 210 | } catch (e) { 211 | callback(__Scheduler_succeed(request)); 212 | 213 | if (e.code === "ERR_INVALID_HTTP_TOKEN") { 214 | send(__HttpClient_Error(__HttpClient_BadHeaders)); 215 | } else if (e.code === "ERR_INVALID_URL") { 216 | send(__HttpClient_Error(__HttpClient_BadUrl(config.__$url))); 217 | } else { 218 | send( 219 | __HttpClient_Error( 220 | __HttpClient_UnknownError("problem with request: " + e.message), 221 | ), 222 | ); 223 | } 224 | 225 | return __Scheduler_rawSpawn(cleanup(request)); 226 | } 227 | 228 | req.on("timeout", () => { 229 | req.destroy(_HttpClient_CustomTimeoutError); 230 | }); 231 | 232 | req.on("error", (e) => { 233 | __Scheduler_rawSpawn(cleanup(request)); 234 | 235 | if (e === _HttpClient_CustomTimeoutError) { 236 | send(__HttpClient_Timeout); 237 | } else if (e === _HttpClient_CustomAbortError) { 238 | send(__HttpClient_Aborted); 239 | } else { 240 | send(__HttpClient_UnknownError("problem with request: " + e.message)); 241 | } 242 | }); 243 | 244 | const body = _HttpClient_extractRequestBody(config); 245 | 246 | if (body == null) { 247 | send(__HttpClient_SentChunk(request)); 248 | } else { 249 | req.write(body, () => { 250 | send(__HttpClient_SentChunk(request)); 251 | }); 252 | } 253 | 254 | return callback( 255 | __Scheduler_succeed({ 256 | __$request: req, 257 | __$response: null, 258 | }), 259 | ); 260 | }); 261 | }); 262 | 263 | var _HttpClient_sendChunk = F4( 264 | function (sendToApp, kernelRequest, request, bytes) { 265 | return __Scheduler_binding(function (callback) { 266 | if (!kernelRequest.__$request.writableEnded) { 267 | const chunk = _HttpClient_prepBytes(bytes); 268 | 269 | kernelRequest.__$request.write(chunk, () => { 270 | __Scheduler_rawSpawn(sendToApp(__HttpClient_SentChunk(request))); 271 | }); 272 | } 273 | 274 | return callback(__Scheduler_succeed({})); 275 | }); 276 | }, 277 | ); 278 | 279 | var _HttpClient_startReceive = F4( 280 | function (cleanup, sendToApp, kernelRequest, request) { 281 | return __Scheduler_binding(function (callback) { 282 | if (kernelRequest.__$request.writableEnded) { 283 | return callback(__Scheduler_succeed({})); 284 | } 285 | kernelRequest.__$request.on("response", (res) => { 286 | kernelRequest.__$response = res; 287 | 288 | res.on("data", (bytes) => { 289 | return __Scheduler_rawSpawn( 290 | sendToApp( 291 | __HttpClient_ReceivedChunk({ 292 | __$request: request, 293 | __$response: _HttpClient_formatResponse( 294 | res, 295 | new DataView( 296 | bytes.buffer, 297 | bytes.byteOffset, 298 | bytes.byteLength, 299 | ), 300 | ), 301 | }), 302 | ), 303 | ); 304 | }); 305 | 306 | res.on("error", (e) => { 307 | __Scheduler_rawSpawn(cleanup(request)); 308 | __Scheduler_rawSpawn( 309 | sendToApp( 310 | __HttpClient_Error( 311 | __HttpClient_UnknownError("problem with request: " + e.message), 312 | ), 313 | ), 314 | ); 315 | }); 316 | 317 | res.on("end", () => { 318 | __Scheduler_rawSpawn(cleanup(request)); 319 | __Scheduler_rawSpawn(sendToApp(__HttpClient_Done)); 320 | }); 321 | }); 322 | 323 | kernelRequest.__$request.end(() => { 324 | return callback(__Scheduler_succeed({})); 325 | }); 326 | }); 327 | }, 328 | ); 329 | 330 | var _HttpClient_abort = function (kernelRequest) { 331 | return __Scheduler_binding(function (callback) { 332 | if (!kernelRequest.__$request.writableEnded) { 333 | kernelRequest.__$request.destroy(_HttpClient_CustomAbortError); 334 | } else if ( 335 | kernelRequest.__$response && 336 | kernelRequest.__$response.complete === false 337 | ) { 338 | kernelRequest.__$response.destroy(_HttpClient_CustomAbortError); 339 | } 340 | 341 | return callback(__Scheduler_succeed({})); 342 | }); 343 | }; 344 | 345 | // HELPERS 346 | 347 | var _HttpClient_dictToObject = F3(function (key, value, obj) { 348 | obj[key] = value; 349 | return obj; 350 | }); 351 | 352 | var _HttpClient_extractRequestBody = function (config) { 353 | switch (config.__$bodyType) { 354 | case "EMPTY": 355 | return null; 356 | case "STRING": 357 | return config.__$body.a; 358 | case "BYTES": 359 | return _HttpClient_prepBytes(config.__$body.a); 360 | } 361 | }; 362 | 363 | var _HttpClient_prepBytes = function (bytes) { 364 | return new Uint8Array(bytes.buffer); 365 | }; 366 | 367 | var _HttpClient_CustomAbortError = new Error(); 368 | 369 | var _HttpClient_CustomTimeoutError = new Error(); 370 | 371 | var _HttpClient_formatResponse = function (res, data) { 372 | let headerDict = __Dict_empty; 373 | for (const [key, value] of Object.entries(res.headersDistinct)) { 374 | headerDict = A3(__Dict_set, key.toLowerCase(), value, headerDict); 375 | } 376 | 377 | return { 378 | __$statusCode: res.statusCode, 379 | __$statusText: res.statusMessage, 380 | __$headers: headerDict, 381 | __$data: data, 382 | }; 383 | }; 384 | -------------------------------------------------------------------------------- /src/Gren/Kernel/HttpServer.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Gren.Kernel.Scheduler exposing (binding, succeed, fail, rawSpawn) 4 | import HttpServer exposing (ServerError, toRequest) 5 | import HttpServer.Response as Response exposing (toResponse) 6 | import Platform exposing (sendToApp, sendToSelf) 7 | 8 | */ 9 | 10 | var _HttpServer_createServer = F2(function (host, port) { 11 | return __Scheduler_binding(function (callback) { 12 | const server = require("http").createServer(); 13 | server.on("error", function (e) { 14 | callback( 15 | __Scheduler_fail( 16 | __HttpServer_ServerError({ __$code: e.code, __$message: e.message }), 17 | ), 18 | ); 19 | }); 20 | server.listen(port, host, function () { 21 | callback(__Scheduler_succeed(server)); 22 | }); 23 | }); 24 | }); 25 | 26 | var _HttpServer_addListener = F3(function (server, router, msg) { 27 | server.on("request", function (request, response) { 28 | // May want to support non-http protocols, proxies, and X-Forwarded-For header(s). 29 | // Note: the `request` here is a node `http.IncomingMessage`, not a `http.ClientRequest`, 30 | // so we can't just look at `request.protocol`, etc. 31 | let url = new URL(request.url, `http://${request.headers.host}`); 32 | let body = []; 33 | request 34 | .on("data", function (chunk) { 35 | body.push(chunk); 36 | }) 37 | // TODO: Timeouts. 38 | // Currently, if the request never ends (because of an error, or...?) 39 | // the server will hang until manually killed. 40 | .on("end", function () { 41 | const buffer = Buffer.concat(body); 42 | let grenRequest = __HttpServer_toRequest({ 43 | __$url: url.href, 44 | __$headers: request.rawHeaders, 45 | __$method: request.method, 46 | __$body: new DataView( 47 | buffer.buffer, 48 | buffer.byteOffset, 49 | buffer.byteLength, 50 | ), 51 | }); 52 | let grenResponse = __Response_toResponse(response); 53 | __Scheduler_rawSpawn( 54 | // May want to send to self, self sends to app instead. 55 | // But effect handlers may be changing soon, so not bothering yet. 56 | A2(__Platform_sendToApp, router, A2(msg, grenRequest, grenResponse)), 57 | ); 58 | }); 59 | }); 60 | }); 61 | 62 | var _HttpServer_removeAllListeners = function (server) { 63 | server.removeAllListeners("request"); 64 | }; 65 | 66 | var _HttpServer_setStatus = F2(function (status, res) { 67 | res.statusCode = status; 68 | return res; 69 | }); 70 | 71 | var _HttpServer_setHeaders = F2(function (headers, res) { 72 | headers.forEach(function (h) { 73 | res.setHeader(h.__$key, h.__$value); 74 | }); 75 | return res; 76 | }); 77 | 78 | var _HttpServer_setBody = F2(function (body, res) { 79 | res.write(body); 80 | return res; 81 | }); 82 | 83 | var _HttpServer_setBodyAsBytes = F2(function (data, res) { 84 | let body = new Uint8Array(data.buffer, data.byteOffset, data.byteLength); 85 | res.write(body); 86 | return res; 87 | }); 88 | 89 | var _HttpServer_endResponse = function (res) { 90 | res.end(); 91 | return {}; 92 | }; 93 | -------------------------------------------------------------------------------- /src/Gren/Kernel/Node.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Dict exposing (empty, set) 4 | import Gren.Kernel.Platform exposing (export) 5 | import Gren.Kernel.Scheduler exposing (binding, succeed, rawSpawn) 6 | import Gren.Kernel.FilePath exposing (fromString) 7 | 8 | */ 9 | 10 | var stream = require("node:stream"); 11 | var process = require("node:process"); 12 | 13 | var _Node_log = F2(function (text, args) { 14 | // This function is used for simple applications where the main function returns String 15 | // NOTE: this function needs __Platform_export available to work 16 | console.log(text); 17 | return {}; 18 | }); 19 | 20 | var _Node_init = __Scheduler_binding(function (callback) { 21 | if (process.stdin.unref) { 22 | // Don't block program shutdown if this is the only 23 | // stream being listened to 24 | process.stdin.unref(); 25 | } 26 | 27 | const stdinStream = stream.Readable.toWeb(process.stdin); 28 | const stdinProxy = !process.stdin.ref 29 | ? stdinStream 30 | : _Node_makeProxyOfStdin(stdinStream); 31 | 32 | callback( 33 | __Scheduler_succeed({ 34 | __$applicationPath: __FilePath_fromString( 35 | typeof module !== "undefined" ? module.filename : process.execPath, 36 | ), 37 | __$arch: process.arch, 38 | __$args: process.argv, 39 | __$platform: process.platform, 40 | __$stderr: stream.Writable.toWeb(process.stderr), 41 | __$stdin: stdinProxy, 42 | __$stdout: stream.Writable.toWeb(process.stdout), 43 | }), 44 | ); 45 | }); 46 | 47 | function _Node_makeProxyOfStdin(stdinStream) { 48 | return new Proxy(stdinStream, { 49 | get(target, prop, receiver) { 50 | if (prop === "getReader") { 51 | // Make sure to keep program alive if we're waiting for 52 | // user input 53 | process.stdin.ref(); 54 | 55 | const reader = Reflect.get(target, prop, receiver); 56 | return _Node_makeProxyOfReader(reader); 57 | } 58 | 59 | if (prop === "pipeThrough") { 60 | process.stdin.ref(); 61 | } 62 | 63 | return Reflect.get(target, prop, receiver); 64 | }, 65 | }); 66 | } 67 | 68 | function _Node_makeProxyOfReader(reader) { 69 | return new Proxy(reader, { 70 | get(target, prop, receiver) { 71 | if (prop === "releaseLock") { 72 | process.stdin.unref(); 73 | } 74 | 75 | return Reflect.get(target, prop, receiver); 76 | }, 77 | }); 78 | } 79 | 80 | var _Node_getPlatform = __Scheduler_binding(function (callback) { 81 | callback(__Scheduler_succeed(process.platform)); 82 | }); 83 | 84 | var _Node_getCpuArchitecture = __Scheduler_binding(function (callback) { 85 | callback(__Scheduler_succeed(process.arch)); 86 | }); 87 | 88 | var _Node_getEnvironmentVariables = __Scheduler_binding(function (callback) { 89 | callback(__Scheduler_succeed(_Node_objToDict(process.env))); 90 | }); 91 | 92 | var _Node_exitWithCode = function (code) { 93 | return __Scheduler_binding(function (callback) { 94 | process.exit(code); 95 | }); 96 | }; 97 | 98 | var _Node_setExitCode = function (code) { 99 | return __Scheduler_binding(function (callback) { 100 | process.exitCode = code; 101 | callback(__Scheduler_succeed({})); 102 | }); 103 | }; 104 | 105 | // Subs 106 | 107 | var _Node_attachEmptyEventLoopListener = function (selfMsg) { 108 | return __Scheduler_binding(function (_callback) { 109 | var listener = function () { 110 | __Scheduler_rawSpawn(selfMsg); 111 | }; 112 | 113 | process.on("beforeExit", listener); 114 | 115 | return function () { 116 | process.off("beforeExit", listener); 117 | }; 118 | }); 119 | }; 120 | 121 | var _Node_attachSignalInterruptListener = function (selfMsg) { 122 | return __Scheduler_binding(function (_callback) { 123 | var listener = function () { 124 | __Scheduler_rawSpawn(selfMsg); 125 | }; 126 | 127 | process.on("SIGINT", listener); 128 | 129 | return function () { 130 | process.off("SIGINT", listener); 131 | }; 132 | }); 133 | }; 134 | 135 | var _Node_attachSignalTerminateListener = function (selfMsg) { 136 | return __Scheduler_binding(function (_callback) { 137 | var listener = function () { 138 | __Scheduler_rawSpawn(selfMsg); 139 | }; 140 | 141 | process.on("SIGTERM", listener); 142 | 143 | return function () { 144 | process.off("SIGTERM", listener); 145 | }; 146 | }); 147 | }; 148 | 149 | // Helpers 150 | 151 | function _Node_objToDict(obj) { 152 | var dict = __Dict_empty; 153 | 154 | for (var key in obj) { 155 | dict = A3(__Dict_set, key, obj[key], dict); 156 | } 157 | 158 | return dict; 159 | } 160 | -------------------------------------------------------------------------------- /src/Gren/Kernel/Terminal.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Gren.Kernel.Scheduler exposing (binding, succeed, rawSpawn) 4 | 5 | */ 6 | 7 | var process = require("node:process"); 8 | 9 | var _Terminal_init = __Scheduler_binding(function (callback) { 10 | callback( 11 | __Scheduler_succeed({ 12 | __$isTTY: process.stdout.isTTY, 13 | __$colorDepth: process.stdout.getColorDepth 14 | ? process.stdout.getColorDepth() 15 | : 0, 16 | __$columns: process.stdout.columns, 17 | __$rows: process.stdout.rows, 18 | }), 19 | ); 20 | }); 21 | 22 | var _Terminal_attachListener = function (sendToApp) { 23 | return __Scheduler_binding(function (_callback) { 24 | var listener = function (data) { 25 | __Scheduler_rawSpawn( 26 | sendToApp({ 27 | __$columns: process.stdout.columns, 28 | __$rows: process.stdout.rows, 29 | }), 30 | ); 31 | }; 32 | 33 | process.stdout.on("resize", listener); 34 | 35 | return function () { 36 | process.stdout.off("resize", listener); 37 | process.stdout.pause(); 38 | }; 39 | }); 40 | }; 41 | 42 | var _Terminal_setStdInRawMode = function (toggle) { 43 | return __Scheduler_binding(function (callback) { 44 | process.stdin.setRawMode(toggle); 45 | callback(__Scheduler_succeed({})); 46 | }); 47 | }; 48 | 49 | var _Terminal_setProcessTitle = function (title) { 50 | return __Scheduler_binding(function (callback) { 51 | process.title = title; 52 | callback(__Scheduler_succeed({})); 53 | }); 54 | }; 55 | -------------------------------------------------------------------------------- /src/HttpClient.gren: -------------------------------------------------------------------------------- 1 | effect module HttpClient where { command = MyCmd } exposing 2 | ( Permission 3 | , initialize, initializeForHost 4 | , RequestConfiguration, get, post, request 5 | , defaultTimeout, withTimeout 6 | , withHeader, withDuplicatedHeader 7 | , Body, withEmptyBody, withStringBody, withJsonBody, withBytesBody 8 | , Expect, expectAnything, expectNothing, expectString, expectJson, expectBytes 9 | , send 10 | , Response 11 | , Error(..), errorToString 12 | , StreamRequest, StreamEvent(..), stream, sendChunk, startReceive, abort 13 | ) 14 | 15 | 16 | {-| 17 | 18 | A module for communicating over HTTP. 19 | 20 | You start by building a [RequestConfiguration](#RequestConfiguration) type, which represents the request you'll make to a server. Once done, 21 | you can either do a `send`, which represents the response as a `Task`, or `stream` which will allow you to perform 22 | actions while the request is sending and while the response is coming in. A typical example of why you'd use `stream` 23 | is to show a progress bar to the user, or decode the response incrementally as opposed to all at once. 24 | 25 | ## Initialization 26 | 27 | Code that wishes to perform HTTP requests require a permission to do so. 28 | 29 | @docs Permission, initialize, initializeForHost 30 | 31 | ## Request configuration 32 | 33 | In order to send something over HTTP, you first need a description of how that request will look like. 34 | 35 | @docs RequestConfiguration, get, post, request 36 | 37 | ## Timeouts 38 | 39 | A timeout represents how long you're willing to wait before giving up on receiving 40 | a response from the server. Servers might not respond for any number of reasons, like bugs or huge amounts of traffic, 41 | so it is a good idea to return an error to the user instead of waiting "forever" for a response. 42 | 43 | @docs defaultTimeout, withTimeout 44 | 45 | ## Headers 46 | 47 | Every HTTP request can have arbitrary metadata attached, called headers. Headers allow you to attach things like 48 | authorization information, how the body is encoded or the name of the client making the request. 49 | 50 | It might be interesting to read this [list of HTTP header fields](https://en.wikipedia.org/wiki/List_of_HTTP_header_fields). 51 | 52 | @docs withHeader, withDuplicatedHeader 53 | 54 | ## Request body 55 | 56 | The request body is the actual data that you wish to send to a server. 57 | 58 | @docs Body, withEmptyBody, withStringBody, withJsonBody, withBytesBody 59 | 60 | ## Expected response body 61 | 62 | Once a request has been sent, you usually get a response. The `Expect` type represents 63 | what we expect the response body to be. 64 | 65 | @docs Expect, expectAnything, expectNothing, expectString, expectJson, expectBytes 66 | 67 | ## Send 68 | 69 | Once your `Response` is configured, you'll want to actually send the request. 70 | 71 | @docs send 72 | 73 | @docs Response 74 | 75 | ## Errors 76 | 77 | @docs Error, errorToString 78 | 79 | ## Streaming 80 | 81 | Streaming is the more advanced way to perform a HTTP request. This requires that you follow the Elm 82 | architecture, as you'll receive messages for every chunk of data sent and received. The benefit of this 83 | extra complexity, is that you can perform actions while the request is being performed. 84 | 85 | @docs StreamRequest, StreamEvent, stream, sendChunk, startReceive, abort 86 | 87 | -} 88 | 89 | 90 | import Dict exposing (Dict) 91 | import Init 92 | import Internal.Init 93 | import Json.Encode as Json 94 | import Json.Decode 95 | import Bytes exposing (Bytes) 96 | import Task exposing (Task) 97 | import Platform 98 | import Gren.Kernel.HttpClient 99 | import HttpServer exposing (Method(..), methodToString) 100 | 101 | 102 | {-| A value that represents the permission to perform HTTP requests. 103 | 104 | Only code you trust should be granted permission. 105 | -} 106 | type Permission 107 | = AnyPermission 108 | | SpecificPermission String 109 | 110 | 111 | {-| Call this during application initialization to get the permission to perform any kind of HTTP request. 112 | -} 113 | initialize : Init.Task Permission 114 | initialize = 115 | Task.succeed AnyPermission 116 | |> Internal.Init.Task 117 | 118 | 119 | {-| Call during application initialization to get a host-specific permission. Code that has this permission value, will only 120 | be able to contact a specific host. 121 | -} 122 | initializeForHost : String -> Init.Task Permission 123 | initializeForHost host = 124 | Task.succeed (SpecificPermission host) 125 | |> Internal.Init.Task 126 | 127 | 128 | -- REQUEST CONFIGURATION 129 | 130 | 131 | {-| Describes the request to be made. Use [get](#get), [post](#post) or [request](#request) to initialize 132 | this value, then customize it using the following `with` functions. 133 | -} 134 | type alias RequestConfiguration responseType = 135 | { method : Method 136 | , url : String 137 | , headers : Dict String (Array String) 138 | , body : Body 139 | , expect : Expect responseType 140 | , timeout : Int 141 | } 142 | 143 | 144 | {-| Initializes the configuration for a simple GET request to the given url. 145 | -} 146 | get : String -> RequestConfiguration {} 147 | get url = 148 | request GET url 149 | 150 | 151 | {-| Initializes the configuration for a simple POST request to the given url. 152 | -} 153 | post : String -> RequestConfiguration {} 154 | post url = 155 | request POST url 156 | 157 | 158 | {-| Initializes a request configuration with the given method and url. 159 | -} 160 | request : Method -> String -> RequestConfiguration {} 161 | request method url = 162 | { method = method 163 | , url = url 164 | , headers = Dict.empty 165 | , body = BodyEmpty 166 | , expect = ExpectAnything 167 | , timeout = defaultTimeout 168 | } 169 | 170 | 171 | {-| This is the default timeout value. It is set to 10 seconds. 172 | If you don't use [withTimeout](#withTimeout) to set a timeout specifically, 173 | this value will be used. 174 | -} 175 | defaultTimeout : Int 176 | defaultTimeout = 177 | -- 10 seconds 178 | 10 * 1000 179 | 180 | 181 | {-| Lets you specify a timeout, in milliseconds, for a request. 182 | If the server doesn't respond to your request within the given timeout, the request 183 | will fail with a Timeout [Error](#Error). 184 | -} 185 | withTimeout : Int -> RequestConfiguration a -> RequestConfiguration a 186 | withTimeout ms req = 187 | if ms < 0 then 188 | req 189 | 190 | else 191 | { req | timeout = ms } 192 | 193 | 194 | {-| A header is a key-value pair of strings that says something about the request. 195 | Examples include the length of the body, authentication information, name of the client making the request, etc. 196 | -} 197 | withHeader : String -> String -> RequestConfiguration a -> RequestConfiguration a 198 | withHeader key value req = 199 | { req 200 | | headers = Dict.set (String.toLower key) [value] req.headers 201 | } 202 | 203 | 204 | {-| Header keys doesn't have to be unique. You're allowed to send the same kind of header 205 | multiple times, like sending multiple cookies. The behaviour of [withHeader](#withHeader) will 206 | replace the value of an already set header. This function will not. 207 | -} 208 | withDuplicatedHeader : String -> String -> RequestConfiguration a -> RequestConfiguration a 209 | withDuplicatedHeader key value req = 210 | { req 211 | | headers = Dict.update 212 | (String.toLower key) 213 | (Maybe.map (Array.pushLast value) >> Maybe.withDefault [value] >> Just) 214 | req.headers 215 | } 216 | 217 | 218 | -- BODY 219 | 220 | 221 | {-| The body represents the main data that you will send in the HTTP request. 222 | -} 223 | type Body 224 | = BodyEmpty 225 | | BodyString String 226 | | BodyBytes Bytes 227 | 228 | 229 | bodyTypeAsString : Body -> String 230 | bodyTypeAsString body = 231 | when body is 232 | BodyEmpty -> 233 | "EMPTY" 234 | 235 | BodyString _ -> 236 | "STRING" 237 | 238 | BodyBytes _ -> 239 | "BYTES" 240 | 241 | 242 | {-| Removes the body from the [RequestConfiguration](#RequestConfiguration). 243 | You normally don't have to use this function, as an empty body is the default. 244 | 245 | If the "Content-Type" header is set, this function will remove it. 246 | -} 247 | withEmptyBody : RequestConfiguration a -> RequestConfiguration a 248 | withEmptyBody req = 249 | { req 250 | | headers = Dict.remove "content-type" req.headers 251 | , body = BodyEmpty 252 | } 253 | 254 | 255 | {-| Sets the given string as the request body. You need to provide a mime type to 256 | describe what the string contains. This mime type will be set as the "Content-Type" 257 | header, potentially overwriting the header if it has already been set. 258 | -} 259 | withStringBody : String -> String -> RequestConfiguration a -> RequestConfiguration a 260 | withStringBody mimeType value req = 261 | { req 262 | | headers = Dict.set "content-type" [mimeType] req.headers 263 | , body = BodyString value 264 | } 265 | 266 | 267 | {-| Sets the provided Json value the request body. A "Content-Type" header will be 268 | attached to the request with a value of "application/json", potentially overwriting 269 | the header if it has already been set. 270 | -} 271 | withJsonBody : Json.Value -> RequestConfiguration a -> RequestConfiguration a 272 | withJsonBody value req = 273 | withStringBody "application/json" (Json.encode 0 value) req 274 | 275 | 276 | {-| Sets the provided Bytes value as the request body. You need to provide a mime type to 277 | desribe what the bytes represent. This mime type will be set as the "Content-Type" header, 278 | potentially overwriting the header if it has already been set. 279 | -} 280 | withBytesBody : String -> Bytes -> RequestConfiguration a -> RequestConfiguration a 281 | withBytesBody mimeType value req = 282 | { req 283 | | headers = Dict.set "content-type" [mimeType] req.headers 284 | , body = BodyBytes value 285 | } 286 | 287 | 288 | -- EXPECT 289 | 290 | 291 | {-| This describes what you expect the server will respond with when it receives your request. 292 | -} 293 | type Expect a 294 | = ExpectNothing 295 | | ExpectAnything 296 | | ExpectString 297 | | ExpectJson (Json.Decode.Decoder a) 298 | | ExpectBytes 299 | 300 | 301 | expectTypeAsString : Expect a -> String 302 | expectTypeAsString expect = 303 | when expect is 304 | ExpectNothing -> 305 | "NOTHING" 306 | 307 | ExpectAnything -> 308 | "ANYTHING" 309 | 310 | ExpectString -> 311 | "STRING" 312 | 313 | ExpectJson _ -> 314 | "JSON" 315 | 316 | ExpectBytes -> 317 | "BYTES" 318 | 319 | 320 | {-| Use this when you you don't really care what the server responds with. Anything is fine. 321 | Actually, this is the default value so you probably don't need to use this at all. 322 | -} 323 | expectAnything : RequestConfiguration a -> RequestConfiguration {} 324 | expectAnything req = 325 | -- Need to create a new record for type checking to pass 326 | { method = req.method 327 | , url = req.url 328 | , headers = req.headers 329 | , body = req.body 330 | , expect = ExpectAnything 331 | , timeout = req.timeout 332 | } 333 | 334 | 335 | {-| Expect _exactly_ nothing. Use this when you want a request to fail if the server responds with 336 | anything at all. 337 | -} 338 | expectNothing : RequestConfiguration a -> RequestConfiguration {} 339 | expectNothing req = 340 | { method = req.method 341 | , url = req.url 342 | , headers = req.headers 343 | , body = req.body 344 | , expect = ExpectNothing 345 | , timeout = req.timeout 346 | } 347 | 348 | 349 | {-| Use this when you expect the server to respond with a string. 350 | -} 351 | expectString : RequestConfiguration a -> RequestConfiguration String 352 | expectString req = 353 | { method = req.method 354 | , url = req.url 355 | , headers = req.headers 356 | , body = req.body 357 | , expect = ExpectString 358 | , timeout = req.timeout 359 | } 360 | 361 | 362 | {-| Use this when you expect a Json response. The request will fail if the provided decoder fails. 363 | -} 364 | expectJson : Json.Decode.Decoder a -> RequestConfiguration x -> RequestConfiguration a 365 | expectJson decoder req = 366 | { method = req.method 367 | , url = req.url 368 | , headers = req.headers 369 | , body = req.body 370 | , expect = ExpectJson decoder 371 | , timeout = req.timeout 372 | } 373 | 374 | 375 | {-| Use this when you want to treat the response as bytes. This will likely never fail, as anything 376 | can be interpreted as bytes. 377 | -} 378 | expectBytes : RequestConfiguration a -> RequestConfiguration Bytes 379 | expectBytes req = 380 | { method = req.method 381 | , url = req.url 382 | , headers = req.headers 383 | , body = req.body 384 | , expect = ExpectBytes 385 | , timeout = req.timeout 386 | } 387 | 388 | 389 | -- SIMPLE SEND 390 | 391 | 392 | {-| Send a request. The task will either complete with a successful [Response](#Response), or an [Error](#Error). 393 | -} 394 | send 395 | : Permission 396 | -> RequestConfiguration expectedBody 397 | -> Task Error (Response expectedBody) 398 | send permission config = 399 | Gren.Kernel.HttpClient.request (kernelRequestConfig permission config) 400 | 401 | 402 | type alias KernelRequestConfig a = 403 | { method : String 404 | , url : String 405 | , headers : Dict String (Array String) 406 | , bodyType : String 407 | , body : Body 408 | , expectType : String 409 | , expect : Expect a 410 | , timeout : Int 411 | } 412 | 413 | 414 | kernelRequestConfig : Permission -> RequestConfiguration a -> KernelRequestConfig a 415 | kernelRequestConfig permission config = 416 | let 417 | actualUrl = 418 | when permission is 419 | AnyPermission -> 420 | config.url 421 | 422 | SpecificPermission prefix -> 423 | prefix ++ config.url 424 | in 425 | { method = methodToString config.method 426 | , url = actualUrl 427 | , headers = config.headers 428 | , bodyType = bodyTypeAsString config.body 429 | , body = config.body 430 | , expectType = expectTypeAsString config.expect 431 | , expect = config.expect 432 | , timeout = config.timeout 433 | } 434 | 435 | 436 | -- RESPONSE 437 | 438 | 439 | {-| The response from the server. 440 | 441 | * statusCode: A numerical value that gives an indication of how the request went. 442 | It might be a good idea to read this [list of HTTP status codes](https://en.wikipedia.org/wiki/List_of_HTTP_status_codes). 443 | * statusText: A human readable interpretation of the status code. 444 | * headers: The headers returned by the server. 445 | * data: The data returned by the server. The type depends on the [Expect](#Expect) value you set on the request. 446 | -} 447 | type alias Response data = 448 | { statusCode : Int 449 | , statusText : String 450 | , headers : Dict String (Array String) 451 | , data : data 452 | } 453 | 454 | 455 | -- ERRORS 456 | 457 | 458 | {-| A HTTP request can fail in a number of ways. 459 | 460 | * BadUrl: Something is wrong with the URL you provided. 461 | * BadHeaders: The request headers are invalid. Make sure you only use characters in the latin-1 character set. 462 | * BadStatus: The status code indicates that the response didn't go well. The [Response](#Response) is attached. 463 | * Timeout: The request timed out. The server didn't respond as quickly as you expected it would. 464 | * UnknownError: We don't know what went wrong. You should probably report this if you see it in the wild. 465 | -} 466 | type Error 467 | = BadUrl String 468 | | BadHeaders 469 | | BadStatus (Response Bytes) 470 | | UnexpectedResponseBody String 471 | | Timeout 472 | | UnknownError String 473 | 474 | 475 | {-| Gives a brief description of an error. 476 | -} 477 | errorToString : Error -> String 478 | errorToString err = 479 | when err is 480 | Timeout -> 481 | "Timeout" 482 | 483 | BadUrl url -> 484 | "Bad URL: " ++ url 485 | 486 | BadHeaders -> 487 | "Bad headers: one or more of your headers contains invalid characters." 488 | 489 | BadStatus res -> 490 | "Bad status: " ++ String.fromInt res.statusCode ++ " - " ++ res.statusText 491 | 492 | UnexpectedResponseBody message -> 493 | "Unexpected response body: " ++ message 494 | 495 | UnknownError debugStr -> 496 | "Unknown error: " ++ debugStr 497 | 498 | 499 | -- STREAM 500 | 501 | 502 | {-| Identifies a streaming request. Required to perform certain operations while 503 | the request is streaming. 504 | -} 505 | type StreamRequest = 506 | StreamRequest Int 507 | 508 | 509 | {-| When a request is streaming, the application is notified of important events 510 | and is required to act on those events for the request to be successful. 511 | 512 | * SentChunk: The initial request body, or the last piece of data sent with [sendChunk](#sendChunk) has been sent. 513 | Send more data, or call `startReceive` to begin listening for the response. 514 | * ReceivedChunk: The server has responded with some data. More data might be coming in, though. 515 | The `Done` event will be triggered when there's no more data coming. You can use the provided 516 | `Response` object to access the response headers, and decide if you'd like to [abort](#abort) the 517 | request or not. 518 | * Error: Something went wrong. More information in the provided [Error](#Error) object. 519 | * Aborted: You called [abort](#abort) on this request. 520 | * Done: The server has sent all it's going to send. You're done. 521 | -} 522 | type StreamEvent 523 | = SentChunk StreamRequest 524 | | ReceivedChunk { request : StreamRequest, response : (Response Bytes) } 525 | | Error Error 526 | | Aborted 527 | | Done 528 | 529 | 530 | {-| Initialize a streaming request. You need to provide a function that generates a message 531 | for handling [StreamEvent](#StreamEvent)s. The headers and data will be sent to the server 532 | immedietly, and a `SentChunk` event will be sent they're done. 533 | 534 | To tell different requests apart, you can use a partially applied custom type like this: 535 | 536 | type Msg = HttpRequest String StreamEvent 537 | 538 | HttpClient.stream httpPermission (HttpRequest "Request 1") requestConfig 539 | -} 540 | stream : Permission -> (StreamEvent -> msg) -> RequestConfiguration Bytes -> Cmd msg 541 | stream permission toMsg config = 542 | command <| Start { toMsg = toMsg, config = kernelRequestConfig permission config } 543 | 544 | 545 | {-| Send more data to the server. This allows you to generate more data as you need to, enabling 546 | you slice up a potentially costly, memory heavy or long-running operation over time. 547 | 548 | You don't have to wait for the matching `SentChunk` event before sending more data but keep in 549 | mind that data will be kept in memory until sent, potentially causing out-of-memory errors in 550 | the case of large amounts of data. 551 | 552 | If you're already receiving data from the server, calling this function will no effect. 553 | -} 554 | sendChunk : StreamRequest -> Bytes -> Cmd msg 555 | sendChunk req bytes = 556 | command <| SendChunk { bytes = bytes, request = req } 557 | 558 | 559 | {-| Use this when you're done sending data. The server will now begin streaming you the response. 560 | -} 561 | startReceive : StreamRequest -> Cmd msg 562 | startReceive req = 563 | command <| StartReceive req 564 | 565 | 566 | {-| Stops the request, for any reason, at any time. Useful if you have an unexpected error with 567 | your own source of data, or if the server response is one you know you don't want to handle after 568 | having inspected the headers. 569 | -} 570 | abort : StreamRequest -> Cmd a 571 | abort req = 572 | command <| Abort req 573 | 574 | 575 | -- COMMANDS 576 | 577 | 578 | type MyCmd msg 579 | = Start { toMsg : (StreamEvent -> msg), config : (KernelRequestConfig Bytes) } 580 | | SendChunk { bytes : Bytes, request : StreamRequest } 581 | | StartReceive StreamRequest 582 | | Abort StreamRequest 583 | 584 | 585 | cmdMap : (a -> b) -> MyCmd a -> MyCmd b 586 | cmdMap func cmd = 587 | when cmd is 588 | Start { toMsg, config } -> 589 | Start { toMsg = (toMsg >> func), config = config } 590 | 591 | SendChunk { bytes, request = req } -> 592 | SendChunk { bytes = bytes, request = req } 593 | 594 | StartReceive req -> 595 | StartReceive req 596 | 597 | Abort req -> 598 | Abort req 599 | 600 | 601 | type alias RequestsState msg = 602 | { nextId : Int 603 | , msgHandlers : Dict Int { toMsg : (StreamEvent -> msg), kernelRequest : KernelRequest } 604 | } 605 | 606 | 607 | type KernelRequest = 608 | -- Actual implementation provided by kernel code 609 | KernelRequest 610 | 611 | 612 | init : Task Never (RequestsState msg) 613 | init = 614 | Task.succeed 615 | { nextId = 0 616 | , msgHandlers = Dict.empty 617 | } 618 | 619 | 620 | onEffects : Platform.Router msg SelfMsg -> Array (MyCmd msg) -> RequestsState msg -> Task Never (RequestsState msg) 621 | onEffects router commands state = 622 | when Array.popFirst commands is 623 | Nothing -> 624 | Task.succeed state 625 | 626 | Just { first, rest } -> 627 | when first is 628 | Start { toMsg, config } -> 629 | let 630 | streamingReq = 631 | StreamRequest state.nextId 632 | in 633 | Gren.Kernel.HttpClient.stream 634 | (Platform.sendToSelf router << Cleanup) 635 | (Platform.sendToApp router << toMsg) 636 | streamingReq 637 | config 638 | |> Task.map 639 | (\kernelRequest -> 640 | { state 641 | | nextId = state.nextId + 1 642 | , msgHandlers = 643 | Dict.set 644 | state.nextId 645 | { toMsg = toMsg 646 | , kernelRequest = kernelRequest 647 | } 648 | state.msgHandlers 649 | } 650 | ) 651 | |> Task.andThen (\updatedState -> onEffects router rest updatedState) 652 | 653 | SendChunk { bytes, request = ((StreamRequest reqId) as req) } -> 654 | when Dict.get reqId state.msgHandlers is 655 | Just msgHandler -> 656 | Gren.Kernel.HttpClient.sendChunk 657 | (Platform.sendToApp router << msgHandler.toMsg) 658 | msgHandler.kernelRequest 659 | req 660 | bytes 661 | |> Task.andThen (\_ -> onEffects router rest state) 662 | 663 | Nothing -> 664 | onEffects router rest state 665 | 666 | StartReceive ((StreamRequest reqId) as req)-> 667 | when Dict.get reqId state.msgHandlers is 668 | Just msgHandler -> 669 | Gren.Kernel.HttpClient.startReceive 670 | (Platform.sendToSelf router << Cleanup) 671 | (Platform.sendToApp router << msgHandler.toMsg) 672 | msgHandler.kernelRequest 673 | req 674 | |> Task.andThen (\_ -> onEffects router rest state) 675 | 676 | Nothing -> 677 | onEffects router rest state 678 | 679 | Abort (StreamRequest reqId)-> 680 | when Dict.get reqId state.msgHandlers is 681 | Just msgHandler -> 682 | Gren.Kernel.HttpClient.abort msgHandler.kernelRequest 683 | |> Task.andThen (\_ -> onEffects router rest state) 684 | 685 | Nothing -> 686 | onEffects router rest state 687 | 688 | 689 | type SelfMsg 690 | = Cleanup StreamRequest 691 | 692 | 693 | onSelfMsg : Platform.Router msg SelfMsg -> SelfMsg -> RequestsState msg -> Task Never (RequestsState msg) 694 | onSelfMsg _ event state = 695 | when event is 696 | Cleanup (StreamRequest reqId) -> 697 | Task.succeed 698 | { state | msgHandlers = Dict.remove reqId state.msgHandlers } 699 | -------------------------------------------------------------------------------- /src/HttpServer.gren: -------------------------------------------------------------------------------- 1 | effect module HttpServer where { subscription = HttpSub } exposing 2 | -- Init 3 | ( Permission 4 | , initialize 5 | 6 | -- Server 7 | , Server 8 | , ServerError(..) 9 | , createServer 10 | 11 | -- Requests 12 | , Request 13 | , Method(..) 14 | , methodToString 15 | , bodyAsString 16 | , bodyFromJson 17 | , requestInfo 18 | , onRequest 19 | ) 20 | 21 | {-| Create a server that can respond to HTTP requests. 22 | 23 | You write your server using The Elm Architecture by subscribing to request 24 | events and responding with commands in update. 25 | 26 | See the [example project](https://github.com/gren-lang/example-projects/blob/main/http-server/src/Main.gren) for what this looks like. 27 | Or the [integration tests](https://github.com/gren-lang/integration-tests/blob/main/http-server/src/Main.gren) for a more robust example with routing and multiple response types. 28 | 29 | ## Initialization 30 | 31 | @docs Permission, Server, ServerError, initialize, createServer 32 | 33 | ## Requests 34 | 35 | @docs Request, Method, methodToString, bodyAsString, bodyFromJson, requestInfo 36 | 37 | ## Responding to requests 38 | 39 | @docs onRequest 40 | 41 | See [HttpServer.Response](HttpServer.Response) for more details on responding to requests. 42 | 43 | -} 44 | 45 | import Bytes exposing (Bytes) 46 | import Bytes.Decode as Decode 47 | import Dict exposing (Dict) 48 | import Init 49 | import Internal.Init 50 | import Json.Encode 51 | import Json.Decode 52 | import Node 53 | import Task exposing (Task) 54 | import Gren.Kernel.HttpServer 55 | import HttpServer.Response exposing (Response(..)) 56 | import Url exposing (Url, Protocol(..)) 57 | 58 | 59 | -- INITIALIZATION 60 | 61 | 62 | {-| The permission to start a [`Server`](HttpServer.Server). 63 | 64 | You get this from [`initialize`](HttpServer.initialize). 65 | -} 66 | type Permission 67 | = Permission 68 | 69 | {-| The HTTP server. 70 | -} 71 | type Server 72 | -- Note: Actual implementation in Kernel code 73 | = Server 74 | 75 | 76 | {-| Error code and message from node. 77 | Most likely from a failed attempt to start the server (e.g. `EADDRINUSE`). 78 | Refer to the [node docs](https://nodejs.org/docs/latest-v18.x/api/errors.html) for details. 79 | -} 80 | type ServerError = 81 | ServerError { code : String, message : String } 82 | 83 | 84 | {-| Initialize the [`HttpServer`](HttpServer) module and get permission to create a server. 85 | -} 86 | initialize : Init.Task Permission 87 | initialize = 88 | Task.succeed Permission 89 | |> Internal.Init.Task 90 | 91 | 92 | 93 | {-| Task to initialize a [`Server`](HttpServer#Server). 94 | -} 95 | createServer : Permission -> { host : String, port_ : Int } -> Task ServerError Server 96 | createServer _ options = 97 | Gren.Kernel.HttpServer.createServer options.host options.port_ 98 | 99 | 100 | -- REQUESTS 101 | 102 | 103 | {-| An incoming HTTP reqest. 104 | -} 105 | type alias Request = 106 | { headers : Dict String String 107 | , method : Method 108 | , body : Bytes 109 | , url : Url 110 | } 111 | 112 | 113 | {-| HTTP request methods. 114 | -} 115 | type Method 116 | = GET 117 | | HEAD 118 | | POST 119 | | PUT 120 | | DELETE 121 | | CONNECT 122 | | TRACE 123 | | PATCH 124 | | UNKNOWN String 125 | 126 | 127 | {-| String representation of method 128 | -} 129 | methodToString : Method -> String 130 | methodToString method = 131 | when method is 132 | GET -> 133 | "GET" 134 | 135 | HEAD -> 136 | "HEAD" 137 | 138 | POST -> 139 | "POST" 140 | 141 | PUT -> 142 | "PUT" 143 | 144 | DELETE -> 145 | "DELETE" 146 | 147 | CONNECT -> 148 | "CONNECT" 149 | 150 | TRACE -> 151 | "TRACE" 152 | 153 | PATCH -> 154 | "PATCH" 155 | 156 | UNKNOWN value -> 157 | value 158 | 159 | 160 | {-| Turn the pieces of a request into a [`Request`](HttpServer.Request) record. 161 | 162 | This is only used internally. 163 | -} 164 | toRequest : 165 | { url : String 166 | , headers : Array String 167 | , method : String 168 | , body : Bytes 169 | } 170 | -> Request 171 | toRequest 172 | { url 173 | , headers 174 | , method 175 | , body 176 | } = 177 | { method = toMethod method 178 | , body = body 179 | , url = 180 | Url.fromString url 181 | |> Maybe.withDefault 182 | { protocol = Http 183 | , port_ = Nothing 184 | , host = "" 185 | , path = "" 186 | , query = Nothing 187 | , fragment = Nothing 188 | } 189 | , headers = 190 | headers 191 | |> arrayPairs 192 | |> dictFromPairs 193 | } 194 | 195 | 196 | {-| Get request body as a string. 197 | -} 198 | bodyAsString : Request -> Maybe String 199 | bodyAsString req = 200 | Bytes.toString req.body 201 | 202 | 203 | {-| Get request body as json. 204 | -} 205 | bodyFromJson : Json.Decode.Decoder a -> Request -> Result Json.Decode.Error a 206 | bodyFromJson decoder req = 207 | req 208 | |> bodyAsString 209 | |> Maybe.withDefault "" -- or better if result holds a maybe? 210 | |> Json.Decode.decodeString decoder 211 | 212 | 213 | {-| Get a string representation of the request. 214 | 215 | Good for logging. 216 | -} 217 | requestInfo : Request -> String 218 | requestInfo req = 219 | let 220 | method 221 | = when req.method is 222 | GET -> 223 | "GET" 224 | 225 | HEAD -> 226 | "HEAD" 227 | 228 | POST -> 229 | "POST" 230 | 231 | PUT -> 232 | "PUT" 233 | 234 | DELETE -> 235 | "DELETE" 236 | 237 | CONNECT -> 238 | "CONNECT" 239 | 240 | TRACE -> 241 | "TRACE" 242 | 243 | PATCH -> 244 | "PATCH" 245 | 246 | UNKNOWN m -> 247 | "UNKNOWN(" ++ m ++ ")" 248 | in 249 | method ++ " " ++ (Url.toString req.url) 250 | 251 | 252 | toMethod : String -> Method 253 | toMethod s = 254 | when s is 255 | "GET" -> 256 | GET 257 | 258 | "HEAD" -> 259 | HEAD 260 | 261 | "POST" -> 262 | POST 263 | 264 | "PUT" -> 265 | PUT 266 | 267 | "DELETE" -> 268 | DELETE 269 | 270 | "CONNECT" -> 271 | CONNECT 272 | 273 | "TRACE" -> 274 | TRACE 275 | 276 | "PATCH" -> 277 | PATCH 278 | 279 | _ -> 280 | UNKNOWN s 281 | 282 | 283 | arrayPairs : Array String -> Array (Array String) 284 | arrayPairs a = 285 | let 286 | pair = 287 | Array.takeFirst 2 a 288 | 289 | rest = 290 | Array.dropFirst 2 a 291 | 292 | allPairs = 293 | [ pair ] ++ when rest is 294 | [] -> 295 | [] 296 | 297 | _ -> 298 | arrayPairs rest 299 | in 300 | allPairs 301 | 302 | 303 | dictFromPairs : Array (Array String) -> Dict String String 304 | dictFromPairs pairs = 305 | let 306 | mapper p dict = 307 | when p is 308 | [a, b] -> 309 | Dict.set a b dict 310 | 311 | _ -> 312 | dict 313 | in 314 | Array.foldl mapper Dict.empty pairs 315 | 316 | 317 | -- EFFECT STUFF 318 | 319 | 320 | type HttpSub msg 321 | = OnRequestSub { server : Server, requestHandler : (Request -> Response -> msg) } 322 | 323 | 324 | subMap : (a -> b) -> HttpSub a -> HttpSub b 325 | subMap f sub = 326 | when sub is 327 | OnRequestSub { server, requestHandler } -> 328 | OnRequestSub { server = server, requestHandler = (\req res -> f (requestHandler req res)) } 329 | 330 | 331 | type alias State msg = 332 | Array (HttpSub msg) 333 | 334 | 335 | init : Task Never (State msg) 336 | init = 337 | Task.succeed [] 338 | 339 | 340 | onEffects 341 | : Platform.Router msg SelfMsg 342 | -> Array (HttpSub msg) 343 | -> State msg 344 | -> Task Never (State msg) 345 | onEffects router subs state = 346 | let 347 | _removeListeners = 348 | state 349 | |> Array.map 350 | (\(OnRequestSub { server }) -> 351 | Gren.Kernel.HttpServer.removeAllListeners server 352 | ) 353 | 354 | _addListeners = 355 | subs 356 | |> Array.map 357 | (\(OnRequestSub { server, requestHandler }) -> 358 | Gren.Kernel.HttpServer.addListener server router requestHandler 359 | ) 360 | in 361 | Task.succeed subs 362 | 363 | 364 | type SelfMsg = 365 | Never 366 | 367 | 368 | onSelfMsg : Platform.Router msg SelfMsg -> SelfMsg -> (State msg) -> Task Never (State msg) 369 | onSelfMsg _ _ state = 370 | Task.succeed state 371 | 372 | 373 | {-| Subscribe to incoming HTTP requests. 374 | -} 375 | onRequest : Server -> (Request -> Response -> msg) -> Sub msg 376 | onRequest server requestHandler = 377 | subscription (OnRequestSub { server = server, requestHandler = requestHandler }) 378 | -------------------------------------------------------------------------------- /src/HttpServer/Response.gren: -------------------------------------------------------------------------------- 1 | effect module HttpServer.Response where { command = ResponseCmd } exposing 2 | ( Response 3 | , send 4 | , setBody 5 | , setBodyAsBytes 6 | , setBodyAsString 7 | , setHeader 8 | , setStatus 9 | ) 10 | 11 | {-| Build up a response as a command. 12 | 13 | Usually this will look something like this, 14 | in your `update` function, 15 | assuming you [subscribed](HttpServer.onRequest) with a `GotRequest` msg: 16 | 17 | GotRequest req res -> 18 | { model = model 19 | , command = 20 | res 21 | |> Response.setHeader "Content-type" "text/html" 22 | |> Response.setBody ("Hello there!") 23 | |> Response.send 24 | } 25 | 26 | @docs Response, send, setBody, setBodyAsBytes, setBodyAsString, setHeader, setStatus 27 | 28 | -} 29 | 30 | import Bytes exposing (Bytes) 31 | import Dict exposing (Dict) 32 | import Task exposing (Task) 33 | 34 | 35 | {-| An HTTP response. 36 | -} 37 | type Response = 38 | Response 39 | { key : ResponseKey 40 | , status : Int 41 | , headers : Dict String String 42 | , body : Body 43 | } 44 | 45 | 46 | type Body 47 | = StringBody String 48 | | BytesBody Bytes 49 | 50 | 51 | type ResponseKey = 52 | NodeHttpResponse 53 | 54 | 55 | {-| Get a [`Response`](HttpServer.Response.Response) from the internal response key. 56 | 57 | This is only used internally. 58 | -} 59 | toResponse : ResponseKey -> Response 60 | toResponse key = 61 | Response 62 | { key = key 63 | , status = 200 64 | , body = StringBody "" 65 | , headers = Dict.empty 66 | } 67 | 68 | 69 | {-| Set the HTTP status code on a response. 70 | -} 71 | setStatus : Int -> Response -> Response 72 | setStatus statusCode (Response response) = 73 | Response { response | status = statusCode } 74 | 75 | 76 | {-| Add a header key/value pair to a response. 77 | -} 78 | setHeader : String -> String -> Response -> Response 79 | setHeader key value (Response response) = 80 | Response 81 | { response 82 | | headers = Dict.set key value response.headers 83 | } 84 | 85 | 86 | {-| Alias for [`setBodyAsString`](HttpServer#setBodyAsString). 87 | -} 88 | setBody : String -> Response -> Response 89 | setBody = setBodyAsString 90 | 91 | 92 | {-| Set the body of the response to a string. 93 | -} 94 | setBodyAsString : String -> Response -> Response 95 | setBodyAsString body (Response response) = 96 | Response 97 | { response | body = StringBody body } 98 | 99 | 100 | {-| Set the body of the response to some bytes. 101 | -} 102 | setBodyAsBytes : Bytes -> Response -> Response 103 | setBodyAsBytes body (Response response) = 104 | Response 105 | { response | body = BytesBody body } 106 | 107 | 108 | -- EFFECT STUFF 109 | 110 | 111 | type ResponseCmd a 112 | = SendResponse Response 113 | 114 | 115 | type alias State = 116 | {} 117 | 118 | 119 | type alias SelfMsg = 120 | Never 121 | 122 | 123 | init : Task Never State 124 | init = 125 | Task.succeed {} 126 | 127 | 128 | onSelfMsg 129 | : Platform.Router msg SelfMsg 130 | -> SelfMsg 131 | -> State 132 | -> Task Never State 133 | onSelfMsg _ _ state = 134 | Task.succeed state 135 | 136 | 137 | cmdMap : (a -> b) -> ResponseCmd a -> ResponseCmd b 138 | cmdMap _ cmd = 139 | when cmd is 140 | SendResponse r -> 141 | SendResponse r 142 | 143 | 144 | onEffects 145 | : Platform.Router msg SelfMsg 146 | -> Array (ResponseCmd a) 147 | -> State 148 | -> Task Never State 149 | onEffects router cmds state = 150 | let 151 | _sendResponses = 152 | cmds 153 | |> Array.map 154 | (\(SendResponse (Response response)) -> 155 | Gren.Kernel.HttpServer.setStatus response.status response.key 156 | |> Gren.Kernel.HttpServer.setHeaders (Dict.foldl (\k v array -> Array.pushLast { key = k, value = v } array) [] response.headers) 157 | |> ( when response.body is 158 | StringBody body -> 159 | Gren.Kernel.HttpServer.setBody body 160 | 161 | BytesBody body -> 162 | Gren.Kernel.HttpServer.setBodyAsBytes body 163 | ) 164 | |> Gren.Kernel.HttpServer.endResponse 165 | ) 166 | in 167 | Task.succeed {} 168 | 169 | 170 | {-| Command to send an HTTP response. 171 | -} 172 | send : Response -> Cmd a 173 | send response = 174 | command (SendResponse response) 175 | -------------------------------------------------------------------------------- /src/Init.gren: -------------------------------------------------------------------------------- 1 | module Init exposing 2 | ( Task 3 | , await 4 | , awaitTask 5 | ) 6 | 7 | {-| This module defines the app initialization task. This is a special kind of task 8 | that can only be passed as the result of an application initialization. You'll typically 9 | use this module in order to initialize sub-systems like `FileSystem` or `ChildProcess`. 10 | 11 | @docs Task, await, awaitTask 12 | -} 13 | 14 | 15 | import Task 16 | import Internal.Init 17 | 18 | 19 | {-| This is like a `Task`, but can only be run as part of initializing your 20 | program. This is usually used for values which should be provided to your program, 21 | and only your program, as opposed to third-party packages. 22 | -} 23 | type alias Task a = 24 | Internal.Init.Task a 25 | 26 | 27 | {-| This let's you wait for the completion of an `Task` before either starting 28 | your application, or begin initialization of another `Task`. 29 | 30 | Init.await Terminal.initialize <| \termConfig -> 31 | Init.await FileSystem.initialize <| \fileSystemConfig -> 32 | -- Start your own program with the values from Terminal and FileSystem 33 | Node.startProgram 34 | { model = 1 35 | , commands = Cmd.none 36 | } 37 | -} 38 | await : Task a -> (a -> Task b) -> Task b 39 | await (Internal.Init.Task task) fn = 40 | Internal.Init.Task (Task.andThen (unwrap << fn) task) 41 | 42 | 43 | {-| This let's you wait for the completion of a `Task` before either starting 44 | your application, or begin initialization of another `Task`. 45 | 46 | Init.await Terminal.initialize <| \termConfig -> 47 | Init.awaitTask Task.now <| \time -> 48 | -- Start your own program with the values from Terminal and FileSystem 49 | Node.startProgram 50 | { model = time 51 | , commands = Cmd.none 52 | } 53 | -} 54 | awaitTask : Task.Task Never a -> (a -> Task b) -> Task b 55 | awaitTask task fn = 56 | Internal.Init.Task (Task.andThen (unwrap << fn) task) 57 | 58 | 59 | unwrap : Task a -> Task.Task Never a 60 | unwrap (Internal.Init.Task task) = 61 | task 62 | 63 | 64 | -------------------------------------------------------------------------------- /src/Internal/Init.gren: -------------------------------------------------------------------------------- 1 | module Internal.Init exposing (Task(..)) 2 | 3 | 4 | import Task 5 | 6 | 7 | type Task a 8 | = Task (Task.Task Never a) 9 | -------------------------------------------------------------------------------- /src/Node.gren: -------------------------------------------------------------------------------- 1 | effect module Node where { subscription = NodeSub } exposing 2 | ( Environment 3 | , Platform(..) 4 | , getPlatform 5 | , CpuArchitecture(..) 6 | , getCpuArchitecture 7 | , getEnvironmentVariables 8 | -- 9 | , SimpleProgram 10 | , defineSimpleProgram 11 | , endSimpleProgram 12 | -- 13 | , Program 14 | , ProgramConfiguration 15 | , defineProgram 16 | , startProgram 17 | -- 18 | , exit 19 | , exitWithCode 20 | , setExitCode 21 | -- 22 | , onEmptyEventLoop 23 | , onSignalInterrupt 24 | , onSignalTerminate 25 | ) 26 | 27 | 28 | {-| A NodeJS program is defined like a browser-based Gren program, except that 29 | there is more flexibility regarding how it is initialized. 30 | 31 | You can initialize any number of subsystems, like `FileSystem` or `Terminal`, before 32 | initializing your own program with the results of those initializations. 33 | 34 | As part of initializing a subsystem, you usually also get access to a value that permits 35 | you to contact said subsystem. Be careful what code you give these permissions to. 36 | 37 | ## Program 38 | 39 | @docs Program, ProgramConfiguration, defineProgram, startProgram 40 | 41 | ## Simple Program 42 | 43 | @docs SimpleProgram, defineSimpleProgram, endSimpleProgram 44 | 45 | ## Environment information 46 | 47 | @docs Environment, getEnvironmentVariables, Platform, getPlatform, CpuArchitecture, getCpuArchitecture 48 | 49 | ## Exit 50 | 51 | @docs exit, exitWithCode, setExitCode 52 | 53 | ## Subscriptions 54 | 55 | @docs onEmptyEventLoop, onSignalInterrupt, onSignalTerminate 56 | 57 | -} 58 | 59 | 60 | import Bytes exposing (Bytes) 61 | import Dict exposing ( Dict ) 62 | import Init 63 | import Internal.Init 64 | import Task exposing ( Task ) 65 | import Gren.Kernel.Node 66 | import FileSystem.Path exposing (Path) 67 | import Stream 68 | import Platform exposing (ProcessId) 69 | import Process 70 | 71 | 72 | -- ENVIRONMENT 73 | 74 | 75 | {-| Contains information about the environment your application was initiated in. 76 | 77 | * `platform` and `cpuArchitecture` tells you something about the operating system and machine your application is running on. 78 | * `applicationPath` is the path to the currently executing program. 79 | * `args` is an `Array` of the arguments passed to your application. 80 | * `stdout`, `stderr` and `stdin` are streams you can use to communicate with the outside world. Take a closer look at the `Stream` module for more information. 81 | 82 | -} 83 | type alias Environment = 84 | { platform : Platform 85 | , cpuArchitecture : CpuArchitecture 86 | , applicationPath : Path 87 | , args : Array String 88 | , stdout : Stream.Writable Bytes 89 | , stderr : Stream.Writable Bytes 90 | , stdin : Stream.Readable Bytes 91 | } 92 | 93 | 94 | initializeEnvironment : Task Never Environment 95 | initializeEnvironment = 96 | Gren.Kernel.Node.init 97 | |> Task.map 98 | (\raw -> 99 | { platform = platformFromString raw.platform 100 | , cpuArchitecture = archFromString raw.arch 101 | , applicationPath = raw.applicationPath 102 | , args = raw.args 103 | , stdout = raw.stdout 104 | , stderr = raw.stderr 105 | , stdin = raw.stdin 106 | } 107 | ) 108 | 109 | 110 | {-| The platform, or operating system, that your application is running on. 111 | -} 112 | type Platform 113 | = Win32 114 | | Darwin 115 | | Linux 116 | | FreeBSD 117 | | OpenBSD 118 | | SunOS 119 | | Aix 120 | | UnknownPlatform String 121 | 122 | 123 | {-| Retrieve the platform of the computer running the application. 124 | -} 125 | getPlatform : Task x Platform 126 | getPlatform = 127 | Gren.Kernel.Node.getPlatform 128 | |> Task.map platformFromString 129 | 130 | 131 | platformFromString : String -> Platform 132 | platformFromString platform = 133 | when String.toLower platform is 134 | "win32" -> 135 | Win32 136 | 137 | "darwin" -> 138 | Darwin 139 | 140 | "linux" -> 141 | Linux 142 | 143 | "freebsd" -> 144 | FreeBSD 145 | 146 | "openbsd" -> 147 | OpenBSD 148 | 149 | "sunos" -> 150 | SunOS 151 | 152 | "aix" -> 153 | Aix 154 | 155 | _ -> 156 | UnknownPlatform platform 157 | 158 | 159 | {-| The CPU architecture your application is running on. 160 | -} 161 | type CpuArchitecture 162 | = Arm 163 | | Arm64 164 | | IA32 165 | | Mips 166 | | Mipsel 167 | | PPC 168 | | PPC64 169 | | S390 170 | | S390x 171 | | X64 172 | | UnknownArchitecture String 173 | 174 | 175 | {-| Retrieve the CPU architecture of the computer running the application. 176 | -} 177 | getCpuArchitecture : Task x CpuArchitecture 178 | getCpuArchitecture = 179 | Gren.Kernel.Node.getCpuArchitecture 180 | |> Task.map archFromString 181 | 182 | 183 | archFromString : String -> CpuArchitecture 184 | archFromString arch = 185 | when String.toLower arch is 186 | "arm" -> 187 | Arm 188 | 189 | "arm64" -> 190 | Arm64 191 | 192 | "ia32" -> 193 | IA32 194 | 195 | "mips" -> 196 | Mips 197 | 198 | "mipsel" -> 199 | Mipsel 200 | 201 | "ppc" -> 202 | PPC 203 | 204 | "ppc64" -> 205 | PPC64 206 | 207 | "s390" -> 208 | S390 209 | 210 | "s390x" -> 211 | S390x 212 | 213 | "x64" -> 214 | X64 215 | 216 | _ -> 217 | UnknownArchitecture arch 218 | 219 | 220 | {-| Get a `Dict` of environment variables. 221 | -} 222 | getEnvironmentVariables : Task x (Dict String String) 223 | getEnvironmentVariables = 224 | Gren.Kernel.Node.getEnvironmentVariables 225 | 226 | 227 | -- PROGRAMS 228 | 229 | 230 | {-| A program that executes a single task and then exits. 231 | -} 232 | type alias SimpleProgram msg = 233 | Platform.Program {} {} msg 234 | 235 | 236 | {-| The definition of a Gren program that runs on NodeJS. 237 | -} 238 | type alias Program model msg = 239 | Platform.Program {} (Model model) (Msg model msg) 240 | 241 | 242 | -- TOP LEVEL PROGRAM 243 | 244 | 245 | type Model model 246 | = Uninitialized 247 | | Initialized model 248 | 249 | 250 | type Msg model msg 251 | = InitDone { model : model, command : Cmd msg } 252 | | MsgReceived msg 253 | 254 | 255 | {-| The required functions that define a program. 256 | -} 257 | type alias ProgramConfiguration model msg = 258 | { init : Environment -> Init.Task { model : model, command : Cmd msg } 259 | , update : msg -> model -> { model : model, command : Cmd msg } 260 | , subscriptions : model -> Sub msg 261 | } 262 | 263 | 264 | {-| Define a program with access to long-lived state and the ability to respond to 265 | messages and listen to subscriptions. If you want to define a simple and short-lived 266 | program, chances are you're looking for [defineSimpleProgram](#defineSimpleProgram) instead. 267 | -} 268 | defineProgram : ProgramConfiguration model msg -> Program model msg 269 | defineProgram config = 270 | Platform.worker 271 | { init = initProgram config.init 272 | , update = update config.update 273 | , subscriptions = subscriptions config.subscriptions 274 | } 275 | 276 | 277 | initProgram 278 | : (Environment -> Init.Task { model : model, command : Cmd msg }) 279 | -> {} 280 | -> { model : Model model, command : Cmd (Msg model msg) } 281 | initProgram initTask {} = 282 | { model = Uninitialized 283 | , command = 284 | initializeEnvironment 285 | |> Task.andThen (\env -> unwrap <| initTask env) 286 | |> Task.perform InitDone 287 | } 288 | 289 | 290 | unwrap : Internal.Init.Task a -> Task Never a 291 | unwrap (Internal.Init.Task task) = 292 | task 293 | 294 | 295 | update 296 | : (msg -> model -> { model : model, command : Cmd msg }) 297 | -> Msg model msg 298 | -> Model model 299 | -> { model : Model model, command : Cmd (Msg model msg) } 300 | update appUpdate msg model = 301 | when model is 302 | Uninitialized -> 303 | when msg is 304 | InitDone initResult -> 305 | { model = Initialized initResult.model 306 | , command = Cmd.map MsgReceived initResult.command 307 | } 308 | 309 | MsgReceived _ -> 310 | -- Ignore 311 | { model = model, command = Cmd.none } 312 | 313 | Initialized appModel -> 314 | when msg is 315 | InitDone _ -> 316 | -- Ignore 317 | { model = model, command = Cmd.none } 318 | 319 | MsgReceived appMsg -> 320 | let 321 | updateResult = 322 | appUpdate appMsg appModel 323 | in 324 | { model = Initialized updateResult.model 325 | , command = Cmd.map MsgReceived updateResult.command 326 | } 327 | 328 | 329 | subscriptions 330 | : (model -> Sub msg) 331 | -> (Model model) 332 | -> Sub (Msg model msg) 333 | subscriptions appSubs model = 334 | when model is 335 | Uninitialized -> 336 | Sub.none 337 | 338 | Initialized appModel -> 339 | Sub.map MsgReceived (appSubs appModel) 340 | 341 | 342 | {-| This lets the runtime know that you're done initializing other subsystems, 343 | and that your program is ready to start. 344 | -} 345 | startProgram : { model : model, command : Cmd cmd } -> Init.Task { model : model, command : Cmd cmd } 346 | startProgram initResult = 347 | Internal.Init.Task (Task.succeed initResult) 348 | 349 | 350 | {-| Define a simple program that doesn't require long-lived state or the ability to respond 351 | to messages or subscriptions. Ideal for simple and short-lived programs. 352 | -} 353 | defineSimpleProgram : (Environment -> Init.Task (Cmd a)) -> SimpleProgram a 354 | defineSimpleProgram initTask = 355 | Platform.worker 356 | { init = \_ -> 357 | { model = {} 358 | , command = 359 | initializeEnvironment 360 | |> Task.andThen (\env -> unwrap <| initTask env) 361 | |> Task.executeCmd 362 | } 363 | , update = (\_ _ -> { model = {}, command = Cmd.none }) 364 | , subscriptions = (\_ -> Sub.none) 365 | } 366 | 367 | 368 | {-| When defining a program with [defineSimpleProgram](#defineSimpleProgram), use this function to define the 369 | final command to execute. 370 | -} 371 | endSimpleProgram : Task Never x -> Init.Task (Cmd a) 372 | endSimpleProgram finalTask = 373 | Internal.Init.Task (Task.succeed <| Task.execute finalTask) 374 | 375 | 376 | -- EXIT 377 | 378 | 379 | {-| Terminate the program immediatly. It will not wait for tasks like http calls 380 | or file system writes to complete. 381 | 382 | This function is equivalent to: 383 | 384 | exitWithCode 0 385 | -} 386 | exit : Cmd msg 387 | exit = 388 | exitWithCode 0 389 | 390 | 391 | {-| Terminate the program immediatly. It will not wait for tasks like http calls 392 | or file system writes, so only use this if you've reached a state where it makes 393 | no sense to continue. 394 | 395 | The exit code can be read by other processes on your system. Any value other than 396 | 0 is considered an error, but there are no other formal requirements for what 397 | makes an exit code. If all you want is to signalize that your application exited 398 | due to an error, -1 is a good option. 399 | -} 400 | exitWithCode : Int -> Cmd msg 401 | exitWithCode code = 402 | Gren.Kernel.Node.exitWithCode code 403 | 404 | 405 | {-| Set the error code that the program will return once it finishes. 406 | 407 | Note: This will not terminate your program, so things like http calls 408 | or writes to the filesystem will be allowed to complete. However, 409 | the program will only exit once there are no ongoing tasks. 410 | -} 411 | setExitCode : Int -> Task x {} 412 | setExitCode code = 413 | Gren.Kernel.Node.setExitCode code 414 | 415 | 416 | -- SUBSCRIPTIONS 417 | 418 | 419 | type NodeSub msg 420 | = OnEmptyEventLoop msg 421 | | OnSignalInterrupt msg 422 | | OnSignalTerminate msg 423 | 424 | 425 | subMap : (a -> b) -> NodeSub a -> NodeSub b 426 | subMap mapFn sub = 427 | when sub is 428 | OnEmptyEventLoop msg -> 429 | OnEmptyEventLoop (mapFn msg) 430 | 431 | OnSignalInterrupt msg -> 432 | OnSignalInterrupt (mapFn msg) 433 | 434 | OnSignalTerminate msg -> 435 | OnSignalTerminate (mapFn msg) 436 | 437 | 438 | {-| -} 439 | onEmptyEventLoop : msg -> Sub msg 440 | onEmptyEventLoop msg = 441 | subscription (OnEmptyEventLoop msg) 442 | 443 | 444 | {-| -} 445 | onSignalInterrupt : msg -> Sub msg 446 | onSignalInterrupt msg = 447 | subscription (OnSignalInterrupt msg) 448 | 449 | 450 | {-| -} 451 | onSignalTerminate : msg -> Sub msg 452 | onSignalTerminate msg = 453 | subscription (OnSignalTerminate msg) 454 | 455 | 456 | -- LOOP 457 | 458 | 459 | type alias State msg = 460 | { emptyEventLoop : Array msg 461 | , emptyEventLoopListener : Maybe ProcessId 462 | , signalInterrupt : Array msg 463 | , signalInterruptListener : Maybe ProcessId 464 | , signalTerminate : Array msg 465 | , signalTerminateListener : Maybe ProcessId 466 | } 467 | 468 | 469 | init : Task Never (State msg) 470 | init = 471 | Task.succeed 472 | { emptyEventLoop = [] 473 | , emptyEventLoopListener = Nothing 474 | , signalInterrupt = [] 475 | , signalInterruptListener = Nothing 476 | , signalTerminate = [] 477 | , signalTerminateListener = Nothing 478 | } 479 | 480 | 481 | onEffects 482 | : Platform.Router msg Event 483 | -> Array (NodeSub msg) 484 | -> State msg 485 | -> Task Never (State msg) 486 | onEffects router subs state = 487 | let 488 | newSubs = 489 | Array.foldl 490 | categorizeSubs 491 | { emptyEventLoop = [] 492 | , signalInterrupt = [] 493 | , signalTerminate = [] 494 | } 495 | subs 496 | 497 | categorizeSubs sub acc = 498 | when sub is 499 | OnEmptyEventLoop msg -> 500 | { acc | emptyEventLoop = Array.pushLast msg acc.emptyEventLoop } 501 | 502 | OnSignalInterrupt msg -> 503 | { acc | signalInterrupt = Array.pushLast msg acc.signalInterrupt } 504 | 505 | OnSignalTerminate msg -> 506 | { acc | signalTerminate = Array.pushLast msg acc.signalTerminate } 507 | 508 | emptyEventLoopListenerTask = 509 | if Array.length newSubs.emptyEventLoop > 0 then 510 | when state.emptyEventLoopListener is 511 | Just pid -> 512 | Task.succeed (Just pid) 513 | 514 | Nothing -> 515 | Gren.Kernel.Node.attachEmptyEventLoopListener (Platform.sendToSelf router NotifyEmptyEventLoop) 516 | |> Process.spawn 517 | |> Task.map Just 518 | else 519 | when state.emptyEventLoopListener is 520 | Just pid -> 521 | Process.kill pid 522 | |> Task.map (\_ -> Nothing) 523 | 524 | Nothing -> 525 | Task.succeed Nothing 526 | 527 | signalInterruptListenerTask = 528 | if Array.length newSubs.signalInterrupt > 0 then 529 | when state.signalInterruptListener is 530 | Just pid -> 531 | Task.succeed (Just pid) 532 | 533 | Nothing -> 534 | Gren.Kernel.Node.attachSignalInterruptListener (Platform.sendToSelf router NotifySignalInterrupt) 535 | |> Process.spawn 536 | |> Task.map Just 537 | else 538 | when state.signalInterruptListener is 539 | Just pid -> 540 | Process.kill pid 541 | |> Task.map (\_ -> Nothing) 542 | 543 | Nothing -> 544 | Task.succeed Nothing 545 | 546 | signalTerminateListenerTask = 547 | if Array.length newSubs.signalTerminate > 0 then 548 | when state.signalTerminateListener is 549 | Just pid -> 550 | Task.succeed (Just pid) 551 | 552 | Nothing -> 553 | Gren.Kernel.Node.attachSignalTerminateListener (Platform.sendToSelf router NotifySignalTerminate) 554 | |> Process.spawn 555 | |> Task.map Just 556 | else 557 | when state.signalTerminateListener is 558 | Just pid -> 559 | Process.kill pid 560 | |> Task.map (\_ -> Nothing) 561 | 562 | Nothing -> 563 | Task.succeed Nothing 564 | in 565 | Task.map3 566 | (\emptyEventLoopListener signalInterruptListener signalTerminateListener -> 567 | { emptyEventLoop = newSubs.emptyEventLoop 568 | , emptyEventLoopListener = emptyEventLoopListener 569 | , signalInterrupt = newSubs.signalInterrupt 570 | , signalInterruptListener = signalInterruptListener 571 | , signalTerminate = newSubs.signalTerminate 572 | , signalTerminateListener = signalTerminateListener 573 | } 574 | ) 575 | emptyEventLoopListenerTask 576 | signalInterruptListenerTask 577 | signalTerminateListenerTask 578 | 579 | 580 | type Event 581 | = NotifyEmptyEventLoop 582 | | NotifySignalInterrupt 583 | | NotifySignalTerminate 584 | 585 | 586 | onSelfMsg : Platform.Router msg Event -> Event -> State msg -> Task Never (State msg) 587 | onSelfMsg router event state = 588 | when event is 589 | NotifyEmptyEventLoop -> 590 | Array.foldl 591 | (\msg task -> Task.andThen (\_ -> Platform.sendToApp router msg) task) 592 | (Task.succeed {}) 593 | state.emptyEventLoop 594 | |> Task.map (\_ -> state) 595 | 596 | NotifySignalInterrupt -> 597 | Array.foldl 598 | (\msg task -> Task.andThen (\_ -> Platform.sendToApp router msg) task) 599 | (Task.succeed {}) 600 | state.signalInterrupt 601 | |> Task.map (\_ -> state) 602 | 603 | NotifySignalTerminate -> 604 | Array.foldl 605 | (\msg task -> Task.andThen (\_ -> Platform.sendToApp router msg) task) 606 | (Task.succeed {}) 607 | state.signalTerminate 608 | |> Task.map (\_ -> state) 609 | -------------------------------------------------------------------------------- /src/Terminal.gren: -------------------------------------------------------------------------------- 1 | effect module Terminal where { subscription = TerminalSub } exposing 2 | ( Permission 3 | , Configuration 4 | , Size 5 | , initialize 6 | -- 7 | , setStdInRawMode 8 | , setProcessTitle 9 | -- 10 | , onResize 11 | ) 12 | 13 | 14 | {-| This lets you interact with the user's terminal, if an interactive 15 | terminal is connected to this application. 16 | 17 | ## Initialization 18 | 19 | @docs Permission, Configuration, Size, initialize 20 | 21 | ## Commands 22 | 23 | @docs setStdInRawMode, setProcessTitle 24 | 25 | ## Subscriptions 26 | 27 | @docs onResize 28 | 29 | -} 30 | 31 | 32 | import Task exposing (Task) 33 | import Process 34 | import Gren.Kernel.Terminal 35 | import Init 36 | import Internal.Init 37 | 38 | 39 | {-| The permission for performing commands specified in this module. 40 | -} 41 | type Permission 42 | = Permission 43 | 44 | 45 | {-| The configuration of the attached interactive terminal. 46 | -} 47 | type alias Configuration = 48 | { permission : Permission 49 | , colorDepth : Int 50 | , columns : Int 51 | , rows : Int 52 | } 53 | 54 | 55 | {-| Size of a terminal. Handy to know for drawing a text-based UI. 56 | -} 57 | type alias Size = 58 | { columns : Int 59 | , rows : Int 60 | } 61 | 62 | 63 | -- INIT 64 | 65 | 66 | {-| Initializes the `Terminal` subsystem. 67 | 68 | `Nothing` is returned if this program isn't connected to an interactive terminal, which 69 | can happen in CI-setups or when used as part of a unix pipe. 70 | -} 71 | initialize : Init.Task (Maybe Configuration) 72 | initialize = 73 | Gren.Kernel.Terminal.init 74 | |> Task.map (\raw -> 75 | if raw.isTTY then 76 | Just 77 | { permission = Permission 78 | , colorDepth = raw.colorDepth 79 | , columns = raw.columns 80 | , rows = raw.rows 81 | } 82 | 83 | else 84 | Nothing 85 | ) 86 | |> Internal.Init.Task 87 | 88 | 89 | -- COMMANDS 90 | 91 | 92 | {-| In it's default mode, `stdin` only sends data when the user hits the enter key. 93 | 94 | If you switch over to raw mode, every keypress will be sent over the stream, and special 95 | combinations like `Ctrl-C` will no longer trigger the kill signal. 96 | 97 | Enable this when you need full control over how input is handled. 98 | -} 99 | setStdInRawMode : Permission -> Bool -> Task x {} 100 | setStdInRawMode _ toggle = 101 | Gren.Kernel.Terminal.setStdInRawMode toggle 102 | 103 | 104 | {-| Set the title of the running process. This will usually display in 105 | activity monitors or in the title bar of your terminal emulator. 106 | -} 107 | setProcessTitle : Permission -> String -> Task x {} 108 | setProcessTitle _ title = 109 | Gren.Kernel.Terminal.setProcessTitle title 110 | 111 | 112 | -- SUBSCRIPTIONS 113 | 114 | 115 | type TerminalSub msg 116 | = OnResize (Size -> msg) 117 | 118 | 119 | subMap : (a -> b) -> TerminalSub a -> TerminalSub b 120 | subMap mapFn sub = 121 | when sub is 122 | OnResize msgMap -> 123 | OnResize (mapFn << msgMap) 124 | 125 | 126 | {-| A subscription that triggers every time the size of the terminal changes. 127 | -} 128 | onResize : Permission -> (Size -> msg) -> Sub msg 129 | onResize _ toMsg = 130 | subscription (OnResize toMsg) 131 | 132 | 133 | -- LOOP 134 | 135 | 136 | type alias State msg = 137 | { taggers : Array (Size -> msg) 138 | , maybeProcessId : Maybe Process.Id 139 | } 140 | 141 | 142 | init : Task Never (State msg) 143 | init = 144 | Task.succeed 145 | { taggers = [] 146 | , maybeProcessId = Nothing 147 | } 148 | 149 | 150 | onEffects 151 | : Platform.Router msg Event 152 | -> Array (TerminalSub msg) 153 | -> State msg 154 | -> Task Never (State msg) 155 | onEffects router subs state = 156 | let 157 | newTaggers = 158 | Array.foldl extractTagger [] subs 159 | 160 | extractTagger (OnResize tagger) acc = 161 | Array.pushLast tagger acc 162 | 163 | subscriptionTask = 164 | if Array.length newTaggers > 0 then 165 | when state.maybeProcessId is 166 | Just pid -> 167 | Task.succeed <| Just pid 168 | 169 | Nothing -> 170 | Gren.Kernel.Terminal.attachListener (\data -> Platform.sendToSelf router (SelfOnResize data)) 171 | |> Process.spawn 172 | |> Task.map Just 173 | 174 | 175 | else 176 | when state.maybeProcessId is 177 | Just pid -> 178 | Process.kill pid 179 | |> Task.map (\_ -> Nothing) 180 | 181 | Nothing -> 182 | Task.succeed Nothing 183 | in 184 | subscriptionTask 185 | |> Task.andThen (\maybeProcessId -> 186 | Task.succeed 187 | { taggers = newTaggers 188 | , maybeProcessId = maybeProcessId 189 | } 190 | ) 191 | 192 | 193 | type Event 194 | = SelfOnResize Size 195 | 196 | 197 | onSelfMsg : Platform.Router msg Event -> Event -> State msg -> Task Never (State msg) 198 | onSelfMsg router event state = 199 | when event is 200 | SelfOnResize newSize -> 201 | state.taggers 202 | |> Array.map (\tagger -> tagger newSize) 203 | |> Array.foldl 204 | (\msg tasks -> 205 | Task.andThen (\{} -> Platform.sendToApp router msg) tasks 206 | ) 207 | (Task.succeed {}) 208 | |> Task.map (\_ -> state) 209 | -------------------------------------------------------------------------------- /tests/gren.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "platform": "node", 4 | "source-directories": [ 5 | "src" 6 | ], 7 | "gren-version": "0.5.3", 8 | "dependencies": { 9 | "direct": { 10 | "gren-lang/core": "6.0.0", 11 | "gren-lang/node": "local:..", 12 | "gren-lang/test": "4.0.0", 13 | "gren-lang/test-runner-node": "5.0.0" 14 | }, 15 | "indirect": { 16 | "gren-lang/url": "5.0.0" 17 | } 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /tests/run-tests.sh: -------------------------------------------------------------------------------- 1 | set -e 2 | 3 | gren make src/Main.gren 4 | node app -------------------------------------------------------------------------------- /tests/src/Main.gren: -------------------------------------------------------------------------------- 1 | module Main exposing (main) 2 | 3 | import Basics exposing (..) 4 | import Json.Decode exposing (Value) 5 | import Platform.Cmd exposing (Cmd) 6 | import Test 7 | import Test.FileSystemPath as FileSystemPath 8 | import Test.Runner.Node exposing (Program, run) 9 | 10 | 11 | main : Program 12 | main = 13 | run <| 14 | Test.describe "Gren Node Tests" 15 | [ FileSystemPath.tests 16 | ] 17 | -------------------------------------------------------------------------------- /tests/src/Test/FileSystemPath.gren: -------------------------------------------------------------------------------- 1 | module Test.FileSystemPath exposing (tests) 2 | 3 | import FileSystem.Path as Path 4 | import Test exposing (Test, describe, test) 5 | import Expect 6 | 7 | 8 | tests : Test 9 | tests = 10 | describe "FileSystem.Path Tests" 11 | [ describe "fromPosixString" 12 | [ test "absolute file" <| 13 | \{} -> 14 | Path.fromPosixString "/some/long/path.js" 15 | |> Expect.equal 16 | { root = "/" 17 | , directory = [ "some", "long" ] 18 | , filename = "path" 19 | , extension = "js" 20 | } 21 | , test "absolute file without extension" <| 22 | \{} -> 23 | Path.fromPosixString "/some/long" 24 | |> Expect.equal 25 | { root = "/" 26 | , directory = [ "some" ] 27 | , filename = "long" 28 | , extension = "" 29 | } 30 | , test "relative file" <| 31 | \{} -> 32 | Path.fromPosixString "some/other/file" 33 | |> Expect.equal 34 | { root = "" 35 | , directory = [ "some", "other" ] 36 | , filename = "file" 37 | , extension = "" 38 | } 39 | , test "just a file name" <| 40 | \{} -> 41 | Path.fromPosixString "file.md" 42 | |> Expect.equal 43 | { root = "" 44 | , directory = [] 45 | , filename = "file" 46 | , extension = "md" 47 | } 48 | , test "paths are normalized" <| 49 | \{} -> 50 | Path.fromPosixString "some/other/file/." 51 | |> Expect.equal 52 | { root = "" 53 | , directory = [ "some", "other" ] 54 | , filename = "file" 55 | , extension = "" 56 | } 57 | , test "paths are normalized, but leading . is kept" <| 58 | \{} -> 59 | Path.fromPosixString "./file" 60 | |> Expect.equal 61 | { root = "" 62 | , directory = [ "." ] 63 | , filename = "file" 64 | , extension = "" 65 | } 66 | , test "paths are normalized, even in extreme cases" <| 67 | \{} -> 68 | Path.fromPosixString "some/other//file/other/.." 69 | |> Expect.equal 70 | { root = "" 71 | , directory = [ "some", "other" ] 72 | , filename = "file" 73 | , extension = "" 74 | } 75 | , test "empty path" <| 76 | \{} -> 77 | Path.fromPosixString "" 78 | |> Expect.equal 79 | { root = "" 80 | , directory = [] 81 | , filename = "" 82 | , extension = "" 83 | } 84 | , test "current path" <| 85 | \{} -> 86 | Path.fromPosixString "" 87 | |> Expect.equal (Path.fromPosixString ".") 88 | ] 89 | , describe "fromWin32String" 90 | [ test "absolute file" <| 91 | \{} -> 92 | Path.fromWin32String "C:\\some\\long\\path.js" 93 | |> Expect.equal 94 | { root = "C:\\" 95 | , directory = [ "some", "long" ] 96 | , filename = "path" 97 | , extension = "js" 98 | } 99 | ] 100 | , describe "to*String" 101 | [ test "toPosixString is the inverse of fromPosixString" <| 102 | \{} -> 103 | let 104 | pathStr = 105 | "/some/specific/file.md" 106 | 107 | path = 108 | Path.fromPosixString pathStr 109 | in 110 | Expect.equal pathStr (Path.toPosixString path) 111 | , test "toPosixString works on simple file name" <| 112 | \{} -> 113 | let 114 | pathStr = 115 | "file.md" 116 | 117 | path = 118 | Path.fromPosixString pathStr 119 | in 120 | Expect.equal pathStr (Path.toPosixString path) 121 | , test "toWin32String is the inverse of fromWin32String" <| 122 | \{} -> 123 | let 124 | pathStr = 125 | "C:\\some\\specific\\file.md" 126 | 127 | path = 128 | Path.fromWin32String pathStr 129 | in 130 | Expect.equal pathStr (Path.toWin32String path) 131 | , test "Path is platform agnostic" <| 132 | \{} -> 133 | let 134 | pathStr = 135 | "C:\\some\\specific\\file.md" 136 | 137 | path = 138 | Path.fromWin32String pathStr 139 | in 140 | Expect.equal "/some/specific/file.md" (Path.toPosixString path) 141 | ] 142 | , describe "filenameWithExtension" 143 | [ test "Returns the filename with extension" <| 144 | \{} -> 145 | Expect.equal "file.md" (Path.filenameWithExtension (Path.fromPosixString "/dir/file.md")) 146 | , test "Or just the filename if no extension is set" <| 147 | \{} -> 148 | Expect.equal "file" (Path.filenameWithExtension (Path.fromPosixString "/dir/file")) 149 | ] 150 | , describe "append" 151 | [ test "Joins two paths" <| 152 | \{} -> 153 | Path.fromPosixString "/some/longer/file.md" 154 | |> Path.append (Path.fromPosixString "/with/more") 155 | |> Path.toPosixString 156 | |> Expect.equal "/some/longer/file.md/with/more" 157 | , test "Preserves root" <| 158 | \{} -> 159 | Path.fromPosixString "/some/path" 160 | |> Path.append (Path.fromPosixString "nested/file.md") 161 | |> Path.toPosixString 162 | |> Expect.equal "/some/path/nested/file.md" 163 | ] 164 | , describe "join" 165 | [ test "Easier way to join many paths" <| 166 | \{} -> 167 | Expect.equal 168 | (Path.fromPosixString "one" 169 | |> Path.append (Path.fromPosixString "two/three") 170 | |> Path.append (Path.fromPosixString "/file.md") 171 | ) 172 | (Path.join 173 | [ Path.fromPosixString "one" 174 | , Path.fromPosixString "two/three" 175 | , Path.fromPosixString "/file.md" 176 | ] 177 | ) 178 | , test "Preserves root" <| 179 | \{} -> 180 | Expect.equal 181 | (Path.fromPosixString "/my/long/path/to/file.md") 182 | (Path.join 183 | [ Path.fromPosixString "/my/long" 184 | , Path.fromPosixString "path/to" 185 | , Path.fromPosixString "file.md" 186 | ] 187 | ) 188 | ] 189 | ] 190 | --------------------------------------------------------------------------------