├── .gitignore ├── LICENSE ├── README.md ├── elm-package.json ├── example ├── .gitignore ├── Example.elm ├── Example │ ├── Supervisor.elm │ └── Worker.elm ├── browser.js ├── elm-package.json ├── example.js ├── index.html ├── package.json ├── supervisor.js └── worker.js ├── package.json └── src ├── elm └── Script.elm └── js ├── supervisor.js └── worker.js /.gitignore: -------------------------------------------------------------------------------- 1 | # Logs 2 | logs 3 | *.log 4 | npm-debug.log* 5 | 6 | # Runtime data 7 | pids 8 | *.pid 9 | *.seed 10 | 11 | # Directory for instrumented libs generated by jscoverage/JSCover 12 | lib-cov 13 | 14 | # Coverage directory used by tools like istanbul 15 | coverage 16 | 17 | # Grunt intermediate storage (http://gruntjs.com/creating-plugins#storing-task-files) 18 | .grunt 19 | 20 | # node-waf configuration 21 | .lock-wscript 22 | 23 | # Compiled binary addons (http://nodejs.org/api/addons.html) 24 | build/Release 25 | 26 | # Dependency directory 27 | node_modules 28 | 29 | # Optional npm cache directory 30 | .npm 31 | 32 | # Optional REPL history 33 | .node_repl_history 34 | 35 | elm-stuff 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Richard Feldman 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of elm-web-workers nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | **CAUTION: NOWHERE NEAR READY FOR PRODUCTION USE!** This is barely at the proof-of-concept at this point! 2 | 3 | # elm-web-workers 4 | 5 | Write Elm code that talks to Web Workers. 6 | 7 | Design goals: 8 | 9 | * You can write Elm code that does Web Worker stuff using a supervisor/worker pattern suggested by [**@evancz**](https://github.com/evancz) 10 | * Your code will not only work in a browser, but will also work on Node as long as you have [webworker-threads](https://www.npmjs.com/package/webworker-threads) installed. 11 | 12 | Implementation notes: 13 | 14 | * End user will have to write some ports and some js (that calls out to the npm library) to kick everything off. 15 | * Don't assume `require` is available; that means all third-party dependencies must be optional. 16 | 17 | You can try out the example with: 18 | 19 | ```bash 20 | $ cd example 21 | $ npm install .. && npm run example 22 | ``` 23 | 24 | It claims it's running a bunch of workers. They aren't doing anything CPU-intensive, 25 | so you sort of have to take its word for it. A really stunning demo, I know. 26 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Run Elm applications on web workers", 4 | "repository": "https://github.com/rtfeldman/elm-web-workers.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | "src/elm" 8 | ], 9 | "exposed-modules": ["Script.Worker", "Script.Supervisor", "Script"], 10 | "dependencies": { 11 | "elm-lang/core": "4.0.0 <= v < 5.0.0", 12 | "elm-lang/html": "1.0.0 <= v < 2.0.0" 13 | }, 14 | "elm-version": "0.17.0 <= v < 0.18.0" 15 | } 16 | -------------------------------------------------------------------------------- /example/.gitignore: -------------------------------------------------------------------------------- 1 | Elm.js 2 | -------------------------------------------------------------------------------- /example/Example.elm: -------------------------------------------------------------------------------- 1 | port module Example exposing (..) 2 | 3 | -- This is where the magic happens 4 | 5 | import Json.Encode as Encode exposing (Value) 6 | import Script exposing (WorkerId, WorkerCommands, SupervisorCommands) 7 | import Set exposing (Set) 8 | import Example.Worker as Worker 9 | import Example.Supervisor as Supervisor 10 | import Html 11 | 12 | 13 | main : Program Never 14 | main = 15 | Script.program 16 | { worker = 17 | { update = Worker.update 18 | , receive = Worker.receive 19 | , init = ( (Worker.Model "0"), Cmd.none ) 20 | , subscriptions = \_ -> Sub.none 21 | } 22 | , supervisor = 23 | { update = Supervisor.update 24 | , init = ( (Supervisor.Model [] Set.empty), Cmd.none ) 25 | , receive = Supervisor.receive 26 | , subscriptions = \_ -> Sub.none 27 | , view = \_ -> Html.text "Running..." 28 | } 29 | , ports = ( send, receive identity ) 30 | } 31 | 32 | 33 | port send : Value -> Cmd msg 34 | 35 | 36 | port receive : (Value -> msg) -> Sub msg 37 | -------------------------------------------------------------------------------- /example/Example/Supervisor.elm: -------------------------------------------------------------------------------- 1 | module Example.Supervisor exposing (..) 2 | 3 | -- This is where the magic happens 4 | 5 | import Json.Encode as Encode exposing (Value) 6 | import Json.Decode as Decode exposing ((:=)) 7 | import Script exposing (SupervisorCommands, WorkerId) 8 | import Set exposing (Set) 9 | import String 10 | 11 | 12 | type Msg 13 | = NoOp 14 | | Echo String 15 | | SendError String 16 | 17 | 18 | type alias Model = 19 | { messagesReceived : List String 20 | , workerIds : Set WorkerId 21 | } 22 | 23 | 24 | update : SupervisorCommands Msg -> Msg -> Model -> ( Model, Cmd Msg ) 25 | update commands msg model = 26 | case msg of 27 | Echo str -> 28 | let 29 | _ = 30 | Debug.log str 31 | in 32 | ( model, Cmd.none ) 33 | 34 | SendError err -> 35 | Debug.crash err 36 | 37 | NoOp -> 38 | ( model, Cmd.none ) 39 | 40 | 41 | receive : WorkerId -> Value -> Msg 42 | receive id data = 43 | case Decode.decodeValue Decode.string data of 44 | Ok str -> 45 | Echo ("worker[" ++ id ++ "] says: " ++ str) 46 | 47 | Err err -> 48 | SendError ("worker[" ++ id ++ "] sent malformed example data:" ++ toString data) 49 | 50 | 51 | 52 | --sub data = 53 | -- case Decode.decodeValue (Decode.object2 (,) ("msgType" := Decode.string) ("data" := Decode.string)) data of 54 | -- Ok ( "echo", msg ) -> 55 | -- let 56 | -- newMessagesReceived = 57 | -- model.messagesReceived ++ [ msg ] 58 | -- output = 59 | -- "Here are all the messages I've received so far:\n" 60 | -- ++ (String.join "\n" newMessagesReceived) 61 | -- in 62 | -- ( { model | messagesReceived = newMessagesReceived }, Supervisor.emit (Encode.string output) ) 63 | -- Ok ( "echoViaWorker", workerId ) -> 64 | -- ( model 65 | -- , Supervisor.send workerId (Encode.string ("I have " ++ toString model.workerIds ++ " workers")) 66 | -- ) 67 | -- Ok ( "spawn", workerId ) -> 68 | -- ( { model | workerIds = Set.insert workerId model.workerIds } 69 | -- , Supervisor.send workerId (Encode.string workerId) 70 | -- ) 71 | -- Ok ( msgType, msg ) -> 72 | -- Debug.crash ("Urecognized msgType: " ++ msgType ++ " with data: " ++ msg) 73 | -- Err err -> 74 | -- ( model, Supervisor.emit (Encode.string ("Error decoding message; error was: " ++ err)) ) 75 | -------------------------------------------------------------------------------- /example/Example/Worker.elm: -------------------------------------------------------------------------------- 1 | module Example.Worker exposing (..) 2 | 3 | -- This is where the magic happens 4 | 5 | import Json.Encode as Encode exposing (Value) 6 | import Json.Decode as Decode exposing ((:=)) 7 | import Script exposing (WorkerCommands) 8 | 9 | 10 | type alias Model = 11 | { id : String } 12 | 13 | 14 | update : WorkerCommands Msg -> Msg -> Model -> ( Model, Cmd Msg ) 15 | update commands msg model = 16 | case msg of 17 | RecordId id -> 18 | ( { model | id = id } 19 | , commands.send (Encode.string ("Hi, my name is Worker " ++ id ++ "!")) 20 | ) 21 | 22 | SendError err -> 23 | ( model 24 | , commands.send (Encode.string ("Error on worker " ++ model.id ++ ": " ++ err)) 25 | ) 26 | 27 | NoOp -> 28 | ( model, Cmd.none ) 29 | 30 | 31 | receive : Value -> Msg 32 | receive data = 33 | case Decode.decodeValue Decode.string data of 34 | Ok id -> 35 | RecordId id 36 | 37 | Err err -> 38 | SendError err 39 | 40 | 41 | type Msg 42 | = NoOp 43 | | RecordId String 44 | | SendError String 45 | -------------------------------------------------------------------------------- /example/browser.js: -------------------------------------------------------------------------------- 1 | var supervisor = new Supervisor("Elm.js", "Example"); 2 | 3 | supervisor.on("emit", function(msg) { 4 | console.log("[supervisor]:", msg); 5 | }); 6 | 7 | supervisor.on("close", function(msg) { 8 | console.log("Closed with message:", msg); 9 | }); 10 | 11 | supervisor.start(); 12 | 13 | supervisor.send({msgType: "echo", data: "Spawning some workers..."}); 14 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 15 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 16 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 17 | supervisor.send({msgType: "spawn", data: "5"}); 18 | 19 | setInterval(function() { 20 | supervisor.send({msgType: "echoViaWorker", data: "5"}); 21 | }, 2000); 22 | -------------------------------------------------------------------------------- /example/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "elm-node-app example", 4 | "repository": "https://github.com/rtfeldman/elm-web-workers.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | ".", 8 | "../src/elm" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "elm-community/elm-json-extra": "1.0.0 <= v < 2.0.0", 13 | "elm-lang/core": "4.0.0 <= v < 5.0.0", 14 | "elm-lang/html": "1.0.0 <= v < 2.0.0" 15 | }, 16 | "elm-version": "0.17.0 <= v < 0.18.0" 17 | } 18 | -------------------------------------------------------------------------------- /example/example.js: -------------------------------------------------------------------------------- 1 | var Supervisor = require("elm-web-workers"); 2 | var path = require("path"); 3 | var elmPath = path.join(__dirname, "Elm.js"); 4 | 5 | var supervisor = new Supervisor(elmPath, "Example"); 6 | 7 | supervisor.on("emit", function(msg) { 8 | console.log("[supervisor]:", msg); 9 | }); 10 | 11 | supervisor.on("close", function(msg) { 12 | console.log("Closed with message:", msg); 13 | }); 14 | 15 | supervisor.start(); 16 | 17 | supervisor.send({msgType: "echo", data: "Spawning some workers..."}); 18 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 19 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 20 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 21 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 22 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 23 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 24 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 25 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 26 | supervisor.send({msgType: "spawn", data: "" + Math.random()}); 27 | supervisor.send({msgType: "spawn", data: "5"}); 28 | 29 | 30 | setInterval(function() { 31 | supervisor.send({msgType: "echoViaWorker", data: "5"}); 32 | }, 2000); 33 | -------------------------------------------------------------------------------- /example/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | Elm Web Workers Example 7 | 8 | 9 | 10 | 11 | 12 | 13 |

Running worker stuff...see console for output!

14 | 15 | 16 | -------------------------------------------------------------------------------- /example/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "example", 3 | "version": "1.0.0", 4 | "description": "", 5 | "main": "example.js", 6 | "scripts": { 7 | "example": "elm-make Example.elm --output=Elm.js && node example.js" 8 | }, 9 | "author": "Richard Feldman", 10 | "license": "BSD-3-Clause", 11 | "dependencies": { 12 | "elm-web-workers": "file:.." 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /example/supervisor.js: -------------------------------------------------------------------------------- 1 | ../src/js/supervisor.js -------------------------------------------------------------------------------- /example/worker.js: -------------------------------------------------------------------------------- 1 | ../src/js/worker.js -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elm-web-workers", 3 | "version": "0.0.1", 4 | "description": "Write Elm code that talks to Web Workers.", 5 | "main": "src/js/supervisor.js", 6 | "directories": { 7 | "example": "example" 8 | }, 9 | "scripts": { 10 | "test": "echo \"Error: no test specified\" && exit 1" 11 | }, 12 | "repository": { 13 | "type": "git", 14 | "url": "git+https://github.com/rtfeldman/elm-web-workers.git" 15 | }, 16 | "author": "Richard Feldman ", 17 | "license": "BSD-3-Clause", 18 | "bugs": { 19 | "url": "https://github.com/rtfeldman/elm-web-workers/issues" 20 | }, 21 | "homepage": "https://github.com/rtfeldman/elm-web-workers#readme", 22 | "optionalDependencies": { 23 | "webworker-threads": "^0.7.2" 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /src/elm/Script.elm: -------------------------------------------------------------------------------- 1 | module Script exposing (ParallelProgram, program, WorkerCommands, SupervisorCommands, WorkerId) 2 | 3 | {-| 4 | 5 | @docs ParallelProgram, program, WorkerCommands, SupervisorCommands, WorkerId 6 | -} 7 | 8 | -- This is where the magic happens 9 | 10 | import Json.Decode as Decode exposing (Value, Decoder, (:=), decodeValue) 11 | import Json.Encode as Encode 12 | import Html.App 13 | import Html exposing (Html) 14 | 15 | 16 | {-| -} 17 | type alias WorkerId = 18 | String 19 | 20 | 21 | {-| -} 22 | type alias WorkerCommands workerMsg = 23 | { send : Value -> Cmd workerMsg 24 | , close : Cmd workerMsg 25 | } 26 | 27 | 28 | {-| -} 29 | type alias SupervisorCommands supervisorMsg = 30 | { send : WorkerId -> Value -> Cmd supervisorMsg 31 | , terminate : WorkerId -> Cmd supervisorMsg 32 | , close : Cmd supervisorMsg 33 | } 34 | 35 | 36 | {-| -} 37 | type alias ParallelProgram workerModel workerMsg supervisorModel supervisorMsg = 38 | { worker : 39 | { update : 40 | WorkerCommands workerMsg 41 | -> workerMsg 42 | -> workerModel 43 | -> ( workerModel, Cmd workerMsg ) 44 | , receive : Value -> workerMsg 45 | , init : ( workerModel, Cmd workerMsg ) 46 | , subscriptions : workerModel -> Sub workerMsg 47 | } 48 | , supervisor : 49 | { update : 50 | SupervisorCommands supervisorMsg 51 | -> supervisorMsg 52 | -> supervisorModel 53 | -> ( supervisorModel, Cmd supervisorMsg ) 54 | , receive : WorkerId -> Value -> supervisorMsg 55 | , init : ( supervisorModel, Cmd supervisorMsg ) 56 | , subscriptions : supervisorModel -> Sub supervisorMsg 57 | , view : supervisorModel -> Html supervisorMsg 58 | } 59 | , ports : ( Value -> Cmd Never, Sub Value ) 60 | } 61 | 62 | 63 | fromNever : Never -> a 64 | fromNever a = 65 | fromNever a 66 | 67 | 68 | getWorkerCommands : (Value -> Cmd Never) -> WorkerCommands msg 69 | getWorkerCommands send = 70 | { send = 71 | \value -> 72 | [ ( "cmd", Encode.string "SEND_TO_SUPERVISOR" ) 73 | , ( "data", value ) 74 | ] 75 | |> Encode.object 76 | |> send 77 | |> Cmd.map fromNever 78 | , close = 79 | [ ( "cmd", Encode.string "CLOSE" ) 80 | , ( "data", Encode.null ) 81 | ] 82 | |> Encode.object 83 | |> send 84 | |> Cmd.map fromNever 85 | } 86 | 87 | 88 | getSupervisorCommands : (Value -> Cmd Never) -> SupervisorCommands msg 89 | getSupervisorCommands send = 90 | { send = 91 | \workerId value -> 92 | [ ( "cmd", Encode.string "SEND_TO_WORKER" ) 93 | , ( "workerId", Encode.string workerId ) 94 | , ( "data", value ) 95 | ] 96 | |> Encode.object 97 | |> send 98 | |> Cmd.map fromNever 99 | , terminate = 100 | \workerId -> 101 | [ ( "cmd", Encode.string "TERMINATE" ) 102 | , ( "workerId", Encode.string workerId ) 103 | , ( "data", Encode.null ) 104 | ] 105 | |> Encode.object 106 | |> send 107 | |> Cmd.map fromNever 108 | , close = 109 | [ ( "cmd", Encode.string "CLOSE" ) 110 | , ( "workerId", Encode.null ) 111 | , ( "data", Encode.null ) 112 | ] 113 | |> Encode.object 114 | |> send 115 | |> Cmd.map fromNever 116 | } 117 | 118 | 119 | messageDecoder : Decoder ( Bool, Maybe WorkerId, Value ) 120 | messageDecoder = 121 | Decode.object3 (,,) 122 | ("forWorker" := Decode.bool) 123 | ("workerId" := nullable Decode.string) 124 | ("data" := Decode.value) 125 | 126 | 127 | type Role workerModel supervisorModel 128 | = Supervisor workerModel supervisorModel 129 | | Worker workerModel supervisorModel 130 | | Uninitialized 131 | 132 | 133 | getUpdate : 134 | ParallelProgram workerModel workerMsg supervisorModel supervisorMsg 135 | -> InternalMsg workerMsg supervisorMsg 136 | -> Role workerModel supervisorModel 137 | -> ( Role workerModel supervisorModel, Cmd (InternalMsg workerMsg supervisorMsg) ) 138 | getUpdate config = 139 | let 140 | send = 141 | fst config.ports 142 | 143 | workerCommands = 144 | getWorkerCommands send 145 | 146 | supervisorCommands = 147 | getSupervisorCommands send 148 | 149 | workerUpdate workerModel supervisorModel msg = 150 | let 151 | ( newModel, cmd ) = 152 | config.worker.update workerCommands msg workerModel 153 | in 154 | ( Worker newModel supervisorModel, Cmd.map InternalWorkerMsg cmd ) 155 | 156 | supervisorUpdate workerModel supervisorModel msg = 157 | let 158 | ( newModel, cmd ) = 159 | config.supervisor.update supervisorCommands msg supervisorModel 160 | in 161 | ( Supervisor workerModel newModel, Cmd.map InternalSupervisorMsg cmd ) 162 | 163 | jsonUpdate config json role = 164 | case ( role, Decode.decodeValue messageDecoder json ) of 165 | ( _, Err err ) -> 166 | Debug.crash ("Someone sent malformed JSON through the `receive` port: " ++ err) 167 | 168 | ( Uninitialized, Ok ( False, _, data ) ) -> 169 | let 170 | -- We've received a supervisor message; we must be a supervisor! 171 | ( supervisorModel, supervisorInitCmd ) = 172 | config.supervisor.init 173 | 174 | initCmd = 175 | Cmd.map InternalSupervisorMsg supervisorInitCmd 176 | 177 | workerModel = 178 | fst config.worker.init 179 | 180 | ( newRole, newCmd ) = 181 | jsonUpdate config json (Supervisor workerModel supervisorModel) 182 | in 183 | ( newRole, Cmd.batch [ initCmd, newCmd ] ) 184 | 185 | ( Uninitialized, Ok ( True, _, data ) ) -> 186 | let 187 | -- We've received a worker message; we must be a worker! 188 | ( workerModel, workerInitCmd ) = 189 | config.worker.init 190 | 191 | initCmd = 192 | Cmd.map InternalWorkerMsg workerInitCmd 193 | 194 | supervisorModel = 195 | fst config.supervisor.init 196 | 197 | ( newRole, newCmd ) = 198 | jsonUpdate config json (Worker workerModel supervisorModel) 199 | in 200 | ( newRole, Cmd.batch [ initCmd, newCmd ] ) 201 | 202 | ( Supervisor workerModel supervisorModel, Ok ( False, Just workerId, data ) ) -> 203 | -- We're a supervisor; process the message accordingly 204 | supervisorUpdate workerModel 205 | supervisorModel 206 | (config.supervisor.receive workerId data) 207 | 208 | ( Worker workerModel supervisorModel, Ok ( True, Nothing, data ) ) -> 209 | -- We're a worker; process the message accordingly 210 | workerUpdate workerModel 211 | supervisorModel 212 | (config.worker.receive data) 213 | 214 | ( Worker _ _, Ok ( True, Just _, data ) ) -> 215 | Debug.crash "Received workerId in a message intended for a worker. Worker messages should never include a workerId, as workers should never rely on knowing their own workerId values!" 216 | 217 | ( Worker _ _, Ok ( False, _, _ ) ) -> 218 | Debug.crash "Received supervisor message while running as worker." 219 | 220 | ( Supervisor _ _, Ok ( False, Nothing, _ ) ) -> 221 | Debug.crash "Received supervisor message without a workerId." 222 | 223 | ( Supervisor _ _, Ok ( True, _, _ ) ) -> 224 | Debug.crash "Received worker message while running as supervisor." 225 | in 226 | -- This is the actual update function. Everything up to this point has 227 | -- been prep work that only needs to be done once, not every time 228 | -- udpate gets called. 229 | \internalMsg role -> 230 | case ( role, internalMsg ) of 231 | ( Worker workerModel supervisorModel, InternalWorkerMsg msg ) -> 232 | workerUpdate workerModel supervisorModel msg 233 | 234 | ( Supervisor workerModel supervisorModel, InternalSupervisorMsg msg ) -> 235 | supervisorUpdate workerModel supervisorModel msg 236 | 237 | ( Worker workerModel supervisorModel, InternalSupervisorMsg msg ) -> 238 | Debug.crash ("Received an internal supervisor message as a worker!" ++ toString msg) 239 | 240 | ( Supervisor workerModel supervisorModel, InternalWorkerMsg msg ) -> 241 | Debug.crash ("Received an internal worker message as a supervisor: " ++ toString msg) 242 | 243 | ( Uninitialized, InternalSupervisorMsg msg ) -> 244 | Debug.crash ("Received an internal supervisor message when uninitialized!" ++ toString msg) 245 | 246 | ( Uninitialized, InternalWorkerMsg msg ) -> 247 | Debug.crash ("Received an internal worker message when uninitialized: " ++ toString msg) 248 | 249 | ( _, InternalJsonMsg json ) -> 250 | jsonUpdate config json role 251 | 252 | 253 | {-| -} 254 | program : ParallelProgram workerModel workerMsg supervisorModel supervisorMsg -> Program Never 255 | program config = 256 | Html.App.program 257 | { init = ( Uninitialized, Cmd.none ) 258 | , view = wrapView config.supervisor.view >> Maybe.withDefault (Html.text "") 259 | , update = getUpdate config 260 | , subscriptions = 261 | wrapSubscriptions (snd config.ports) 262 | config.worker.subscriptions 263 | config.supervisor.subscriptions 264 | } 265 | 266 | 267 | type InternalMsg workerMsg supervisorMsg 268 | = InternalSupervisorMsg supervisorMsg 269 | | InternalWorkerMsg workerMsg 270 | | InternalJsonMsg Value 271 | 272 | 273 | wrapView : (supervisorModel -> Html supervisorMsg) -> Role workerModel supervisorModel -> Maybe (Html (InternalMsg workerMsg supervisorMsg)) 274 | wrapView view role = 275 | case role of 276 | Supervisor _ supervisorModel -> 277 | supervisorModel 278 | |> view 279 | |> Html.App.map InternalSupervisorMsg 280 | |> Just 281 | 282 | Worker workerModel supervisorModel -> 283 | -- Workers can't have views 284 | Nothing 285 | 286 | Uninitialized -> 287 | -- We don't get a view until we initialize 288 | Nothing 289 | 290 | 291 | wrapSubscriptions : 292 | Sub Value 293 | -> (workerModel -> Sub workerMsg) 294 | -> (supervisorModel -> Sub supervisorMsg) 295 | -> Role workerModel supervisorModel 296 | -> Sub (InternalMsg workerMsg supervisorMsg) 297 | wrapSubscriptions receive workerSubscriptions supervisorSubscriptions role = 298 | let 299 | receiveJson = 300 | Sub.map InternalJsonMsg receive 301 | in 302 | case role of 303 | Worker workerModel _ -> 304 | Sub.batch 305 | [ receiveJson 306 | , Sub.map InternalWorkerMsg (workerSubscriptions workerModel) 307 | ] 308 | 309 | Supervisor _ supervisorModel -> 310 | Sub.batch 311 | [ receiveJson 312 | , Sub.map InternalSupervisorMsg (supervisorSubscriptions supervisorModel) 313 | ] 314 | 315 | Uninitialized -> 316 | receiveJson 317 | 318 | 319 | {-| Works just like http://package.elm-lang.org/packages/elm-community/json-extra/1.0.0/Json-Decode-Extra#maybeNull 320 | -} 321 | nullable : Decoder a -> Decoder (Maybe a) 322 | nullable decoder = 323 | Decode.oneOf 324 | [ Decode.null Nothing 325 | , Decode.map Just decoder 326 | ] 327 | -------------------------------------------------------------------------------- /src/js/supervisor.js: -------------------------------------------------------------------------------- 1 | if (typeof Worker === "undefined") { 2 | Worker = require("webworker-threads").Worker; 3 | } 4 | 5 | function Supervisor(elmPath, elmModuleName, args, sendMessagePortName, receiveMessagePortName, workerPath) { 6 | if (typeof workerPath === "undefined") { 7 | workerPath = (typeof require !== "undefined" && require.resolve) ? require.resolve("./worker.js") : "worker.js"; 8 | } 9 | 10 | Elm = typeof Elm === "undefined" ? require(elmPath) : Elm; 11 | 12 | var elmApp = Elm[elmModuleName].worker(args); 13 | 14 | if (typeof sendMessagePortName === "undefined") { 15 | sendMessagePortName = "send"; 16 | } else if (typeof sendMessagePortName !== "string") { 17 | throw new Error("Invalid sendMessagePortName: " + sendMessagePortName); 18 | } 19 | 20 | if (typeof receiveMessagePortName === "undefined") { 21 | receiveMessagePortName = "receive"; 22 | } else if (typeof receiveMessagePortName !== "string") { 23 | throw new Error("Invalid receiveMessagePortName: " + receiveMessagePortName); 24 | } 25 | 26 | // Validate that elmApp looks right. 27 | if (typeof elmApp !== "object") { 28 | throw new Error("Invalid elmApp: " + elmApp); 29 | } else if (typeof elmApp.ports !== "object") { 30 | throw new Error("The provided elmApp is missing a `ports` field."); 31 | } 32 | 33 | [sendMessagePortName, receiveMessagePortName].forEach(function(portName) { 34 | if (typeof elmApp.ports[portName] !== "object") { 35 | throw new Error("The provided elmApp does not have a valid a port called `" + portName + "`."); 36 | } 37 | }); 38 | 39 | // Set up methods 40 | 41 | var ports = elmApp.ports; 42 | var subscribe = ports[sendMessagePortName].subscribe; 43 | var send = ports[receiveMessagePortName].send 44 | var listeners = {}; 45 | 46 | function emit(msgType, data) { 47 | if (typeof listeners[msgType] === "object") { 48 | listeners[msgType].forEach(function(callback) { 49 | callback(data); 50 | }); 51 | } 52 | } 53 | 54 | this.on = function on(msgType, callback) { 55 | if (typeof listeners[msgType] === "undefined") { 56 | listeners[msgType] = [callback]; 57 | } else { 58 | listeners[msgType].push(callback); 59 | } 60 | } 61 | 62 | this.off = function off(msgType) { 63 | delete listeners[msgType]; 64 | } 65 | 66 | var started = false; // CAUTION: this gets mutated! 67 | var sendQueue = []; // CAUTION: this gets mutated! 68 | 69 | this.start = function() { 70 | if (started) { 71 | throw new Error("Attempted to start a supervisor that was already started!"); 72 | } else { 73 | var workerConfig = JSON.stringify({ 74 | elmPath: elmPath, 75 | elmModuleName: elmModuleName, 76 | receiveMessagePortName: receiveMessagePortName, 77 | sendMessagePortName: sendMessagePortName, 78 | args: args 79 | }); 80 | 81 | supervise(subscribe, send, emit, workerPath, workerConfig); 82 | } 83 | 84 | // Clear out the send queue. 85 | // NOTE: we must wrap this in a setTimeout, as sending immediately after 86 | // calling start() drops the messages on Node.js for some as-yet unknown reason. 87 | setTimeout(function() { 88 | sendQueue.forEach(function(thunk) { thunk() }); 89 | 90 | sendQueue = undefined; 91 | }, 0); 92 | } 93 | 94 | this.send = function(data) { 95 | if (typeof sendQueue === "undefined") { 96 | return send({forWorker: false, workerId: null, data: data}); 97 | } else { 98 | // If we haven't started yet, enqueue the messages for sending later. 99 | sendQueue.push(function() { send({forWorker: false, workerId: null, data: data}); }); 100 | } 101 | } 102 | 103 | this.Elm = Elm; 104 | 105 | return this; 106 | } 107 | 108 | function supervise(subscribe, send, emit, workerPath, workerConfig) { 109 | var workers = {}; 110 | 111 | function emitClose(msg) { 112 | emit("close", msg); 113 | } 114 | 115 | function emitMessage(msg) { 116 | emit("emit", msg); 117 | } 118 | 119 | function terminateWorkers() { 120 | Object.keys(workers).forEach(function(id) { 121 | workers[id].terminate(); 122 | }); 123 | } 124 | 125 | function handleMessage(msg) { 126 | switch (msg.cmd) { 127 | case "TERMINATE": 128 | terminateWorkers(); 129 | 130 | // We're done! 131 | return emitClose(null); 132 | 133 | case "EMIT": 134 | return emitMessage(msg.data); 135 | 136 | case "SEND_TO_WORKER": 137 | var workerId = msg.workerId; 138 | 139 | if (typeof workerId !== "string") { 140 | terminateWorkers(); 141 | 142 | return emitClose("Error: Cannot send message " + msg + " to workerId `" + workerId + "`!"); 143 | } else { 144 | var message = {cmd: "SEND_TO_WORKER", data: msg.data}; 145 | 146 | if (workers.hasOwnProperty(workerId)) { 147 | return workers[workerId].postMessage(message); 148 | } else { 149 | // This workerId is unknown to us; init a new worker before sending. 150 | var worker = new Worker(workerPath); 151 | 152 | worker.onerror = function(err) { 153 | throw("Exception in worker[" + workerId + "]: " + JSON.stringify(err)); 154 | } 155 | 156 | function handleWorkerMessage(event) { 157 | switch (event.data.type) { 158 | case "initialized": 159 | worker.postMessage(message); 160 | 161 | break; 162 | 163 | case "messages": 164 | (event.data.contents || []).forEach(function(contents) { 165 | // When the worker sends a message, tag it with this workerId 166 | // and then send it along for the supervisor to handle. 167 | return send({forWorker: false, workerId: workerId, data: contents}); 168 | }); 169 | 170 | break; 171 | 172 | default: 173 | throw new Error("Unrecognized worker message type: " + event.data.type); 174 | } 175 | } 176 | 177 | worker.onmessage = handleWorkerMessage; 178 | 179 | // Record this new worker in the lookup table. 180 | workers[workerId] = worker; 181 | 182 | worker.postMessage({cmd: "INIT_WORKER", data: workerConfig}); 183 | } 184 | break; 185 | } 186 | 187 | default: 188 | throw new Error("Supervisor attempted to handle unrecognized command: " + msg.cmd); 189 | } 190 | } 191 | 192 | subscribe(function(messages) { 193 | try { 194 | messages.forEach(handleMessage); 195 | } catch (err) { 196 | terminateWorkers(); 197 | emitClose(err); 198 | } 199 | }); 200 | } 201 | 202 | 203 | if (typeof module === "object") { 204 | module.exports = Supervisor; 205 | } 206 | -------------------------------------------------------------------------------- /src/js/worker.js: -------------------------------------------------------------------------------- 1 | // TODO: this still doesn't quite work right. Messages are getting dropped. 2 | // In a browser, things work great. 3 | // In here, not so much. Not all the threads report that they initialized 4 | // successfully, and then even fewer greet successfully. 5 | // onerror doesn't work, so we need to wrap everything in a try/catch 6 | // and send a {type: error} message to the parent if something blows up. 7 | // At least that will get us some visibility. 8 | 9 | var receiveMessagePortName; 10 | 11 | self.onmessage = function(event) { 12 | var msg = event.data; 13 | 14 | switch (msg.cmd) { 15 | case "INIT_WORKER": 16 | if (typeof elmApp === "undefined") { 17 | var config = JSON.parse(msg.data); 18 | 19 | try { 20 | module = {}; 21 | 22 | importScripts(config.elmPath); 23 | var Elm = module.exports; 24 | 25 | receiveMessagePortName = config.receiveMessagePortName; 26 | 27 | elmApp = Elm[config.elmModuleName].worker(config.args); 28 | 29 | elmApp.ports[config.sendMessagePortName].subscribe(sendMessages); 30 | 31 | // Tell the supervisor we're initialized, so it can run the 32 | // pending message that was waiting for init to complete. 33 | self.postMessage({type: "initialized"}); 34 | } catch(err) { 35 | throw new Error("Error initializing Elm in worker: " + err); 36 | } 37 | } else { 38 | throw new Error("Worker attempted to initialize twice!"); 39 | } 40 | 41 | break; 42 | 43 | case "SEND_TO_WORKER": 44 | if (typeof elmApp === "undefined") { 45 | throw new Error("Canot send() to a worker that has not yet been initialized!"); 46 | } 47 | 48 | try { 49 | elmApp.ports[receiveMessagePortName].send({forWorker: true, workerId: null, data: msg.data}); 50 | } catch (err) { 51 | throw new Error("Error attempting to send message to Elm Worker: " + err); 52 | } 53 | 54 | break; 55 | 56 | default: 57 | throw new Error("Unrecognized worker command: " + msg.cmd); 58 | } 59 | }; 60 | 61 | // Polyfill setTimeout 62 | if (typeof setTimeout === "undefined") { 63 | // TODO verify that this actually works with values other than 0. It has never 64 | // been verified as of the writing of this comment, but should be before 65 | // someone uses `sleep` and is surprised when it (maybe) doesn't work. 66 | function delayUntil(time, callback) { 67 | if (new Date().getTime() >= time) { 68 | callback(); 69 | } else { 70 | self.thread.nextTick(function() { delayUntil(time, callback); }); 71 | } 72 | } 73 | 74 | setTimeout = function setTimeout(callback, delay) { 75 | if (delay === 0) { 76 | self.thread.nextTick(callback); 77 | } else { 78 | delayUntil(new Date().getTime() + delay, callback); 79 | } 80 | } 81 | } 82 | 83 | if (typeof module === "undefined") { 84 | module = {}; 85 | } 86 | 87 | 88 | function sendMessages(messages) { 89 | self.postMessage({type: "messages", contents: messages}); 90 | } 91 | --------------------------------------------------------------------------------