diff --git a/.github/workflows/set-issue-expectations.yml b/.github/workflows/set-issue-expectations.yml new file mode 100644 index 00000000..da03493f --- /dev/null +++ b/.github/workflows/set-issue-expectations.yml @@ -0,0 +1,21 @@ +name: Set Issue Expectations +on: + issues: + types: [opened] +jobs: + comment-on-issue: + name: Comment On Issue + runs-on: ubuntu-latest + steps: + - uses: actions/github@v1.0.0 + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + with: + args: | + comment "Thanks for reporting this! To set expectations: + + - Issues are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response. + - Ask questions a [community forum](https://elm-lang.org/community). You will get an answer quicker that way! + - If you experience something similar, open a new issue. [We like duplicates](https://github.com/elm/expectations/blob/master/duplicates.md). + + Finally, please be patient with the core team. They are trying their best with limited resources." diff --git a/.github/workflows/set-pull-expectations.yml b/.github/workflows/set-pull-expectations.yml new file mode 100644 index 00000000..63813f6b --- /dev/null +++ b/.github/workflows/set-pull-expectations.yml @@ -0,0 +1,21 @@ +name: Set Pull Expectations +on: + pull_request: + types: [opened] +jobs: + comment-on-pull: + name: Comment On Pull + runs-on: ubuntu-latest + steps: + - uses: actions/github@v1.0.0 + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + with: + args: | + comment "Thanks for suggesting these code changes. To set expectations: + + - Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response. + - Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md). + - Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc. + + Finally, please be patient with the core team. They are trying their best with limited resources." diff --git a/NEWS b/NEWS new file mode 100644 index 00000000..7171ffb4 --- /dev/null +++ b/NEWS @@ -0,0 +1,51 @@ +# NEWS + +A little inline blog documenting the development of this library. + +# 2020/4/26 -- Merge elm/random back into core + +In my book, things that can manage effects belong in elm/core. This merge +required replacing effect manager code with an alternative (in this case +channel based) implementation. + +The new implementation is not that nice. Maybe it will look better when I +manage to unifiy the two Task types. I think this is a case where the effect +manager abstraction really worked well. I might just have my rose tinted +specticles on. + +# 2020/4/26 -- A new internal module `Platform.Raw.Impure` + +This module contains an abstaction for functions that **do things** when +they are run. The functions in this module are constrained to take one argument +and return the unit tuple. + +Why can we not use Task's for this, given that this is _exactly_ what they are +intended for. Well, two reasons + +1. Sometimes we need a guarantee that the function will be run exactly when we + need to run. Task are always enqueued; they are only run after stepping + through all the previous Tasks in the queue. Sometimes, this is not + acceptable, for instance when updating the listeners for a subscription + effect. + +2. We need to use impure functions to run Tasks. The + `Platform.Raw.Scheduler.enqueue` function takes a Task, adds it to the + scheduler queue and, if the scheduler is not currently stepping tasks (i.e. + this is not a reentrant call to `Platform.Raw.Scheduler.enqueue`), starts + stepping. This function is impure. However, if we represented it as a Task + we would have an infinite loop! + +Hopefully, use of this module can be reduced to a couple of key places and +maybe even inlined into the scheduler is that is the only place that uses it. +Hopefully, it will help us move all effectful functions out of elm. + + +## 2020/04/26 - the future? + +I wan't to move to away from callbacks and towards async/await and promises (or +futures). Firstly, I find that async/await is much easier to reason about than +callbacks and leads to much prettier code. Also, in the back of my mind is the +desire to eventually port the core libraries to rust for native compiled elm +code. + +Todays change is just cosmetic, but hopefully is step 1. diff --git a/README.md b/README.md index 0a8cf2a2..8ca95f78 100644 --- a/README.md +++ b/README.md @@ -1,30 +1,14 @@ -# Core Libraries +# Elm-in-elm core libraries -Every Elm project needs this package! +> This repository currently contains a work in progress attempt to rewrite the elm core libraries into a form better suited for elm-in-elm. +> It has not yet been upstreamed or adopted by elm-in-elm; I hope one day to integrate this into elm-in-elm but currently is just my work. -It provides **basic functionality** like addition and subtraction as well as **data structures** like lists, dictionaries, and sets. +## Aims -> **New to Elm?** Go to [elm-lang.org](https://elm-lang.org) for an overview. +* Minimal amount of Kernel code. +* Easy to read. +## Rules -## Default Imports - -The modules in this package are so common, that some of them are imported by default in all Elm files. So it is as if every Elm file starts with these imports: - -```elm -import Basics exposing (..) -import List exposing (List, (::)) -import Maybe exposing (Maybe(..)) -import Result exposing (Result(..)) -import String exposing (String) -import Char exposing (Char) -import Tuple - -import Debug - -import Platform exposing ( Program ) -import Platform.Cmd as Cmd exposing ( Cmd ) -import Platform.Sub as Sub exposing ( Sub ) -``` - -The intention is to include things that are both extremely useful and very unlikely to overlap with anything that anyone will ever write in a library. By keeping the set of default imports relatively small, it also becomes easier to use whatever version of `map` suits your fancy. Finally, it makes it easier to figure out where the heck a function is coming from. +* Each kernel function may only be called via a type annotated redefinition in an elm file. +* Kernel functions may **not** call other kernel functions. diff --git a/benchmark/.gitignore b/benchmark/.gitignore new file mode 100644 index 00000000..aee98106 --- /dev/null +++ b/benchmark/.gitignore @@ -0,0 +1 @@ +/elm-stuff/ diff --git a/benchmark/elm.json b/benchmark/elm.json new file mode 100644 index 00000000..776d8656 --- /dev/null +++ b/benchmark/elm.json @@ -0,0 +1,29 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.1", + "elm/core": "1.0.2", + "elm/html": "1.0.0", + "elm-explorations/benchmark": "1.0.1" + }, + "indirect": { + "BrianHicks/elm-trend": "2.1.3", + "Skinney/murmur3": "2.0.8", + "elm/json": "1.1.3", + "elm/regex": "1.0.0", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2", + "mdgriffith/style-elements": "5.0.1" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/benchmark/src/Main.elm b/benchmark/src/Main.elm new file mode 100644 index 00000000..b22fe411 --- /dev/null +++ b/benchmark/src/Main.elm @@ -0,0 +1,104 @@ + +module Main exposing (..) + +import Benchmark.Runner exposing (BenchmarkProgram, program) + +import Array +import Benchmark exposing (..) +import List exposing (reverse) + + +main : BenchmarkProgram +main = + program suite + +cons : a -> List a -> List a +cons = + (::) + + +map2 : (a -> b -> result) -> List a -> List b -> List result +map2 f xs1 xs2 = + map5 (\a b _ _ _ -> f a b) xs1 xs2 xs1 xs1 xs1 + + +{-|-} +map3 : (a -> b -> c -> result) -> List a -> List b -> List c -> List result +map3 f xs1 xs2 xs3 = + map5 (\a b c _ _ -> f a b c) xs1 xs2 xs3 xs1 xs1 + + +{-|-} +map4 : (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result +map4 f xs1 xs2 xs3 xs4 = + map5 (\a b c d _ -> f a b c d) xs1 xs2 xs3 xs4 xs1 + + + +{-|-} +map5 : (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result +map5 = + List.map5 + +map2Help : (a -> b -> result) -> List a -> List b -> List result -> List result +map2Help f xs1 xs2 ys = + case (xs1, xs2) of + (head1 :: rest1, head2 :: rest2) -> + map2Help f rest1 rest2 (cons (f head1 head2) ys) + _ -> + ys + +map3Help : (a -> b -> c -> result) -> List a -> List b -> List c-> List result -> List result +map3Help f xs1 xs2 xs3 ys = + case (xs1, xs2, xs3) of + (head1 :: rest1, head2 :: rest2, head3 :: rest3) -> + map3Help f rest1 rest2 rest3 (cons (f head1 head2 head3) ys) + _ -> + ys + +map4Help : (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result -> List result +map4Help f xs1 xs2 xs3 xs4 ys = + case (xs1, xs2, (xs3, xs4)) of + (head1 :: rest1, head2 :: rest2, (head3 :: rest3, head4 :: rest4)) -> + map4Help f rest1 rest2 rest3 rest4 (cons (f head1 head2 head3 head4) ys) + _ -> + ys + + +map5Help : (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result -> List result +map5Help f xs1 xs2 xs3 xs4 xs5 ys = + case (xs1, xs2, (xs3, xs4, xs5)) of + (head1 :: rest1, head2 :: rest2, (head3 :: rest3, head4 :: rest4, head5 :: rest5)) -> + map5Help f rest1 rest2 rest3 rest4 rest5 (cons (f head1 head2 head3 head4 head5) ys) + _ -> + ys + + +suite : Benchmark +suite = + let + sampleList = + List.range 0 4999 + in + describe "mapping" + [ Benchmark.compare "map2" + "no kernel" + (\_ -> map2 (\a b -> a + b) sampleList sampleList) + "core" + (\_ -> List.map2 (\a b -> a + b) sampleList sampleList) + , Benchmark.compare "map3" + "no kernel" + (\_ -> map3 (\a b c -> a + b + c) sampleList sampleList sampleList) + "core" + (\_ -> List.map3 (\a b c -> a + b + c) sampleList sampleList sampleList) + , Benchmark.compare "map4" + "no kernel" + (\_ -> map4 (\a b c d -> a + b + c + d) sampleList sampleList sampleList sampleList) + "core" + (\_ -> List.map4 (\a b c d -> a + b + c + d) sampleList sampleList sampleList sampleList) + , Benchmark.compare "map5" + "no kernel" + (\_ -> map5 (\a b c d e -> a + b + c + d + e) sampleList sampleList sampleList sampleList sampleList) + "core" + (\_ -> List.map5 (\a b c d e -> a + b + c + d + e) sampleList sampleList sampleList sampleList sampleList) + ] diff --git a/custom-core.sh b/custom-core.sh new file mode 100755 index 00000000..8f72454e --- /dev/null +++ b/custom-core.sh @@ -0,0 +1,52 @@ +#! /usr/bin/env bash + +set -o errexit; +set -o nounset; + +if [[ ! -v ELM_HOME ]]; then + printf "Please set ELM_HOME!\n" + exit 1 +fi + +printf "Sucess if ends with DONE: " + +ELM="${ELM:-elm}" +ELM_VERSION="$($ELM --version)" + +cd $1 + +CORE_VERSIONS_DIR="$ELM_HOME/$ELM_VERSION/packages/elm/core" + +if [[ -d "$CORE_VERSIONS_DIR" ]]; then + + CORE_VERSION_COUNT=$(ls "$CORE_VERSIONS_DIR" | wc -l) + CORE_VERSION=$(ls "$CORE_VERSIONS_DIR") + CORE_PACKAGE_DIR="$CORE_VERSIONS_DIR/$CORE_VERSION" + + if [ $CORE_VERSION_COUNT == 1 ] && \ + [[ -f $CORE_PACKAGE_DIR/custom ]] && \ + [[ -d "$ELM_HOME/$ELM_VERSION/packages/elm/time" ]] && \ + [[ -d "$ELM_HOME/$ELM_VERSION/packages/elm/random" ]] ; then + printf "REFRESH " + else + printf "INIT " + ./init-elm-home.sh > /dev/null + fi +else + printf "INIT " + ./init-elm-home.sh > /dev/null +fi + +CORE_VERSION=$(ls $CORE_VERSIONS_DIR) +CORE_PACKAGE_DIR="$CORE_VERSIONS_DIR/$CORE_VERSION" + +./stub.py "$ELM_HOME/$ELM_VERSION/packages/elm/time" +./stub.py "$ELM_HOME/$ELM_VERSION/packages/elm/random" + +rm -rf "$CORE_PACKAGE_DIR" > /dev/null +mkdir "$CORE_PACKAGE_DIR" +cp -r src "$CORE_PACKAGE_DIR"/ > /dev/null +cp -r elm.json "$CORE_PACKAGE_DIR"/ > /dev/null +touch "$CORE_PACKAGE_DIR/custom" + +printf "DONE\n" diff --git a/design-documents/OperatorExample.elm b/design-documents/OperatorExample.elm new file mode 100644 index 00000000..f544a9e0 --- /dev/null +++ b/design-documents/OperatorExample.elm @@ -0,0 +1,33 @@ +module OperatorExample exposing (..) + +import Platform + + +compositionExample : (Float -> Float -> Float) +compositionExample x = + mean 6 + >> mean x + + +mean : Float -> Float -> Float +mean a b = + (a + b) / 2 + + +ident : Bool -> Bool +ident b = + not (not b) + + +main = + let + m = compositionExample 21 4 + + _ = ident True + in + + Platform.worker + { init = \() -> (m, Cmd.none) + , update = \model _ -> (model, Cmd.none) + , subscriptions = \_ -> Sub.none + } diff --git a/design-documents/elm-minimal-master/.gitignore b/design-documents/elm-minimal-master/.gitignore new file mode 100644 index 00000000..aee98106 --- /dev/null +++ b/design-documents/elm-minimal-master/.gitignore @@ -0,0 +1 @@ +/elm-stuff/ diff --git a/design-documents/elm-minimal-master/elm.json b/design-documents/elm-minimal-master/elm.json new file mode 100644 index 00000000..fd754fc7 --- /dev/null +++ b/design-documents/elm-minimal-master/elm.json @@ -0,0 +1,24 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.1", + "elm/core": "1.0.2", + "elm/html": "1.0.0" + }, + "indirect": { + "elm/json": "1.1.3", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/design-documents/elm-minimal-master/main.js b/design-documents/elm-minimal-master/main.js new file mode 100644 index 00000000..a99c5992 --- /dev/null +++ b/design-documents/elm-minimal-master/main.js @@ -0,0 +1,2832 @@ +(function(scope){ +'use strict'; + +function F(arity, fun, wrapper) { + wrapper.a = arity; + wrapper.f = fun; + return wrapper; +} + +function F2(fun) { + return F(2, fun, function(a) { return function(b) { return fun(a,b); }; }) +} +function F3(fun) { + return F(3, fun, function(a) { + return function(b) { return function(c) { return fun(a, b, c); }; }; + }); +} +function F4(fun) { + return F(4, fun, function(a) { return function(b) { return function(c) { + return function(d) { return fun(a, b, c, d); }; }; }; + }); +} +function F5(fun) { + return F(5, fun, function(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return fun(a, b, c, d, e); }; }; }; }; + }); +} +function F6(fun) { + return F(6, fun, function(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return fun(a, b, c, d, e, f); }; }; }; }; }; + }); +} +function F7(fun) { + return F(7, fun, function(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return function(g) { return fun(a, b, c, d, e, f, g); }; }; }; }; }; }; + }); +} +function F8(fun) { + return F(8, fun, function(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return function(g) { return function(h) { + return fun(a, b, c, d, e, f, g, h); }; }; }; }; }; }; }; + }); +} +function F9(fun) { + return F(9, fun, function(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return function(g) { return function(h) { return function(i) { + return fun(a, b, c, d, e, f, g, h, i); }; }; }; }; }; }; }; }; + }); +} + +function A2(fun, a, b) { + return fun.a === 2 ? fun.f(a, b) : fun(a)(b); +} +function A3(fun, a, b, c) { + return fun.a === 3 ? fun.f(a, b, c) : fun(a)(b)(c); +} +function A4(fun, a, b, c, d) { + return fun.a === 4 ? fun.f(a, b, c, d) : fun(a)(b)(c)(d); +} +function A5(fun, a, b, c, d, e) { + return fun.a === 5 ? fun.f(a, b, c, d, e) : fun(a)(b)(c)(d)(e); +} +function A6(fun, a, b, c, d, e, f) { + return fun.a === 6 ? fun.f(a, b, c, d, e, f) : fun(a)(b)(c)(d)(e)(f); +} +function A7(fun, a, b, c, d, e, f, g) { + return fun.a === 7 ? fun.f(a, b, c, d, e, f, g) : fun(a)(b)(c)(d)(e)(f)(g); +} +function A8(fun, a, b, c, d, e, f, g, h) { + return fun.a === 8 ? fun.f(a, b, c, d, e, f, g, h) : fun(a)(b)(c)(d)(e)(f)(g)(h); +} +function A9(fun, a, b, c, d, e, f, g, h, i) { + return fun.a === 9 ? fun.f(a, b, c, d, e, f, g, h, i) : fun(a)(b)(c)(d)(e)(f)(g)(h)(i); +} + +console.warn('Compiled in DEV mode. Follow the advice at https://elm-lang.org/0.19.1/optimize for better performance and smaller assets.'); + + +var _List_Nil_UNUSED = { $: 0 }; +var _List_Nil = { $: '[]' }; + +function _List_Cons_UNUSED(hd, tl) { return { $: 1, a: hd, b: tl }; } +function _List_Cons(hd, tl) { return { $: '::', a: hd, b: tl }; } + + +var _List_cons = F2(_List_Cons); + +function _List_fromArray(arr) +{ + var out = _List_Nil; + for (var i = arr.length; i--; ) + { + out = _List_Cons(arr[i], out); + } + return out; +} + +function _List_toArray(xs) +{ + for (var out = []; xs.b; xs = xs.b) // WHILE_CONS + { + out.push(xs.a); + } + return out; +} + +var _List_map2 = F3(function(f, xs, ys) +{ + for (var arr = []; xs.b && ys.b; xs = xs.b, ys = ys.b) // WHILE_CONSES + { + arr.push(A2(f, xs.a, ys.a)); + } + return _List_fromArray(arr); +}); + +var _List_map3 = F4(function(f, xs, ys, zs) +{ + for (var arr = []; xs.b && ys.b && zs.b; xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES + { + arr.push(A3(f, xs.a, ys.a, zs.a)); + } + return _List_fromArray(arr); +}); + +var _List_map4 = F5(function(f, ws, xs, ys, zs) +{ + for (var arr = []; ws.b && xs.b && ys.b && zs.b; ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES + { + arr.push(A4(f, ws.a, xs.a, ys.a, zs.a)); + } + return _List_fromArray(arr); +}); + +var _List_map5 = F6(function(f, vs, ws, xs, ys, zs) +{ + for (var arr = []; vs.b && ws.b && xs.b && ys.b && zs.b; vs = vs.b, ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES + { + arr.push(A5(f, vs.a, ws.a, xs.a, ys.a, zs.a)); + } + return _List_fromArray(arr); +}); + +var _List_sortBy = F2(function(f, xs) +{ + return _List_fromArray(_List_toArray(xs).sort(function(a, b) { + return _Utils_cmp(f(a), f(b)); + })); +}); + +var _List_sortWith = F2(function(f, xs) +{ + return _List_fromArray(_List_toArray(xs).sort(function(a, b) { + var ord = A2(f, a, b); + return ord === $elm$core$Basics$EQ ? 0 : ord === $elm$core$Basics$LT ? -1 : 1; + })); +}); + + + +var _JsArray_empty = []; + +function _JsArray_singleton(value) +{ + return [value]; +} + +function _JsArray_length(array) +{ + return array.length; +} + +var _JsArray_initialize = F3(function(size, offset, func) +{ + var result = new Array(size); + + for (var i = 0; i < size; i++) + { + result[i] = func(offset + i); + } + + return result; +}); + +var _JsArray_initializeFromList = F2(function (max, ls) +{ + var result = new Array(max); + + for (var i = 0; i < max && ls.b; i++) + { + result[i] = ls.a; + ls = ls.b; + } + + result.length = i; + return _Utils_Tuple2(result, ls); +}); + +var _JsArray_unsafeGet = F2(function(index, array) +{ + return array[index]; +}); + +var _JsArray_unsafeSet = F3(function(index, value, array) +{ + var length = array.length; + var result = new Array(length); + + for (var i = 0; i < length; i++) + { + result[i] = array[i]; + } + + result[index] = value; + return result; +}); + +var _JsArray_push = F2(function(value, array) +{ + var length = array.length; + var result = new Array(length + 1); + + for (var i = 0; i < length; i++) + { + result[i] = array[i]; + } + + result[length] = value; + return result; +}); + +var _JsArray_foldl = F3(function(func, acc, array) +{ + var length = array.length; + + for (var i = 0; i < length; i++) + { + acc = A2(func, array[i], acc); + } + + return acc; +}); + +var _JsArray_foldr = F3(function(func, acc, array) +{ + for (var i = array.length - 1; i >= 0; i--) + { + acc = A2(func, array[i], acc); + } + + return acc; +}); + +var _JsArray_map = F2(function(func, array) +{ + var length = array.length; + var result = new Array(length); + + for (var i = 0; i < length; i++) + { + result[i] = func(array[i]); + } + + return result; +}); + +var _JsArray_indexedMap = F3(function(func, offset, array) +{ + var length = array.length; + var result = new Array(length); + + for (var i = 0; i < length; i++) + { + result[i] = A2(func, offset + i, array[i]); + } + + return result; +}); + +var _JsArray_slice = F3(function(from, to, array) +{ + return array.slice(from, to); +}); + +var _JsArray_appendN = F3(function(n, dest, source) +{ + var destLen = dest.length; + var itemsToCopy = n - destLen; + + if (itemsToCopy > source.length) + { + itemsToCopy = source.length; + } + + var size = destLen + itemsToCopy; + var result = new Array(size); + + for (var i = 0; i < destLen; i++) + { + result[i] = dest[i]; + } + + for (var i = 0; i < itemsToCopy; i++) + { + result[i + destLen] = source[i]; + } + + return result; +}); + + + +// LOG + +var _Debug_log_UNUSED = F2(function(tag, value) +{ + return value; +}); + +var _Debug_log = F2(function(tag, value) +{ + console.log(tag + ': ' + _Debug_toString(value)); + return value; +}); + + +// TODOS + +function _Debug_todo(moduleName, region) +{ + return function(message) { + _Debug_crash(8, moduleName, region, message); + }; +} + +function _Debug_todoCase(moduleName, region, value) +{ + return function(message) { + _Debug_crash(9, moduleName, region, value, message); + }; +} + + +// TO STRING + +function _Debug_toString_UNUSED(value) +{ + return ''; +} + +function _Debug_toString(value) +{ + return _Debug_toAnsiString(false, value); +} + +function _Debug_toAnsiString(ansi, value) +{ + if (typeof value === 'function') + { + return _Debug_internalColor(ansi, ''); + } + + if (typeof value === 'boolean') + { + return _Debug_ctorColor(ansi, value ? 'True' : 'False'); + } + + if (typeof value === 'number') + { + return _Debug_numberColor(ansi, value + ''); + } + + if (value instanceof String) + { + return _Debug_charColor(ansi, "'" + _Debug_addSlashes(value, true) + "'"); + } + + if (typeof value === 'string') + { + return _Debug_stringColor(ansi, '"' + _Debug_addSlashes(value, false) + '"'); + } + + if (typeof value === 'object' && '$' in value) + { + var tag = value.$; + + if (typeof tag === 'number') + { + return _Debug_internalColor(ansi, ''); + } + + if (tag[0] === '#') + { + var output = []; + for (var k in value) + { + if (k === '$') continue; + output.push(_Debug_toAnsiString(ansi, value[k])); + } + return '(' + output.join(',') + ')'; + } + + if (tag === 'Set_elm_builtin') + { + return _Debug_ctorColor(ansi, 'Set') + + _Debug_fadeColor(ansi, '.fromList') + ' ' + + _Debug_toAnsiString(ansi, $elm$core$Set$toList(value)); + } + + if (tag === 'RBNode_elm_builtin' || tag === 'RBEmpty_elm_builtin') + { + return _Debug_ctorColor(ansi, 'Dict') + + _Debug_fadeColor(ansi, '.fromList') + ' ' + + _Debug_toAnsiString(ansi, $elm$core$Dict$toList(value)); + } + + if (tag === 'Array_elm_builtin') + { + return _Debug_ctorColor(ansi, 'Array') + + _Debug_fadeColor(ansi, '.fromList') + ' ' + + _Debug_toAnsiString(ansi, $elm$core$Array$toList(value)); + } + + if (tag === '::' || tag === '[]') + { + var output = '['; + + value.b && (output += _Debug_toAnsiString(ansi, value.a), value = value.b) + + for (; value.b; value = value.b) // WHILE_CONS + { + output += ',' + _Debug_toAnsiString(ansi, value.a); + } + return output + ']'; + } + + var output = ''; + for (var i in value) + { + if (i === '$') continue; + var str = _Debug_toAnsiString(ansi, value[i]); + var c0 = str[0]; + var parenless = c0 === '{' || c0 === '(' || c0 === '[' || c0 === '<' || c0 === '"' || str.indexOf(' ') < 0; + output += ' ' + (parenless ? str : '(' + str + ')'); + } + return _Debug_ctorColor(ansi, tag) + output; + } + + if (typeof DataView === 'function' && value instanceof DataView) + { + return _Debug_stringColor(ansi, '<' + value.byteLength + ' bytes>'); + } + + if (typeof File === 'function' && value instanceof File) + { + return _Debug_internalColor(ansi, '<' + value.name + '>'); + } + + if (typeof value === 'object') + { + var output = []; + for (var key in value) + { + var field = key[0] === '_' ? key.slice(1) : key; + output.push(_Debug_fadeColor(ansi, field) + ' = ' + _Debug_toAnsiString(ansi, value[key])); + } + if (output.length === 0) + { + return '{}'; + } + return '{ ' + output.join(', ') + ' }'; + } + + return _Debug_internalColor(ansi, ''); +} + +function _Debug_addSlashes(str, isChar) +{ + var s = str + .replace(/\\/g, '\\\\') + .replace(/\n/g, '\\n') + .replace(/\t/g, '\\t') + .replace(/\r/g, '\\r') + .replace(/\v/g, '\\v') + .replace(/\0/g, '\\0'); + + if (isChar) + { + return s.replace(/\'/g, '\\\''); + } + else + { + return s.replace(/\"/g, '\\"'); + } +} + +function _Debug_ctorColor(ansi, string) +{ + return ansi ? '\x1b[96m' + string + '\x1b[0m' : string; +} + +function _Debug_numberColor(ansi, string) +{ + return ansi ? '\x1b[95m' + string + '\x1b[0m' : string; +} + +function _Debug_stringColor(ansi, string) +{ + return ansi ? '\x1b[93m' + string + '\x1b[0m' : string; +} + +function _Debug_charColor(ansi, string) +{ + return ansi ? '\x1b[92m' + string + '\x1b[0m' : string; +} + +function _Debug_fadeColor(ansi, string) +{ + return ansi ? '\x1b[37m' + string + '\x1b[0m' : string; +} + +function _Debug_internalColor(ansi, string) +{ + return ansi ? '\x1b[94m' + string + '\x1b[0m' : string; +} + +function _Debug_toHexDigit(n) +{ + return String.fromCharCode(n < 10 ? 48 + n : 55 + n); +} + + +// CRASH + + +function _Debug_crash_UNUSED(identifier) +{ + throw new Error('https://github.com/elm/core/blob/1.0.0/hints/' + identifier + '.md'); +} + + +function _Debug_crash(identifier, fact1, fact2, fact3, fact4) +{ + switch(identifier) + { + case 0: + throw new Error('What node should I take over? In JavaScript I need something like:\n\n Elm.Main.init({\n node: document.getElementById("elm-node")\n })\n\nYou need to do this with any Browser.sandbox or Browser.element program.'); + + case 1: + throw new Error('Browser.application programs cannot handle URLs like this:\n\n ' + document.location.href + '\n\nWhat is the root? The root of your file system? Try looking at this program with `elm reactor` or some other server.'); + + case 2: + var jsonErrorString = fact1; + throw new Error('Problem with the flags given to your Elm program on initialization.\n\n' + jsonErrorString); + + case 3: + var portName = fact1; + throw new Error('There can only be one port named `' + portName + '`, but your program has multiple.'); + + case 4: + var portName = fact1; + var problem = fact2; + throw new Error('Trying to send an unexpected type of value through port `' + portName + '`:\n' + problem); + + case 5: + throw new Error('Trying to use `(==)` on functions.\nThere is no way to know if functions are "the same" in the Elm sense.\nRead more about this at https://package.elm-lang.org/packages/elm/core/latest/Basics#== which describes why it is this way and what the better version will look like.'); + + case 6: + var moduleName = fact1; + throw new Error('Your page is loading multiple Elm scripts with a module named ' + moduleName + '. Maybe a duplicate script is getting loaded accidentally? If not, rename one of them so I know which is which!'); + + case 8: + var moduleName = fact1; + var region = fact2; + var message = fact3; + throw new Error('TODO in module `' + moduleName + '` ' + _Debug_regionToString(region) + '\n\n' + message); + + case 9: + var moduleName = fact1; + var region = fact2; + var value = fact3; + var message = fact4; + throw new Error( + 'TODO in module `' + moduleName + '` from the `case` expression ' + + _Debug_regionToString(region) + '\n\nIt received the following value:\n\n ' + + _Debug_toString(value).replace('\n', '\n ') + + '\n\nBut the branch that handles it says:\n\n ' + message.replace('\n', '\n ') + ); + + case 10: + throw new Error('Bug in https://github.com/elm/virtual-dom/issues'); + + case 11: + throw new Error('Cannot perform mod 0. Division by zero error.'); + } +} + +function _Debug_regionToString(region) +{ + if (region.start.line === region.end.line) + { + return 'on line ' + region.start.line; + } + return 'on lines ' + region.start.line + ' through ' + region.end.line; +} + + + +// EQUALITY + +function _Utils_eq(x, y) +{ + for ( + var pair, stack = [], isEqual = _Utils_eqHelp(x, y, 0, stack); + isEqual && (pair = stack.pop()); + isEqual = _Utils_eqHelp(pair.a, pair.b, 0, stack) + ) + {} + + return isEqual; +} + +function _Utils_eqHelp(x, y, depth, stack) +{ + if (depth > 100) + { + stack.push(_Utils_Tuple2(x,y)); + return true; + } + + if (x === y) + { + return true; + } + + if (typeof x !== 'object' || x === null || y === null) + { + typeof x === 'function' && _Debug_crash(5); + return false; + } + + /**/ + if (x.$ === 'Set_elm_builtin') + { + x = $elm$core$Set$toList(x); + y = $elm$core$Set$toList(y); + } + if (x.$ === 'RBNode_elm_builtin' || x.$ === 'RBEmpty_elm_builtin') + { + x = $elm$core$Dict$toList(x); + y = $elm$core$Dict$toList(y); + } + //*/ + + /**_UNUSED/ + if (x.$ < 0) + { + x = $elm$core$Dict$toList(x); + y = $elm$core$Dict$toList(y); + } + //*/ + + for (var key in x) + { + if (!_Utils_eqHelp(x[key], y[key], depth + 1, stack)) + { + return false; + } + } + return true; +} + +var _Utils_equal = F2(_Utils_eq); +var _Utils_notEqual = F2(function(a, b) { return !_Utils_eq(a,b); }); + + + +// COMPARISONS + +// Code in Generate/JavaScript.hs, Basics.js, and List.js depends on +// the particular integer values assigned to LT, EQ, and GT. + +function _Utils_cmp(x, y, ord) +{ + if (typeof x !== 'object') + { + return x === y ? /*EQ*/ 0 : x < y ? /*LT*/ -1 : /*GT*/ 1; + } + + /**/ + if (x instanceof String) + { + var a = x.valueOf(); + var b = y.valueOf(); + return a === b ? 0 : a < b ? -1 : 1; + } + //*/ + + /**_UNUSED/ + if (typeof x.$ === 'undefined') + //*/ + /**/ + if (x.$[0] === '#') + //*/ + { + return (ord = _Utils_cmp(x.a, y.a)) + ? ord + : (ord = _Utils_cmp(x.b, y.b)) + ? ord + : _Utils_cmp(x.c, y.c); + } + + // traverse conses until end of a list or a mismatch + for (; x.b && y.b && !(ord = _Utils_cmp(x.a, y.a)); x = x.b, y = y.b) {} // WHILE_CONSES + return ord || (x.b ? /*GT*/ 1 : y.b ? /*LT*/ -1 : /*EQ*/ 0); +} + +var _Utils_lt = F2(function(a, b) { return _Utils_cmp(a, b) < 0; }); +var _Utils_le = F2(function(a, b) { return _Utils_cmp(a, b) < 1; }); +var _Utils_gt = F2(function(a, b) { return _Utils_cmp(a, b) > 0; }); +var _Utils_ge = F2(function(a, b) { return _Utils_cmp(a, b) >= 0; }); + +var _Utils_compare = F2(function(x, y) +{ + var n = _Utils_cmp(x, y); + return n < 0 ? $elm$core$Basics$LT : n ? $elm$core$Basics$GT : $elm$core$Basics$EQ; +}); + + +// COMMON VALUES + +var _Utils_Tuple0_UNUSED = 0; +var _Utils_Tuple0 = { $: '#0' }; + +function _Utils_Tuple2_UNUSED(a, b) { return { a: a, b: b }; } +function _Utils_Tuple2(a, b) { return { $: '#2', a: a, b: b }; } + +function _Utils_Tuple3_UNUSED(a, b, c) { return { a: a, b: b, c: c }; } +function _Utils_Tuple3(a, b, c) { return { $: '#3', a: a, b: b, c: c }; } + +function _Utils_chr_UNUSED(c) { return c; } +function _Utils_chr(c) { return new String(c); } + + +// RECORDS + +function _Utils_update(oldRecord, updatedFields) +{ + var newRecord = {}; + + for (var key in oldRecord) + { + newRecord[key] = oldRecord[key]; + } + + for (var key in updatedFields) + { + newRecord[key] = updatedFields[key]; + } + + return newRecord; +} + + +// APPEND + +var _Utils_append = F2(_Utils_ap); + +function _Utils_ap(xs, ys) +{ + // append Strings + if (typeof xs === 'string') + { + return xs + ys; + } + + // append Lists + if (!xs.b) + { + return ys; + } + var root = _List_Cons(xs.a, ys); + xs = xs.b + for (var curr = root; xs.b; xs = xs.b) // WHILE_CONS + { + curr = curr.b = _List_Cons(xs.a, ys); + } + return root; +} + + + +// MATH + +var _Basics_add = F2(function(a, b) { return a + b; }); +var _Basics_sub = F2(function(a, b) { return a - b; }); +var _Basics_mul = F2(function(a, b) { return a * b; }); +var _Basics_fdiv = F2(function(a, b) { return a / b; }); +var _Basics_idiv = F2(function(a, b) { return (a / b) | 0; }); +var _Basics_pow = F2(Math.pow); + +var _Basics_remainderBy = F2(function(b, a) { return a % b; }); + +// https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf +var _Basics_modBy = F2(function(modulus, x) +{ + var answer = x % modulus; + return modulus === 0 + ? _Debug_crash(11) + : + ((answer > 0 && modulus < 0) || (answer < 0 && modulus > 0)) + ? answer + modulus + : answer; +}); + + +// TRIGONOMETRY + +var _Basics_pi = Math.PI; +var _Basics_e = Math.E; +var _Basics_cos = Math.cos; +var _Basics_sin = Math.sin; +var _Basics_tan = Math.tan; +var _Basics_acos = Math.acos; +var _Basics_asin = Math.asin; +var _Basics_atan = Math.atan; +var _Basics_atan2 = F2(Math.atan2); + + +// MORE MATH + +function _Basics_toFloat(x) { return x; } +function _Basics_truncate(n) { return n | 0; } +function _Basics_isInfinite(n) { return n === Infinity || n === -Infinity; } + +var _Basics_ceiling = Math.ceil; +var _Basics_floor = Math.floor; +var _Basics_round = Math.round; +var _Basics_sqrt = Math.sqrt; +var _Basics_log = Math.log; +var _Basics_isNaN = isNaN; + + +// BOOLEANS + +function _Basics_not(bool) { return !bool; } +var _Basics_and = F2(function(a, b) { return a && b; }); +var _Basics_or = F2(function(a, b) { return a || b; }); +var _Basics_xor = F2(function(a, b) { return a !== b; }); + + + +var _String_cons = F2(function(chr, str) +{ + return chr + str; +}); + +function _String_uncons(string) +{ + var word = string.charCodeAt(0); + return word + ? $elm$core$Maybe$Just( + 0xD800 <= word && word <= 0xDBFF + ? _Utils_Tuple2(_Utils_chr(string[0] + string[1]), string.slice(2)) + : _Utils_Tuple2(_Utils_chr(string[0]), string.slice(1)) + ) + : $elm$core$Maybe$Nothing; +} + +var _String_append = F2(function(a, b) +{ + return a + b; +}); + +function _String_length(str) +{ + return str.length; +} + +var _String_map = F2(function(func, string) +{ + var len = string.length; + var array = new Array(len); + var i = 0; + while (i < len) + { + var word = string.charCodeAt(i); + if (0xD800 <= word && word <= 0xDBFF) + { + array[i] = func(_Utils_chr(string[i] + string[i+1])); + i += 2; + continue; + } + array[i] = func(_Utils_chr(string[i])); + i++; + } + return array.join(''); +}); + +var _String_filter = F2(function(isGood, str) +{ + var arr = []; + var len = str.length; + var i = 0; + while (i < len) + { + var char = str[i]; + var word = str.charCodeAt(i); + i++; + if (0xD800 <= word && word <= 0xDBFF) + { + char += str[i]; + i++; + } + + if (isGood(_Utils_chr(char))) + { + arr.push(char); + } + } + return arr.join(''); +}); + +function _String_reverse(str) +{ + var len = str.length; + var arr = new Array(len); + var i = 0; + while (i < len) + { + var word = str.charCodeAt(i); + if (0xD800 <= word && word <= 0xDBFF) + { + arr[len - i] = str[i + 1]; + i++; + arr[len - i] = str[i - 1]; + i++; + } + else + { + arr[len - i] = str[i]; + i++; + } + } + return arr.join(''); +} + +var _String_foldl = F3(function(func, state, string) +{ + var len = string.length; + var i = 0; + while (i < len) + { + var char = string[i]; + var word = string.charCodeAt(i); + i++; + if (0xD800 <= word && word <= 0xDBFF) + { + char += string[i]; + i++; + } + state = A2(func, _Utils_chr(char), state); + } + return state; +}); + +var _String_foldr = F3(function(func, state, string) +{ + var i = string.length; + while (i--) + { + var char = string[i]; + var word = string.charCodeAt(i); + if (0xDC00 <= word && word <= 0xDFFF) + { + i--; + char = string[i] + char; + } + state = A2(func, _Utils_chr(char), state); + } + return state; +}); + +var _String_split = F2(function(sep, str) +{ + return str.split(sep); +}); + +var _String_join = F2(function(sep, strs) +{ + return strs.join(sep); +}); + +var _String_slice = F3(function(start, end, str) { + return str.slice(start, end); +}); + +function _String_trim(str) +{ + return str.trim(); +} + +function _String_trimLeft(str) +{ + return str.replace(/^\s+/, ''); +} + +function _String_trimRight(str) +{ + return str.replace(/\s+$/, ''); +} + +function _String_words(str) +{ + return _List_fromArray(str.trim().split(/\s+/g)); +} + +function _String_lines(str) +{ + return _List_fromArray(str.split(/\r\n|\r|\n/g)); +} + +function _String_toUpper(str) +{ + return str.toUpperCase(); +} + +function _String_toLower(str) +{ + return str.toLowerCase(); +} + +var _String_any = F2(function(isGood, string) +{ + var i = string.length; + while (i--) + { + var char = string[i]; + var word = string.charCodeAt(i); + if (0xDC00 <= word && word <= 0xDFFF) + { + i--; + char = string[i] + char; + } + if (isGood(_Utils_chr(char))) + { + return true; + } + } + return false; +}); + +var _String_all = F2(function(isGood, string) +{ + var i = string.length; + while (i--) + { + var char = string[i]; + var word = string.charCodeAt(i); + if (0xDC00 <= word && word <= 0xDFFF) + { + i--; + char = string[i] + char; + } + if (!isGood(_Utils_chr(char))) + { + return false; + } + } + return true; +}); + +var _String_contains = F2(function(sub, str) +{ + return str.indexOf(sub) > -1; +}); + +var _String_startsWith = F2(function(sub, str) +{ + return str.indexOf(sub) === 0; +}); + +var _String_endsWith = F2(function(sub, str) +{ + return str.length >= sub.length && + str.lastIndexOf(sub) === str.length - sub.length; +}); + +var _String_indexes = F2(function(sub, str) +{ + var subLen = sub.length; + + if (subLen < 1) + { + return _List_Nil; + } + + var i = 0; + var is = []; + + while ((i = str.indexOf(sub, i)) > -1) + { + is.push(i); + i = i + subLen; + } + + return _List_fromArray(is); +}); + + +// TO STRING + +function _String_fromNumber(number) +{ + return number + ''; +} + + +// INT CONVERSIONS + +function _String_toInt(str) +{ + var total = 0; + var code0 = str.charCodeAt(0); + var start = code0 == 0x2B /* + */ || code0 == 0x2D /* - */ ? 1 : 0; + + for (var i = start; i < str.length; ++i) + { + var code = str.charCodeAt(i); + if (code < 0x30 || 0x39 < code) + { + return $elm$core$Maybe$Nothing; + } + total = 10 * total + code - 0x30; + } + + return i == start + ? $elm$core$Maybe$Nothing + : $elm$core$Maybe$Just(code0 == 0x2D ? -total : total); +} + + +// FLOAT CONVERSIONS + +function _String_toFloat(s) +{ + // check if it is a hex, octal, or binary number + if (s.length === 0 || /[\sxbo]/.test(s)) + { + return $elm$core$Maybe$Nothing; + } + var n = +s; + // faster isNaN check + return n === n ? $elm$core$Maybe$Just(n) : $elm$core$Maybe$Nothing; +} + +function _String_fromList(chars) +{ + return _List_toArray(chars).join(''); +} + + + + +function _Char_toCode(char) +{ + var code = char.charCodeAt(0); + if (0xD800 <= code && code <= 0xDBFF) + { + return (code - 0xD800) * 0x400 + char.charCodeAt(1) - 0xDC00 + 0x10000 + } + return code; +} + +function _Char_fromCode(code) +{ + return _Utils_chr( + (code < 0 || 0x10FFFF < code) + ? '\uFFFD' + : + (code <= 0xFFFF) + ? String.fromCharCode(code) + : + (code -= 0x10000, + String.fromCharCode(Math.floor(code / 0x400) + 0xD800, code % 0x400 + 0xDC00) + ) + ); +} + +function _Char_toUpper(char) +{ + return _Utils_chr(char.toUpperCase()); +} + +function _Char_toLower(char) +{ + return _Utils_chr(char.toLowerCase()); +} + +function _Char_toLocaleUpper(char) +{ + return _Utils_chr(char.toLocaleUpperCase()); +} + +function _Char_toLocaleLower(char) +{ + return _Utils_chr(char.toLocaleLowerCase()); +} + + + +/**/ +function _Json_errorToString(error) +{ + return $elm$json$Json$Decode$errorToString(error); +} +//*/ + + +// CORE DECODERS + +function _Json_succeed(msg) +{ + return { + $: 0, + a: msg + }; +} + +function _Json_fail(msg) +{ + return { + $: 1, + a: msg + }; +} + +function _Json_decodePrim(decoder) +{ + return { $: 2, b: decoder }; +} + +var _Json_decodeInt = _Json_decodePrim(function(value) { + return (typeof value !== 'number') + ? _Json_expecting('an INT', value) + : + (-2147483647 < value && value < 2147483647 && (value | 0) === value) + ? $elm$core$Result$Ok(value) + : + (isFinite(value) && !(value % 1)) + ? $elm$core$Result$Ok(value) + : _Json_expecting('an INT', value); +}); + +var _Json_decodeBool = _Json_decodePrim(function(value) { + return (typeof value === 'boolean') + ? $elm$core$Result$Ok(value) + : _Json_expecting('a BOOL', value); +}); + +var _Json_decodeFloat = _Json_decodePrim(function(value) { + return (typeof value === 'number') + ? $elm$core$Result$Ok(value) + : _Json_expecting('a FLOAT', value); +}); + +var _Json_decodeValue = _Json_decodePrim(function(value) { + return $elm$core$Result$Ok(_Json_wrap(value)); +}); + +var _Json_decodeString = _Json_decodePrim(function(value) { + return (typeof value === 'string') + ? $elm$core$Result$Ok(value) + : (value instanceof String) + ? $elm$core$Result$Ok(value + '') + : _Json_expecting('a STRING', value); +}); + +function _Json_decodeList(decoder) { return { $: 3, b: decoder }; } +function _Json_decodeArray(decoder) { return { $: 4, b: decoder }; } + +function _Json_decodeNull(value) { return { $: 5, c: value }; } + +var _Json_decodeField = F2(function(field, decoder) +{ + return { + $: 6, + d: field, + b: decoder + }; +}); + +var _Json_decodeIndex = F2(function(index, decoder) +{ + return { + $: 7, + e: index, + b: decoder + }; +}); + +function _Json_decodeKeyValuePairs(decoder) +{ + return { + $: 8, + b: decoder + }; +} + +function _Json_mapMany(f, decoders) +{ + return { + $: 9, + f: f, + g: decoders + }; +} + +var _Json_andThen = F2(function(callback, decoder) +{ + return { + $: 10, + b: decoder, + h: callback + }; +}); + +function _Json_oneOf(decoders) +{ + return { + $: 11, + g: decoders + }; +} + + +// DECODING OBJECTS + +var _Json_map1 = F2(function(f, d1) +{ + return _Json_mapMany(f, [d1]); +}); + +var _Json_map2 = F3(function(f, d1, d2) +{ + return _Json_mapMany(f, [d1, d2]); +}); + +var _Json_map3 = F4(function(f, d1, d2, d3) +{ + return _Json_mapMany(f, [d1, d2, d3]); +}); + +var _Json_map4 = F5(function(f, d1, d2, d3, d4) +{ + return _Json_mapMany(f, [d1, d2, d3, d4]); +}); + +var _Json_map5 = F6(function(f, d1, d2, d3, d4, d5) +{ + return _Json_mapMany(f, [d1, d2, d3, d4, d5]); +}); + +var _Json_map6 = F7(function(f, d1, d2, d3, d4, d5, d6) +{ + return _Json_mapMany(f, [d1, d2, d3, d4, d5, d6]); +}); + +var _Json_map7 = F8(function(f, d1, d2, d3, d4, d5, d6, d7) +{ + return _Json_mapMany(f, [d1, d2, d3, d4, d5, d6, d7]); +}); + +var _Json_map8 = F9(function(f, d1, d2, d3, d4, d5, d6, d7, d8) +{ + return _Json_mapMany(f, [d1, d2, d3, d4, d5, d6, d7, d8]); +}); + + +// DECODE + +var _Json_runOnString = F2(function(decoder, string) +{ + try + { + var value = JSON.parse(string); + return _Json_runHelp(decoder, value); + } + catch (e) + { + return $elm$core$Result$Err(A2($elm$json$Json$Decode$Failure, 'This is not valid JSON! ' + e.message, _Json_wrap(string))); + } +}); + +var _Json_run = F2(function(decoder, value) +{ + return _Json_runHelp(decoder, _Json_unwrap(value)); +}); + +function _Json_runHelp(decoder, value) +{ + switch (decoder.$) + { + case 2: + return decoder.b(value); + + case 5: + return (value === null) + ? $elm$core$Result$Ok(decoder.c) + : _Json_expecting('null', value); + + case 3: + if (!_Json_isArray(value)) + { + return _Json_expecting('a LIST', value); + } + return _Json_runArrayDecoder(decoder.b, value, _List_fromArray); + + case 4: + if (!_Json_isArray(value)) + { + return _Json_expecting('an ARRAY', value); + } + return _Json_runArrayDecoder(decoder.b, value, _Json_toElmArray); + + case 6: + var field = decoder.d; + if (typeof value !== 'object' || value === null || !(field in value)) + { + return _Json_expecting('an OBJECT with a field named `' + field + '`', value); + } + var result = _Json_runHelp(decoder.b, value[field]); + return ($elm$core$Result$isOk(result)) ? result : $elm$core$Result$Err(A2($elm$json$Json$Decode$Field, field, result.a)); + + case 7: + var index = decoder.e; + if (!_Json_isArray(value)) + { + return _Json_expecting('an ARRAY', value); + } + if (index >= value.length) + { + return _Json_expecting('a LONGER array. Need index ' + index + ' but only see ' + value.length + ' entries', value); + } + var result = _Json_runHelp(decoder.b, value[index]); + return ($elm$core$Result$isOk(result)) ? result : $elm$core$Result$Err(A2($elm$json$Json$Decode$Index, index, result.a)); + + case 8: + if (typeof value !== 'object' || value === null || _Json_isArray(value)) + { + return _Json_expecting('an OBJECT', value); + } + + var keyValuePairs = _List_Nil; + // TODO test perf of Object.keys and switch when support is good enough + for (var key in value) + { + if (value.hasOwnProperty(key)) + { + var result = _Json_runHelp(decoder.b, value[key]); + if (!$elm$core$Result$isOk(result)) + { + return $elm$core$Result$Err(A2($elm$json$Json$Decode$Field, key, result.a)); + } + keyValuePairs = _List_Cons(_Utils_Tuple2(key, result.a), keyValuePairs); + } + } + return $elm$core$Result$Ok($elm$core$List$reverse(keyValuePairs)); + + case 9: + var answer = decoder.f; + var decoders = decoder.g; + for (var i = 0; i < decoders.length; i++) + { + var result = _Json_runHelp(decoders[i], value); + if (!$elm$core$Result$isOk(result)) + { + return result; + } + answer = answer(result.a); + } + return $elm$core$Result$Ok(answer); + + case 10: + var result = _Json_runHelp(decoder.b, value); + return (!$elm$core$Result$isOk(result)) + ? result + : _Json_runHelp(decoder.h(result.a), value); + + case 11: + var errors = _List_Nil; + for (var temp = decoder.g; temp.b; temp = temp.b) // WHILE_CONS + { + var result = _Json_runHelp(temp.a, value); + if ($elm$core$Result$isOk(result)) + { + return result; + } + errors = _List_Cons(result.a, errors); + } + return $elm$core$Result$Err($elm$json$Json$Decode$OneOf($elm$core$List$reverse(errors))); + + case 1: + return $elm$core$Result$Err(A2($elm$json$Json$Decode$Failure, decoder.a, _Json_wrap(value))); + + case 0: + return $elm$core$Result$Ok(decoder.a); + } +} + +function _Json_runArrayDecoder(decoder, value, toElmValue) +{ + var len = value.length; + var array = new Array(len); + for (var i = 0; i < len; i++) + { + var result = _Json_runHelp(decoder, value[i]); + if (!$elm$core$Result$isOk(result)) + { + return $elm$core$Result$Err(A2($elm$json$Json$Decode$Index, i, result.a)); + } + array[i] = result.a; + } + return $elm$core$Result$Ok(toElmValue(array)); +} + +function _Json_isArray(value) +{ + return Array.isArray(value) || (typeof FileList !== 'undefined' && value instanceof FileList); +} + +function _Json_toElmArray(array) +{ + return A2($elm$core$Array$initialize, array.length, function(i) { return array[i]; }); +} + +function _Json_expecting(type, value) +{ + return $elm$core$Result$Err(A2($elm$json$Json$Decode$Failure, 'Expecting ' + type, _Json_wrap(value))); +} + + +// EQUALITY + +function _Json_equality(x, y) +{ + if (x === y) + { + return true; + } + + if (x.$ !== y.$) + { + return false; + } + + switch (x.$) + { + case 0: + case 1: + return x.a === y.a; + + case 2: + return x.b === y.b; + + case 5: + return x.c === y.c; + + case 3: + case 4: + case 8: + return _Json_equality(x.b, y.b); + + case 6: + return x.d === y.d && _Json_equality(x.b, y.b); + + case 7: + return x.e === y.e && _Json_equality(x.b, y.b); + + case 9: + return x.f === y.f && _Json_listEquality(x.g, y.g); + + case 10: + return x.h === y.h && _Json_equality(x.b, y.b); + + case 11: + return _Json_listEquality(x.g, y.g); + } +} + +function _Json_listEquality(aDecoders, bDecoders) +{ + var len = aDecoders.length; + if (len !== bDecoders.length) + { + return false; + } + for (var i = 0; i < len; i++) + { + if (!_Json_equality(aDecoders[i], bDecoders[i])) + { + return false; + } + } + return true; +} + + +// ENCODE + +var _Json_encode = F2(function(indentLevel, value) +{ + return JSON.stringify(_Json_unwrap(value), null, indentLevel) + ''; +}); + +function _Json_wrap(value) { return { $: 0, a: value }; } +function _Json_unwrap(value) { return value.a; } + +function _Json_wrap_UNUSED(value) { return value; } +function _Json_unwrap_UNUSED(value) { return value; } + +function _Json_emptyArray() { return []; } +function _Json_emptyObject() { return {}; } + +var _Json_addField = F3(function(key, value, object) +{ + object[key] = _Json_unwrap(value); + return object; +}); + +function _Json_addEntry(func) +{ + return F2(function(entry, array) + { + array.push(_Json_unwrap(func(entry))); + return array; + }); +} + +var _Json_encodeNull = _Json_wrap(null); + + + +// TASKS + +function _Scheduler_succeed(value) +{ + return { + $: 0, + a: value + }; +} + +function _Scheduler_fail(error) +{ + return { + $: 1, + a: error + }; +} + +function _Scheduler_binding(callback) +{ + return { + $: 2, + b: callback, + c: null + }; +} + +var _Scheduler_andThen = F2(function(callback, task) +{ + return { + $: 3, + b: callback, + d: task + }; +}); + +var _Scheduler_onError = F2(function(callback, task) +{ + return { + $: 4, + b: callback, + d: task + }; +}); + +function _Scheduler_receive(callback) +{ + return { + $: 5, + b: callback + }; +} + + +// PROCESSES + +var _Scheduler_guid = 0; + +function _Scheduler_rawSpawn(task) +{ + var proc = { + $: 0, + e: _Scheduler_guid++, + f: task, + g: null, + h: [] + }; + + _Scheduler_enqueue(proc); + + return proc; +} + +function _Scheduler_spawn(task) +{ + return _Scheduler_binding(function(callback) { + callback(_Scheduler_succeed(_Scheduler_rawSpawn(task))); + }); +} + +function _Scheduler_rawSend(proc, msg) +{ + proc.h.push(msg); + _Scheduler_enqueue(proc); +} + +var _Scheduler_send = F2(function(proc, msg) +{ + return _Scheduler_binding(function(callback) { + _Scheduler_rawSend(proc, msg); + callback(_Scheduler_succeed(_Utils_Tuple0)); + }); +}); + +function _Scheduler_kill(proc) +{ + return _Scheduler_binding(function(callback) { + var task = proc.f; + if (task.$ === 2 && task.c) + { + task.c(); + } + + proc.f = null; + + callback(_Scheduler_succeed(_Utils_Tuple0)); + }); +} + + +/* STEP PROCESSES + +type alias Process = + { $ : tag + , id : unique_id + , root : Task + , stack : null | { $: SUCCEED | FAIL, a: callback, b: stack } + , mailbox : [msg] + } + +*/ + + +var _Scheduler_working = false; +var _Scheduler_queue = []; + + +function _Scheduler_enqueue(proc) +{ + _Scheduler_queue.push(proc); + if (_Scheduler_working) + { + return; + } + _Scheduler_working = true; + while (proc = _Scheduler_queue.shift()) + { + _Scheduler_step(proc); + } + _Scheduler_working = false; +} + + +function _Scheduler_step(proc) +{ + while (proc.f) + { + var rootTag = proc.f.$; + if (rootTag === 0 || rootTag === 1) + { + while (proc.g && proc.g.$ !== rootTag) + { + proc.g = proc.g.i; + } + if (!proc.g) + { + return; + } + proc.f = proc.g.b(proc.f.a); + proc.g = proc.g.i; + } + else if (rootTag === 2) + { + proc.f.c = proc.f.b(function(newRoot) { + proc.f = newRoot; + _Scheduler_enqueue(proc); + }); + return; + } + else if (rootTag === 5) + { + if (proc.h.length === 0) + { + return; + } + proc.f = proc.f.b(proc.h.shift()); + } + else // if (rootTag === 3 || rootTag === 4) + { + proc.g = { + $: rootTag === 3 ? 0 : 1, + b: proc.f.b, + i: proc.g + }; + proc.f = proc.f.d; + } + } +} + + + +function _Process_sleep(time) +{ + return _Scheduler_binding(function(callback) { + var id = setTimeout(function() { + callback(_Scheduler_succeed(_Utils_Tuple0)); + }, time); + + return function() { clearTimeout(id); }; + }); +} + + + + +// PROGRAMS + + +var _Platform_worker = F4(function(impl, flagDecoder, debugMetadata, args) +{ + return _Platform_initialize( + flagDecoder, + args, + impl.init, + impl.update, + impl.subscriptions, + function() { return function() {} } + ); +}); + + + +// INITIALIZE A PROGRAM + + +function _Platform_initialize(flagDecoder, args, init, update, subscriptions, stepperBuilder) +{ + var result = A2(_Json_run, flagDecoder, _Json_wrap(args ? args['flags'] : undefined)); + $elm$core$Result$isOk(result) || _Debug_crash(2 /**/, _Json_errorToString(result.a) /**/); + var managers = {}; + result = init(result.a); + var model = result.a; + var stepper = stepperBuilder(sendToApp, model); + var ports = _Platform_setupEffects(managers, sendToApp); + + function sendToApp(msg, viewMetadata) + { + result = A2(update, msg, model); + stepper(model = result.a, viewMetadata); + _Platform_dispatchEffects(managers, result.b, subscriptions(model)); + } + + _Platform_dispatchEffects(managers, result.b, subscriptions(model)); + + return ports ? { ports: ports } : {}; +} + + + +// TRACK PRELOADS +// +// This is used by code in elm/browser and elm/http +// to register any HTTP requests that are triggered by init. +// + + +var _Platform_preload; + + +function _Platform_registerPreload(url) +{ + _Platform_preload.add(url); +} + + + +// EFFECT MANAGERS + + +var _Platform_effectManagers = {}; + + +function _Platform_setupEffects(managers, sendToApp) +{ + var ports; + + // setup all necessary effect managers + for (var key in _Platform_effectManagers) + { + var manager = _Platform_effectManagers[key]; + + if (manager.a) + { + ports = ports || {}; + ports[key] = manager.a(key, sendToApp); + } + + managers[key] = _Platform_instantiateManager(manager, sendToApp); + } + + return ports; +} + + +function _Platform_createManager(init, onEffects, onSelfMsg, cmdMap, subMap) +{ + return { + b: init, + c: onEffects, + d: onSelfMsg, + e: cmdMap, + f: subMap + }; +} + + +function _Platform_instantiateManager(info, sendToApp) +{ + var router = { + g: sendToApp, + h: undefined + }; + + var onEffects = info.c; + var onSelfMsg = info.d; + var cmdMap = info.e; + var subMap = info.f; + + function loop(state) + { + return A2(_Scheduler_andThen, loop, _Scheduler_receive(function(msg) + { + var value = msg.a; + + if (msg.$ === 0) + { + return A3(onSelfMsg, router, value, state); + } + + return cmdMap && subMap + ? A4(onEffects, router, value.i, value.j, state) + : A3(onEffects, router, cmdMap ? value.i : value.j, state); + })); + } + + return router.h = _Scheduler_rawSpawn(A2(_Scheduler_andThen, loop, info.b)); +} + + + +// ROUTING + + +var _Platform_sendToApp = F2(function(router, msg) +{ + return _Scheduler_binding(function(callback) + { + router.g(msg); + callback(_Scheduler_succeed(_Utils_Tuple0)); + }); +}); + + +var _Platform_sendToSelf = F2(function(router, msg) +{ + return A2(_Scheduler_send, router.h, { + $: 0, + a: msg + }); +}); + + + +// BAGS + + +function _Platform_leaf(home) +{ + return function(value) + { + return { + $: 1, + k: home, + l: value + }; + }; +} + + +function _Platform_batch(list) +{ + return { + $: 2, + m: list + }; +} + + +var _Platform_map = F2(function(tagger, bag) +{ + return { + $: 3, + n: tagger, + o: bag + } +}); + + + +// PIPE BAGS INTO EFFECT MANAGERS + + +function _Platform_dispatchEffects(managers, cmdBag, subBag) +{ + var effectsDict = {}; + _Platform_gatherEffects(true, cmdBag, effectsDict, null); + _Platform_gatherEffects(false, subBag, effectsDict, null); + + for (var home in managers) + { + _Scheduler_rawSend(managers[home], { + $: 'fx', + a: effectsDict[home] || { i: _List_Nil, j: _List_Nil } + }); + } +} + + +function _Platform_gatherEffects(isCmd, bag, effectsDict, taggers) +{ + switch (bag.$) + { + case 1: + var home = bag.k; + var effect = _Platform_toEffect(isCmd, home, taggers, bag.l); + effectsDict[home] = _Platform_insert(isCmd, effect, effectsDict[home]); + return; + + case 2: + for (var list = bag.m; list.b; list = list.b) // WHILE_CONS + { + _Platform_gatherEffects(isCmd, list.a, effectsDict, taggers); + } + return; + + case 3: + _Platform_gatherEffects(isCmd, bag.o, effectsDict, { + p: bag.n, + q: taggers + }); + return; + } +} + + +function _Platform_toEffect(isCmd, home, taggers, value) +{ + function applyTaggers(x) + { + for (var temp = taggers; temp; temp = temp.q) + { + x = temp.p(x); + } + return x; + } + + var map = isCmd + ? _Platform_effectManagers[home].e + : _Platform_effectManagers[home].f; + + return A2(map, applyTaggers, value) +} + + +function _Platform_insert(isCmd, newEffect, effects) +{ + effects = effects || { i: _List_Nil, j: _List_Nil }; + + isCmd + ? (effects.i = _List_Cons(newEffect, effects.i)) + : (effects.j = _List_Cons(newEffect, effects.j)); + + return effects; +} + + + +// PORTS + + +function _Platform_checkPortName(name) +{ + if (_Platform_effectManagers[name]) + { + _Debug_crash(3, name) + } +} + + + +// OUTGOING PORTS + + +function _Platform_outgoingPort(name, converter) +{ + _Platform_checkPortName(name); + _Platform_effectManagers[name] = { + e: _Platform_outgoingPortMap, + r: converter, + a: _Platform_setupOutgoingPort + }; + return _Platform_leaf(name); +} + + +var _Platform_outgoingPortMap = F2(function(tagger, value) { return value; }); + + +function _Platform_setupOutgoingPort(name) +{ + var subs = []; + var converter = _Platform_effectManagers[name].r; + + // CREATE MANAGER + + var init = _Process_sleep(0); + + _Platform_effectManagers[name].b = init; + _Platform_effectManagers[name].c = F3(function(router, cmdList, state) + { + for ( ; cmdList.b; cmdList = cmdList.b) // WHILE_CONS + { + // grab a separate reference to subs in case unsubscribe is called + var currentSubs = subs; + var value = _Json_unwrap(converter(cmdList.a)); + for (var i = 0; i < currentSubs.length; i++) + { + currentSubs[i](value); + } + } + return init; + }); + + // PUBLIC API + + function subscribe(callback) + { + subs.push(callback); + } + + function unsubscribe(callback) + { + // copy subs into a new array in case unsubscribe is called within a + // subscribed callback + subs = subs.slice(); + var index = subs.indexOf(callback); + if (index >= 0) + { + subs.splice(index, 1); + } + } + + return { + subscribe: subscribe, + unsubscribe: unsubscribe + }; +} + + + +// INCOMING PORTS + + +function _Platform_incomingPort(name, converter) +{ + _Platform_checkPortName(name); + _Platform_effectManagers[name] = { + f: _Platform_incomingPortMap, + r: converter, + a: _Platform_setupIncomingPort + }; + return _Platform_leaf(name); +} + + +var _Platform_incomingPortMap = F2(function(tagger, finalTagger) +{ + return function(value) + { + return tagger(finalTagger(value)); + }; +}); + + +function _Platform_setupIncomingPort(name, sendToApp) +{ + var subs = _List_Nil; + var converter = _Platform_effectManagers[name].r; + + // CREATE MANAGER + + var init = _Scheduler_succeed(null); + + _Platform_effectManagers[name].b = init; + _Platform_effectManagers[name].c = F3(function(router, subList, state) + { + subs = subList; + return init; + }); + + // PUBLIC API + + function send(incomingValue) + { + var result = A2(_Json_run, converter, _Json_wrap(incomingValue)); + + $elm$core$Result$isOk(result) || _Debug_crash(4, name, result.a); + + var value = result.a; + for (var temp = subs; temp.b; temp = temp.b) // WHILE_CONS + { + sendToApp(temp.a(value)); + } + } + + return { send: send }; +} + + + +// EXPORT ELM MODULES +// +// Have DEBUG and PROD versions so that we can (1) give nicer errors in +// debug mode and (2) not pay for the bits needed for that in prod mode. +// + + +function _Platform_export_UNUSED(exports) +{ + scope['Elm'] + ? _Platform_mergeExportsProd(scope['Elm'], exports) + : scope['Elm'] = exports; +} + + +function _Platform_mergeExportsProd(obj, exports) +{ + for (var name in exports) + { + (name in obj) + ? (name == 'init') + ? _Debug_crash(6) + : _Platform_mergeExportsProd(obj[name], exports[name]) + : (obj[name] = exports[name]); + } +} + + +function _Platform_export(exports) +{ + scope['Elm'] + ? _Platform_mergeExportsDebug('Elm', scope['Elm'], exports) + : scope['Elm'] = exports; +} + + +function _Platform_mergeExportsDebug(moduleName, obj, exports) +{ + for (var name in exports) + { + (name in obj) + ? (name == 'init') + ? _Debug_crash(6, moduleName) + : _Platform_mergeExportsDebug(moduleName + '.' + name, obj[name], exports[name]) + : (obj[name] = exports[name]); + } +} +var $elm$core$Basics$EQ = {$: 'EQ'}; +var $elm$core$Basics$LT = {$: 'LT'}; +var $elm$core$List$cons = _List_cons; +var $elm$core$Elm$JsArray$foldr = _JsArray_foldr; +var $elm$core$Array$foldr = F3( + function (func, baseCase, _v0) { + var tree = _v0.c; + var tail = _v0.d; + var helper = F2( + function (node, acc) { + if (node.$ === 'SubTree') { + var subTree = node.a; + return A3($elm$core$Elm$JsArray$foldr, helper, acc, subTree); + } else { + var values = node.a; + return A3($elm$core$Elm$JsArray$foldr, func, acc, values); + } + }); + return A3( + $elm$core$Elm$JsArray$foldr, + helper, + A3($elm$core$Elm$JsArray$foldr, func, baseCase, tail), + tree); + }); +var $elm$core$Array$toList = function (array) { + return A3($elm$core$Array$foldr, $elm$core$List$cons, _List_Nil, array); +}; +var $elm$core$Dict$foldr = F3( + function (func, acc, t) { + foldr: + while (true) { + if (t.$ === 'RBEmpty_elm_builtin') { + return acc; + } else { + var key = t.b; + var value = t.c; + var left = t.d; + var right = t.e; + var $temp$func = func, + $temp$acc = A3( + func, + key, + value, + A3($elm$core$Dict$foldr, func, acc, right)), + $temp$t = left; + func = $temp$func; + acc = $temp$acc; + t = $temp$t; + continue foldr; + } + } + }); +var $elm$core$Dict$toList = function (dict) { + return A3( + $elm$core$Dict$foldr, + F3( + function (key, value, list) { + return A2( + $elm$core$List$cons, + _Utils_Tuple2(key, value), + list); + }), + _List_Nil, + dict); +}; +var $elm$core$Dict$keys = function (dict) { + return A3( + $elm$core$Dict$foldr, + F3( + function (key, value, keyList) { + return A2($elm$core$List$cons, key, keyList); + }), + _List_Nil, + dict); +}; +var $elm$core$Set$toList = function (_v0) { + var dict = _v0.a; + return $elm$core$Dict$keys(dict); +}; +var $elm$core$Basics$GT = {$: 'GT'}; +var $elm$core$Basics$True = {$: 'True'}; +var $elm$core$Basics$composeR = F3( + function (f, g, x) { + return g( + f(x)); + }); +var $elm$core$Basics$add = _Basics_add; +var $elm$core$Basics$fdiv = _Basics_fdiv; +var $author$project$OperatorExample$mean = F2( + function (a, b) { + return (a + b) / 2; + }); +var $author$project$OperatorExample$compositionExample = function (x) { + return A2( + $elm$core$Basics$composeR, + $author$project$OperatorExample$mean(6), + $author$project$OperatorExample$mean(x)); +}; +var $elm$core$Basics$not = _Basics_not; +var $author$project$OperatorExample$ident = function (b) { + return !(!b); +}; +var $elm$core$Result$Err = function (a) { + return {$: 'Err', a: a}; +}; +var $elm$json$Json$Decode$Failure = F2( + function (a, b) { + return {$: 'Failure', a: a, b: b}; + }); +var $elm$json$Json$Decode$Field = F2( + function (a, b) { + return {$: 'Field', a: a, b: b}; + }); +var $elm$json$Json$Decode$Index = F2( + function (a, b) { + return {$: 'Index', a: a, b: b}; + }); +var $elm$core$Result$Ok = function (a) { + return {$: 'Ok', a: a}; +}; +var $elm$json$Json$Decode$OneOf = function (a) { + return {$: 'OneOf', a: a}; +}; +var $elm$core$Basics$False = {$: 'False'}; +var $elm$core$Maybe$Just = function (a) { + return {$: 'Just', a: a}; +}; +var $elm$core$Maybe$Nothing = {$: 'Nothing'}; +var $elm$core$String$all = _String_all; +var $elm$core$Basics$and = _Basics_and; +var $elm$core$Basics$append = _Utils_append; +var $elm$json$Json$Encode$encode = _Json_encode; +var $elm$core$String$fromInt = _String_fromNumber; +var $elm$core$String$join = F2( + function (sep, chunks) { + return A2( + _String_join, + sep, + _List_toArray(chunks)); + }); +var $elm$core$String$split = F2( + function (sep, string) { + return _List_fromArray( + A2(_String_split, sep, string)); + }); +var $elm$json$Json$Decode$indent = function (str) { + return A2( + $elm$core$String$join, + '\n ', + A2($elm$core$String$split, '\n', str)); +}; +var $elm$core$List$foldl = F3( + function (func, acc, list) { + foldl: + while (true) { + if (!list.b) { + return acc; + } else { + var x = list.a; + var xs = list.b; + var $temp$func = func, + $temp$acc = A2(func, x, acc), + $temp$list = xs; + func = $temp$func; + acc = $temp$acc; + list = $temp$list; + continue foldl; + } + } + }); +var $elm$core$List$length = function (xs) { + return A3( + $elm$core$List$foldl, + F2( + function (_v0, i) { + return i + 1; + }), + 0, + xs); +}; +var $elm$core$List$map2 = _List_map2; +var $elm$core$Basics$le = _Utils_le; +var $elm$core$Basics$sub = _Basics_sub; +var $elm$core$List$rangeHelp = F3( + function (lo, hi, list) { + rangeHelp: + while (true) { + if (_Utils_cmp(lo, hi) < 1) { + var $temp$lo = lo, + $temp$hi = hi - 1, + $temp$list = A2($elm$core$List$cons, hi, list); + lo = $temp$lo; + hi = $temp$hi; + list = $temp$list; + continue rangeHelp; + } else { + return list; + } + } + }); +var $elm$core$List$range = F2( + function (lo, hi) { + return A3($elm$core$List$rangeHelp, lo, hi, _List_Nil); + }); +var $elm$core$List$indexedMap = F2( + function (f, xs) { + return A3( + $elm$core$List$map2, + f, + A2( + $elm$core$List$range, + 0, + $elm$core$List$length(xs) - 1), + xs); + }); +var $elm$core$Char$toCode = _Char_toCode; +var $elm$core$Char$isLower = function (_char) { + var code = $elm$core$Char$toCode(_char); + return (97 <= code) && (code <= 122); +}; +var $elm$core$Char$isUpper = function (_char) { + var code = $elm$core$Char$toCode(_char); + return (code <= 90) && (65 <= code); +}; +var $elm$core$Basics$or = _Basics_or; +var $elm$core$Char$isAlpha = function (_char) { + return $elm$core$Char$isLower(_char) || $elm$core$Char$isUpper(_char); +}; +var $elm$core$Char$isDigit = function (_char) { + var code = $elm$core$Char$toCode(_char); + return (code <= 57) && (48 <= code); +}; +var $elm$core$Char$isAlphaNum = function (_char) { + return $elm$core$Char$isLower(_char) || ($elm$core$Char$isUpper(_char) || $elm$core$Char$isDigit(_char)); +}; +var $elm$core$List$reverse = function (list) { + return A3($elm$core$List$foldl, $elm$core$List$cons, _List_Nil, list); +}; +var $elm$core$String$uncons = _String_uncons; +var $elm$json$Json$Decode$errorOneOf = F2( + function (i, error) { + return '\n\n(' + ($elm$core$String$fromInt(i + 1) + (') ' + $elm$json$Json$Decode$indent( + $elm$json$Json$Decode$errorToString(error)))); + }); +var $elm$json$Json$Decode$errorToString = function (error) { + return A2($elm$json$Json$Decode$errorToStringHelp, error, _List_Nil); +}; +var $elm$json$Json$Decode$errorToStringHelp = F2( + function (error, context) { + errorToStringHelp: + while (true) { + switch (error.$) { + case 'Field': + var f = error.a; + var err = error.b; + var isSimple = function () { + var _v1 = $elm$core$String$uncons(f); + if (_v1.$ === 'Nothing') { + return false; + } else { + var _v2 = _v1.a; + var _char = _v2.a; + var rest = _v2.b; + return $elm$core$Char$isAlpha(_char) && A2($elm$core$String$all, $elm$core$Char$isAlphaNum, rest); + } + }(); + var fieldName = isSimple ? ('.' + f) : ('[\'' + (f + '\']')); + var $temp$error = err, + $temp$context = A2($elm$core$List$cons, fieldName, context); + error = $temp$error; + context = $temp$context; + continue errorToStringHelp; + case 'Index': + var i = error.a; + var err = error.b; + var indexName = '[' + ($elm$core$String$fromInt(i) + ']'); + var $temp$error = err, + $temp$context = A2($elm$core$List$cons, indexName, context); + error = $temp$error; + context = $temp$context; + continue errorToStringHelp; + case 'OneOf': + var errors = error.a; + if (!errors.b) { + return 'Ran into a Json.Decode.oneOf with no possibilities' + function () { + if (!context.b) { + return '!'; + } else { + return ' at json' + A2( + $elm$core$String$join, + '', + $elm$core$List$reverse(context)); + } + }(); + } else { + if (!errors.b.b) { + var err = errors.a; + var $temp$error = err, + $temp$context = context; + error = $temp$error; + context = $temp$context; + continue errorToStringHelp; + } else { + var starter = function () { + if (!context.b) { + return 'Json.Decode.oneOf'; + } else { + return 'The Json.Decode.oneOf at json' + A2( + $elm$core$String$join, + '', + $elm$core$List$reverse(context)); + } + }(); + var introduction = starter + (' failed in the following ' + ($elm$core$String$fromInt( + $elm$core$List$length(errors)) + ' ways:')); + return A2( + $elm$core$String$join, + '\n\n', + A2( + $elm$core$List$cons, + introduction, + A2($elm$core$List$indexedMap, $elm$json$Json$Decode$errorOneOf, errors))); + } + } + default: + var msg = error.a; + var json = error.b; + var introduction = function () { + if (!context.b) { + return 'Problem with the given value:\n\n'; + } else { + return 'Problem with the value at json' + (A2( + $elm$core$String$join, + '', + $elm$core$List$reverse(context)) + ':\n\n '); + } + }(); + return introduction + ($elm$json$Json$Decode$indent( + A2($elm$json$Json$Encode$encode, 4, json)) + ('\n\n' + msg)); + } + } + }); +var $elm$core$Array$branchFactor = 32; +var $elm$core$Array$Array_elm_builtin = F4( + function (a, b, c, d) { + return {$: 'Array_elm_builtin', a: a, b: b, c: c, d: d}; + }); +var $elm$core$Elm$JsArray$empty = _JsArray_empty; +var $elm$core$Basics$ceiling = _Basics_ceiling; +var $elm$core$Basics$logBase = F2( + function (base, number) { + return _Basics_log(number) / _Basics_log(base); + }); +var $elm$core$Basics$toFloat = _Basics_toFloat; +var $elm$core$Array$shiftStep = $elm$core$Basics$ceiling( + A2($elm$core$Basics$logBase, 2, $elm$core$Array$branchFactor)); +var $elm$core$Array$empty = A4($elm$core$Array$Array_elm_builtin, 0, $elm$core$Array$shiftStep, $elm$core$Elm$JsArray$empty, $elm$core$Elm$JsArray$empty); +var $elm$core$Elm$JsArray$initialize = _JsArray_initialize; +var $elm$core$Array$Leaf = function (a) { + return {$: 'Leaf', a: a}; +}; +var $elm$core$Basics$apL = F2( + function (f, x) { + return f(x); + }); +var $elm$core$Basics$apR = F2( + function (x, f) { + return f(x); + }); +var $elm$core$Basics$eq = _Utils_equal; +var $elm$core$Basics$floor = _Basics_floor; +var $elm$core$Elm$JsArray$length = _JsArray_length; +var $elm$core$Basics$gt = _Utils_gt; +var $elm$core$Basics$max = F2( + function (x, y) { + return (_Utils_cmp(x, y) > 0) ? x : y; + }); +var $elm$core$Basics$mul = _Basics_mul; +var $elm$core$Array$SubTree = function (a) { + return {$: 'SubTree', a: a}; +}; +var $elm$core$Elm$JsArray$initializeFromList = _JsArray_initializeFromList; +var $elm$core$Array$compressNodes = F2( + function (nodes, acc) { + compressNodes: + while (true) { + var _v0 = A2($elm$core$Elm$JsArray$initializeFromList, $elm$core$Array$branchFactor, nodes); + var node = _v0.a; + var remainingNodes = _v0.b; + var newAcc = A2( + $elm$core$List$cons, + $elm$core$Array$SubTree(node), + acc); + if (!remainingNodes.b) { + return $elm$core$List$reverse(newAcc); + } else { + var $temp$nodes = remainingNodes, + $temp$acc = newAcc; + nodes = $temp$nodes; + acc = $temp$acc; + continue compressNodes; + } + } + }); +var $elm$core$Tuple$first = function (_v0) { + var x = _v0.a; + return x; +}; +var $elm$core$Array$treeFromBuilder = F2( + function (nodeList, nodeListSize) { + treeFromBuilder: + while (true) { + var newNodeSize = $elm$core$Basics$ceiling(nodeListSize / $elm$core$Array$branchFactor); + if (newNodeSize === 1) { + return A2($elm$core$Elm$JsArray$initializeFromList, $elm$core$Array$branchFactor, nodeList).a; + } else { + var $temp$nodeList = A2($elm$core$Array$compressNodes, nodeList, _List_Nil), + $temp$nodeListSize = newNodeSize; + nodeList = $temp$nodeList; + nodeListSize = $temp$nodeListSize; + continue treeFromBuilder; + } + } + }); +var $elm$core$Array$builderToArray = F2( + function (reverseNodeList, builder) { + if (!builder.nodeListSize) { + return A4( + $elm$core$Array$Array_elm_builtin, + $elm$core$Elm$JsArray$length(builder.tail), + $elm$core$Array$shiftStep, + $elm$core$Elm$JsArray$empty, + builder.tail); + } else { + var treeLen = builder.nodeListSize * $elm$core$Array$branchFactor; + var depth = $elm$core$Basics$floor( + A2($elm$core$Basics$logBase, $elm$core$Array$branchFactor, treeLen - 1)); + var correctNodeList = reverseNodeList ? $elm$core$List$reverse(builder.nodeList) : builder.nodeList; + var tree = A2($elm$core$Array$treeFromBuilder, correctNodeList, builder.nodeListSize); + return A4( + $elm$core$Array$Array_elm_builtin, + $elm$core$Elm$JsArray$length(builder.tail) + treeLen, + A2($elm$core$Basics$max, 5, depth * $elm$core$Array$shiftStep), + tree, + builder.tail); + } + }); +var $elm$core$Basics$idiv = _Basics_idiv; +var $elm$core$Basics$lt = _Utils_lt; +var $elm$core$Array$initializeHelp = F5( + function (fn, fromIndex, len, nodeList, tail) { + initializeHelp: + while (true) { + if (fromIndex < 0) { + return A2( + $elm$core$Array$builderToArray, + false, + {nodeList: nodeList, nodeListSize: (len / $elm$core$Array$branchFactor) | 0, tail: tail}); + } else { + var leaf = $elm$core$Array$Leaf( + A3($elm$core$Elm$JsArray$initialize, $elm$core$Array$branchFactor, fromIndex, fn)); + var $temp$fn = fn, + $temp$fromIndex = fromIndex - $elm$core$Array$branchFactor, + $temp$len = len, + $temp$nodeList = A2($elm$core$List$cons, leaf, nodeList), + $temp$tail = tail; + fn = $temp$fn; + fromIndex = $temp$fromIndex; + len = $temp$len; + nodeList = $temp$nodeList; + tail = $temp$tail; + continue initializeHelp; + } + } + }); +var $elm$core$Basics$remainderBy = _Basics_remainderBy; +var $elm$core$Array$initialize = F2( + function (len, fn) { + if (len <= 0) { + return $elm$core$Array$empty; + } else { + var tailLen = len % $elm$core$Array$branchFactor; + var tail = A3($elm$core$Elm$JsArray$initialize, tailLen, len - tailLen, fn); + var initialFromIndex = (len - tailLen) - $elm$core$Array$branchFactor; + return A5($elm$core$Array$initializeHelp, fn, initialFromIndex, len, _List_Nil, tail); + } + }); +var $elm$core$Result$isOk = function (result) { + if (result.$ === 'Ok') { + return true; + } else { + return false; + } +}; +var $elm$core$Platform$Cmd$batch = _Platform_batch; +var $elm$core$Platform$Cmd$none = $elm$core$Platform$Cmd$batch(_List_Nil); +var $elm$core$Platform$Sub$batch = _Platform_batch; +var $elm$core$Platform$Sub$none = $elm$core$Platform$Sub$batch(_List_Nil); +var $elm$json$Json$Decode$succeed = _Json_succeed; +var $elm$core$Platform$worker = _Platform_worker; +var $author$project$OperatorExample$main = function () { + var m = A2($author$project$OperatorExample$compositionExample, 21, 4); + var _v0 = $author$project$OperatorExample$ident(true); + return $elm$core$Platform$worker( + { + init: function (_v1) { + return _Utils_Tuple2(m, $elm$core$Platform$Cmd$none); + }, + subscriptions: function (_v2) { + return $elm$core$Platform$Sub$none; + }, + update: F2( + function (model, _v3) { + return _Utils_Tuple2(model, $elm$core$Platform$Cmd$none); + }) + }); +}(); +_Platform_export({'OperatorExample':{'init':$author$project$OperatorExample$main( + $elm$json$Json$Decode$succeed(_Utils_Tuple0))(0)}});}(this)); diff --git a/design-documents/elm-minimal-master/src/Main.elm b/design-documents/elm-minimal-master/src/Main.elm new file mode 100644 index 00000000..71cb1228 --- /dev/null +++ b/design-documents/elm-minimal-master/src/Main.elm @@ -0,0 +1,31 @@ +module Main exposing (..) + +import Platform + + +arithmeticMean : Float -> Float -> Float +arithmeticMean a b = + (a + b) / 2 + + +geometricMean : Float -> Float -> Float +geometricMean a b = + sqrt (a * b) + + +compositionExample : (Float -> Float) +compositionExample = + arithmeticMean 6 + >> geometricMean 20 + + +main = + let + m = compositionExample 4 + in + + Platform.worker + { init = \() -> (m, Cmd.none) + , update = \model _ -> (model, Cmd.none) + , subscriptions = \_ -> Sub.none + } diff --git a/design-documents/elm-minimal-master/src/OperatorExample.elm b/design-documents/elm-minimal-master/src/OperatorExample.elm new file mode 120000 index 00000000..2e2dbf7f --- /dev/null +++ b/design-documents/elm-minimal-master/src/OperatorExample.elm @@ -0,0 +1 @@ +../../OperatorExample.elm \ No newline at end of file diff --git a/design-documents/operators.md b/design-documents/operators.md new file mode 100644 index 00000000..c29d900c --- /dev/null +++ b/design-documents/operators.md @@ -0,0 +1,337 @@ +# Operators in elm + +Elm programs use operators to consisely write some of the most common code. +For instance, elm provides arithmetic operators; it is far more consise to write `x * 5 + 1` than its equivilent written using functions (e.g. `add (multiply x 5) 1`). + +Starting with the 0.19 release series only "core"¹ modules can define operators, effectively fixing the number of operators in the language. +The operators used by elm are [listed below](#listing). + +## Defining operators + +In elm, operators are defined in terms of a function. +For example in `elm/core` the `Basics` module defines the addition operator `+` + +```elm + +infix left 6 (+) = add +-- ^ ^ ^ ^ ^ +-- | | | | | +-- (1) | (3)| (5) +-- (2) (4) + +add : number -> number -> number +add = + Elm.Kernel.Basics.add + +``` + +where `Elm.Kernel.Basics.add` is defined in JavaScript + +```js +var _Basics_add = F2(function(a, b) { return a + b; }); +``` + +The operator definition contains + +1. The `infix` keyword enables the compiler to parse this line as an operator definition. +2. Associativity, in this case `left` meaning the compiler parses `4 + 5 + 7` as `(4 + 5) + 7`. +3. The precedence controlls what happens when different operators are used together. + For example, `(+)` has precedence 6 and `(*)` has precedence 7 so the compiler parses `4 + 5 * 7` as `4 + (5 * 7)`. +4. The operator name enclosed in parentheses. +5. The function that the operator will bind to. + Operators provide a simpler syntax for calling a function; the elm code `a + b` is equivilent to the code `Basics.add a b` (except the function `add` is not exposed by the `Basics` module). + +## Compiling operators + +All examples in this section are found within [OperatorExample.elm](./OperatorExample.elm) using `elm/core` version `1.0.2` and the offical elm compiler version `0.19.1`. + +These are the elm functions we will use + +```elm +compositionExample : (Float -> Float -> Float) +compositionExample x = + mean 6 + >> mean x + +mean : Float -> Float -> Float +mean a b = + (a + b) / 2 + + +ident : Bool -> Bool +ident b = + not (not b) +``` + +### Operators: shorthand for functions + +The operator `>>` composes functions together, for example `mean 6 >> mean x` is equilent to `\dummy => mean x (mean 6 dummy)`. +Compiling `compositionExample` generates the folling JavaScript: + +```js +var $author$project$OperatorExample$compositionExample = function (x) { + return A2( + $elm$core$Basics$composeR, + $author$project$OperatorExample$mean(6), + $author$project$OperatorExample$mean(x)); +}; + +``` + +It is clear that the compiler treats `mean 6 >> mean 21` as the function call `Basics.composeR (mean 6) mean(21)`; the operator has been substituted for a call to the function from which the operator is defined. + +### Operaters: a suprising result + +However, when we look at the JavaScript generated for `mean` we see something quite different: + +```js +var $author$project$OperatorExample$mean = F2( + function (a, b) { + return (a + b) / 2; + }); + +``` + +The compiler does not generate a call to `Basics.add` for the operator `+`, nor has does it generate a call to `Basics.fdiv` for the operator `/`! +Does this mean that using operators is not equivalent to calling the function from which it is defined? +No, it does not. +To see why take a look at the generated javascript for a third example `ident`. +`ident` takes a boolean value and inverts it twice so that it will always return the value it is given. + +```js +var $author$project$OperatorExample$ident = function (b) { + return !(!b); +}; +``` + +As with `mean`, the compiler has refused to generate a call to `Basics.not` and instead uses the javascript `!` operator. +To understand this we need to dip our toes into the source code of the compiler itself. + +### Special cases + +In the section titled [Defining operators](#defining-operators) I claimed that "the elm code `a + b` is equivilent to the code `Basics.add a b`". +How can this be true if the compiler generated JavaScript for our example `mean` function does not contain a call to `$elm$core$Basics.add$`? +Surely the elm compiler must special case the addition operator? + +No! +The elm compiler does not special case the addition operator; it special-cases `Basics.add`! +It also special-cases `Basics.not` expaining the generated JavaScript for our function `ident`. +Let us look at the Haskell code that makes these cases special: + +#### [`generateCall`](https://github.com/elm/compiler/blob/0.19.1/compiler/src/Generate/JavaScript/Expression.hs#L386) + +This haskell function generates JavaScript for every elm function call, we can see that it usually uses `generateCallHelp` to generate JavaScript. +However, when calling a function in the `elm/core` package the function instead calls `generateCoreCall`. + +```hs +generateCall :: Mode.Mode -> Opt.Expr -> [Opt.Expr] -> JS.Expr +generateCall mode func args = + case func of + Opt.VarGlobal global@(Opt.Global (ModuleName.Canonical pkg _) _) | pkg == Pkg.core -> + generateCoreCall mode global args + + -- snip + + _ -> + generateCallHelp mode func args +``` + +#### [`generateCoreCall`](https://github.com/elm/compiler/blob/0.19.1/compiler/src/Generate/JavaScript/Expression.hs#L442) + +`generateCoreCall` detects calls to function in the `Basics` module (and a couple of other modules not shown here) and calls `generateBasicsCall`. +Like `generateCall`, uses `generateCallHelp` to handle any calls to functions defined in modules the compile does not have a special case for. + +```hs +generateCoreCall :: Mode.Mode -> Opt.Global -> [Opt.Expr] -> JS.Expr +generateCoreCall mode (Opt.Global home@(ModuleName.Canonical _ moduleName) name) args = + if moduleName == Name.basics then + generateBasicsCall mode home name args + + -- snip + + else + generateGlobalCall home name (map (generateJsExpr mode) args) +``` + +#### [src/Generate/JavaScript/Expression.hs](https://github.com/elm/compiler/blob/0.19.1/compiler/src/Generate/JavaScript/Expression.hs#L503) + +```hs +generateBasicsCall :: Mode.Mode -> ModuleName.Canonical -> Name.Name -> [Opt.Expr] -> JS.Expr +generateBasicsCall mode home name args = + case args of + [elmArg] -> + let arg = generateJsExpr mode elmArg in + case name of + "not" -> JS.Prefix JS.PrefixNot arg + -- snip + _ -> generateGlobalCall home name [arg] + + [elmLeft, elmRight] -> + case name of + -- snip + _ -> + let + left = generateJsExpr mode elmLeft + right = generateJsExpr mode elmRight + in + case name of + "add" -> JS.Infix JS.OpAdd left right + + -- snip + + _ -> generateGlobalCall home name [left, right] + + _ -> + generateGlobalCall home name (map (generateJsExpr mode) args) +``` + +## Elm operator listing + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
PrecedenceSyntaxDescriptionSourceAssociativity
9 +

highest

+ 		f << gFunctional compositionelm/core:Basicsconflicting
g >> fFunctional compositionelm/core:Basicsconflicting
8a ^ bExponentationelm/core:Basicsright-to-left
7a * bMultiplicationelm/core:Basicsleft-to-right
a / bFloating-point divisionelm/core:Basics
a // bInteger divisionelm/core:Basics
6a + bAdditionelm/core:Basicsleft-to-right
a - bSubtractionelm/core:Basics
5xs ++ ysAppendelm/core:Basicsright-to-left
a :: xsList constructionelm/core:List
4a == bEqualityelm/core:Basicsconflicting
a /= bInequalityelm/core:Basics
a < bLess thanelm/core:Basics
a > bGreater thanelm/core:Basics
a <= bLess than equal toelm/core:Basics
a >= bGreater than equal toelm/core:Basics
3a && bLogical ANDelm/core:Basicsright-to-left
2a || bLogical ORelm/core:Basicsright-to-left
0 +

lowest

+ 		a |> bPipe operatorelm/core:Basicsconflicts
a <| bPipe operatorelm/core:Basics
+ +--- + +### Notes + +1. "Core" modules describe all modules in the elm and elm-exploration organisations. diff --git a/design-documents/table.html b/design-documents/table.html new file mode 100644 index 00000000..36ab6cec --- /dev/null +++ b/design-documents/table.html @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
PrecedenceSyntaxDescriptionAssociativity
9 +

highest

+ 		f << gFunctional compositionconflicting
g >> fFunctional compositionright-to-left
8a ^ bExponentationright-to-left (?)
7a * bMultiplicationleft-to-right
a / bFloating-point division
a // bInteger-point division
diff --git a/elm.json b/elm.json index 2045963d..a19d2d5b 100644 --- a/elm.json +++ b/elm.json @@ -3,7 +3,7 @@ "name": "elm/core", "summary": "Elm's standard libraries", "license": "BSD-3-Clause", - "version": "1.0.4", + "version": "1.0.5", "exposed-modules": { "Primitives": [ "Basics", @@ -30,10 +30,14 @@ "Platform.Sub", "Platform", "Process", - "Task" + "Task", + "Time", + "Random" ] }, "elm-version": "0.19.0 <= v < 0.20.0", - "dependencies": {}, + "dependencies": { + "elm/json": "1.1.3 <= v < 2.0.0" + }, "test-dependencies": {} } diff --git a/init-elm-home.sh b/init-elm-home.sh new file mode 100755 index 00000000..72646ca5 --- /dev/null +++ b/init-elm-home.sh @@ -0,0 +1,19 @@ +#! /usr/bin/env bash + +set -o errexit; +set -o nounset; + +ELM="${ELM:-elm}" +ELM_VERSION="$($ELM --version)" +CORE_GIT_DIR=$(realpath .) + + +rm -rf "$ELM_HOME" +cd $(mktemp -d) + +git clone -q https://github.com/harrysarson/elm-minimal +cd elm-minimal +yes | $ELM install elm/time +yes | $ELM install elm/random +$ELM make src/Main.elm --output /dev/null || true + diff --git a/src/Array.elm b/src/Array.elm index 8c180605..68117490 100644 --- a/src/Array.elm +++ b/src/Array.elm @@ -1,47 +1,45 @@ -module Array - exposing - ( Array - , empty - , isEmpty - , length - , initialize - , repeat - , fromList - , get - , set - , push - , toList - , toIndexedList - , foldr - , foldl - , filter - , map - , indexedMap - , append - , slice - ) +module Array exposing + ( Array + , empty, initialize, repeat, fromList + , isEmpty, length, get + , set, push, append, slice + , toList, toIndexedList + , map, indexedMap, foldl, foldr, filter + ) {-| Fast immutable arrays. The elements in an array must have the same type. + # Arrays + @docs Array + # Creation + @docs empty, initialize, repeat, fromList + # Query + @docs isEmpty, length, get + # Manipulate + @docs set, push, append, slice + # Lists + @docs toList, toIndexedList + # Transform + @docs map, indexedMap, foldl, foldr, filter --} +-} import Basics exposing (..) import Bitwise @@ -65,6 +63,7 @@ tree, and we do this by dividing it into several smaller numbers (see `shiftStep` documentation). By dividing the index into smaller numbers, we will always get a range which is a power of two (2 bits gives 0-3, 3 gives 0-7, 4 gives 0-15...). + -} branchFactor : Int branchFactor = @@ -88,6 +87,7 @@ read which of the 32 branches to take. The `shiftStep` specifices how many bits are required to represent the branching factor. + -} shiftStep : Int shiftStep = @@ -136,6 +136,7 @@ type alias Tree a = {-| Return an empty array. length empty == 0 + -} empty : Array a empty = @@ -149,6 +150,7 @@ empty = {-| Determine if an array is empty. isEmpty empty == True + -} isEmpty : Array a -> Bool isEmpty (Array_elm_builtin len _ _ _) = @@ -157,7 +159,8 @@ isEmpty (Array_elm_builtin len _ _ _) = {-| Return the length of an array. - length (fromList [1,2,3]) == 3 + length (fromList [ 1, 2, 3 ]) == 3 + -} length : Array a -> Int length (Array_elm_builtin len _ _ _) = @@ -167,14 +170,18 @@ length (Array_elm_builtin len _ _ _) = {-| Initialize an array. `initialize n f` creates an array of length `n` with the element at index `i` initialized to the result of `(f i)`. - initialize 4 identity == fromList [0,1,2,3] - initialize 4 (\n -> n*n) == fromList [0,1,4,9] - initialize 4 (always 0) == fromList [0,0,0,0] + initialize 4 identity == fromList [ 0, 1, 2, 3 ] + + initialize 4 (\n -> n * n) == fromList [ 0, 1, 4, 9 ] + + initialize 4 (always 0) == fromList [ 0, 0, 0, 0 ] + -} initialize : Int -> (Int -> a) -> Array a initialize len fn = if len <= 0 then empty + else let tailLen = @@ -186,7 +193,7 @@ initialize len fn = initialFromIndex = len - tailLen - branchFactor in - initializeHelp fn initialFromIndex len [] tail + initializeHelp fn initialFromIndex len [] tail initializeHelp : (Int -> a) -> Int -> Int -> List (Node a) -> JsArray a -> Array a @@ -197,25 +204,28 @@ initializeHelp fn fromIndex len nodeList tail = , nodeList = nodeList , nodeListSize = len // branchFactor } + else let leaf = Leaf <| JsArray.initialize branchFactor fromIndex fn in - initializeHelp - fn - (fromIndex - branchFactor) - len - (leaf :: nodeList) - tail + initializeHelp + fn + (fromIndex - branchFactor) + len + (leaf :: nodeList) + tail {-| Creates an array with a given length, filled with a default element. - repeat 5 0 == fromList [0,0,0,0,0] - repeat 3 "cat" == fromList ["cat","cat","cat"] + repeat 5 0 == fromList [ 0, 0, 0, 0, 0 ] + + repeat 3 "cat" == fromList [ "cat", "cat", "cat" ] Notice that `repeat 3 x` is the same as `initialize 3 (always x)`. + -} repeat : Int -> a -> Array a repeat n e = @@ -240,33 +250,40 @@ fromListHelp list nodeList nodeListSize = ( jsArray, remainingItems ) = JsArray.initializeFromList branchFactor list in - if JsArray.length jsArray < branchFactor then - builderToArray True - { tail = jsArray - , nodeList = nodeList - , nodeListSize = nodeListSize - } - else - fromListHelp - remainingItems - (Leaf jsArray :: nodeList) - (nodeListSize + 1) + if JsArray.length jsArray < branchFactor then + builderToArray True + { tail = jsArray + , nodeList = nodeList + , nodeListSize = nodeListSize + } + + else + fromListHelp + remainingItems + (Leaf jsArray :: nodeList) + (nodeListSize + 1) {-| Return `Just` the element at the index or `Nothing` if the index is out of range. - get 0 (fromList [0,1,2]) == Just 0 - get 2 (fromList [0,1,2]) == Just 2 - get 5 (fromList [0,1,2]) == Nothing - get -1 (fromList [0,1,2]) == Nothing + get 0 (fromList [ 0, 1, 2 ]) == Just 0 + + get 2 (fromList [ 0, 1, 2 ]) == Just 2 + + get 5 (fromList [ 0, 1, 2 ]) == Nothing + + get -1 (fromList [ 0, 1, 2 ]) == Nothing + -} get : Int -> Array a -> Maybe a get index (Array_elm_builtin len startShift tree tail) = if index < 0 || index >= len then Nothing + else if index >= tailIndex len then Just <| JsArray.unsafeGet (Bitwise.and bitMask index) tail + else Just <| getHelp startShift index tree @@ -277,12 +294,12 @@ getHelp shift index tree = pos = Bitwise.and bitMask <| Bitwise.shiftRightZfBy shift index in - case JsArray.unsafeGet pos tree of - SubTree subTree -> - getHelp (shift - shiftStep) index subTree + case JsArray.unsafeGet pos tree of + SubTree subTree -> + getHelp (shift - shiftStep) index subTree - Leaf values -> - JsArray.unsafeGet (Bitwise.and bitMask index) values + Leaf values -> + JsArray.unsafeGet (Bitwise.and bitMask index) values {-| Given an array length, return the index of the first element in the tail. @@ -298,15 +315,18 @@ tailIndex len = {-| Set the element at a particular index. Returns an updated array. If the index is out of range, the array is unaltered. - set 1 7 (fromList [1,2,3]) == fromList [1,7,3] + set 1 7 (fromList [ 1, 2, 3 ]) == fromList [ 1, 7, 3 ] + -} set : Int -> a -> Array a -> Array a set index value ((Array_elm_builtin len startShift tree tail) as array) = if index < 0 || index >= len then array + else if index >= tailIndex len then Array_elm_builtin len startShift tree <| JsArray.unsafeSet (Bitwise.and bitMask index) value tail + else Array_elm_builtin len @@ -321,25 +341,26 @@ setHelp shift index value tree = pos = Bitwise.and bitMask <| Bitwise.shiftRightZfBy shift index in - case JsArray.unsafeGet pos tree of - SubTree subTree -> - let - newSub = - setHelp (shift - shiftStep) index value subTree - in - JsArray.unsafeSet pos (SubTree newSub) tree + case JsArray.unsafeGet pos tree of + SubTree subTree -> + let + newSub = + setHelp (shift - shiftStep) index value subTree + in + JsArray.unsafeSet pos (SubTree newSub) tree - Leaf values -> - let - newLeaf = - JsArray.unsafeSet (Bitwise.and bitMask index) value values - in - JsArray.unsafeSet pos (Leaf newLeaf) tree + Leaf values -> + let + newLeaf = + JsArray.unsafeSet (Bitwise.and bitMask index) value values + in + JsArray.unsafeSet pos (Leaf newLeaf) tree {-| Push an element onto the end of an array. - push 3 (fromList [1,2]) == fromList [1,2,3] + push 3 (fromList [ 1, 2 ]) == fromList [ 1, 2, 3 ] + -} push : a -> Array a -> Array a push a ((Array_elm_builtin _ _ _ tail) as array) = @@ -352,6 +373,7 @@ push a ((Array_elm_builtin _ _ _ tail) as array) = WARNING: For performance reasons, this function does not check if the new tail has a length equal to or beneath the `branchFactor`. Make sure this is the case before using this function. + -} unsafeReplaceTail : JsArray a -> Array a -> Array a unsafeReplaceTail newTail (Array_elm_builtin len startShift tree tail) = @@ -365,37 +387,39 @@ unsafeReplaceTail newTail (Array_elm_builtin len startShift tree tail) = newArrayLen = len + (newTailLen - originalTailLen) in - if newTailLen == branchFactor then + if newTailLen == branchFactor then + let + overflow = + Bitwise.shiftRightZfBy shiftStep newArrayLen > Bitwise.shiftLeftBy startShift 1 + in + if overflow then let - overflow = - Bitwise.shiftRightZfBy shiftStep newArrayLen > Bitwise.shiftLeftBy startShift 1 + newShift = + startShift + shiftStep + + newTree = + JsArray.singleton (SubTree tree) + |> insertTailInTree newShift len newTail in - if overflow then - let - newShift = - startShift + shiftStep + Array_elm_builtin + newArrayLen + newShift + newTree + JsArray.empty - newTree = - JsArray.singleton (SubTree tree) - |> insertTailInTree newShift len newTail - in - Array_elm_builtin - newArrayLen - newShift - newTree - JsArray.empty - else - Array_elm_builtin - newArrayLen - startShift - (insertTailInTree startShift len newTail tree) - JsArray.empty else Array_elm_builtin newArrayLen startShift - tree - newTail + (insertTailInTree startShift len newTail tree) + JsArray.empty + + else + Array_elm_builtin + newArrayLen + startShift + tree + newTail insertTailInTree : Int -> Int -> JsArray a -> Tree a -> Tree a @@ -404,45 +428,48 @@ insertTailInTree shift index tail tree = pos = Bitwise.and bitMask <| Bitwise.shiftRightZfBy shift index in - if pos >= JsArray.length tree then - if shift == 5 then - JsArray.push (Leaf tail) tree - else + if pos >= JsArray.length tree then + if shift == 5 then + JsArray.push (Leaf tail) tree + + else + let + newSub = + JsArray.empty + |> insertTailInTree (shift - shiftStep) index tail + |> SubTree + in + JsArray.push newSub tree + + else + let + value = + JsArray.unsafeGet pos tree + in + case value of + SubTree subTree -> let newSub = - JsArray.empty + subTree |> insertTailInTree (shift - shiftStep) index tail |> SubTree in - JsArray.push newSub tree - else - let - value = - JsArray.unsafeGet pos tree - in - case value of - SubTree subTree -> - let - newSub = - subTree - |> insertTailInTree (shift - shiftStep) index tail - |> SubTree - in - JsArray.unsafeSet pos newSub tree - - Leaf _ -> - let - newSub = - JsArray.singleton value - |> insertTailInTree (shift - shiftStep) index tail - |> SubTree - in - JsArray.unsafeSet pos newSub tree + JsArray.unsafeSet pos newSub tree + + Leaf _ -> + let + newSub = + JsArray.singleton value + |> insertTailInTree (shift - shiftStep) index tail + |> SubTree + in + JsArray.unsafeSet pos newSub tree {-| Create a list of elements from an array. - toList (fromList [3,5,8]) == [3,5,8] + toList (fromList [ 3, 5, 8 ]) == [ 3, 5, 8 ] + -} toList : Array a -> List a toList array = @@ -452,20 +479,22 @@ toList array = {-| Create an indexed list from an array. Each element of the array will be paired with its index. - toIndexedList (fromList ["cat","dog"]) == [(0,"cat"), (1,"dog")] + toIndexedList (fromList [ "cat", "dog" ]) == [ ( 0, "cat" ), ( 1, "dog" ) ] + -} toIndexedList : Array a -> List ( Int, a ) toIndexedList ((Array_elm_builtin len _ _ _) as array) = let helper entry ( index, list ) = - ( index - 1, (index,entry) :: list ) + ( index - 1, ( index, entry ) :: list ) in - Tuple.second (foldr helper ( len - 1, [] ) array) + Tuple.second (foldr helper ( len - 1, [] ) array) {-| Reduce an array from the right. Read `foldr` as fold from the right. foldr (+) 0 (repeat 3 5) == 15 + -} foldr : (a -> b -> b) -> b -> Array a -> b foldr func baseCase (Array_elm_builtin _ _ tree tail) = @@ -478,12 +507,13 @@ foldr func baseCase (Array_elm_builtin _ _ tree tail) = Leaf values -> JsArray.foldr func acc values in - JsArray.foldr helper (JsArray.foldr func baseCase tail) tree + JsArray.foldr helper (JsArray.foldr func baseCase tail) tree {-| Reduce an array from the left. Read `foldl` as fold from the left. - foldl (::) [] (fromList [1,2,3]) == [3,2,1] + foldl (::) [] (fromList [ 1, 2, 3 ]) == [ 3, 2, 1 ] + -} foldl : (a -> b -> b) -> b -> Array a -> b foldl func baseCase (Array_elm_builtin _ _ tree tail) = @@ -496,21 +526,34 @@ foldl func baseCase (Array_elm_builtin _ _ tree tail) = Leaf values -> JsArray.foldl func acc values in - JsArray.foldl func (JsArray.foldl helper baseCase tree) tail + JsArray.foldl func (JsArray.foldl helper baseCase tree) tail {-| Keep elements that pass the test. - filter isEven (fromList [1,2,3,4,5,6]) == (fromList [2,4,6]) + filter isEven (fromList [ 1, 2, 3, 4, 5, 6 ]) == fromList [ 2, 4, 6 ] + -} filter : (a -> Bool) -> Array a -> Array a filter isGood array = - fromList (foldr (\x xs -> if isGood x then x :: xs else xs) [] array) + fromList + (foldr + (\x xs -> + if isGood x then + x :: xs + + else + xs + ) + [] + array + ) {-| Apply a function on every element in an array. - map sqrt (fromList [1,4,9]) == fromList [1,2,3] + map sqrt (fromList [ 1, 4, 9 ]) == fromList [ 1, 2, 3 ] + -} map : (a -> b) -> Array a -> Array b map func (Array_elm_builtin len startShift tree tail) = @@ -523,16 +566,17 @@ map func (Array_elm_builtin len startShift tree tail) = Leaf values -> Leaf <| JsArray.map func values in - Array_elm_builtin - len - startShift - (JsArray.map helper tree) - (JsArray.map func tail) + Array_elm_builtin + len + startShift + (JsArray.map helper tree) + (JsArray.map func tail) {-| Apply a function on every element with its index as first argument. - indexedMap (*) (fromList [5,5,5]) == fromList [0,5,10] + indexedMap (*) (fromList [ 5, 5, 5 ]) == fromList [ 0, 5, 10 ] + -} indexedMap : (Int -> a -> b) -> Array a -> Array b indexedMap func (Array_elm_builtin len _ tree tail) = @@ -550,10 +594,10 @@ indexedMap func (Array_elm_builtin len _ tree tail) = mappedLeaf = Leaf <| JsArray.indexedMap func offset leaf in - { tail = builder.tail - , nodeList = mappedLeaf :: builder.nodeList - , nodeListSize = builder.nodeListSize + 1 - } + { tail = builder.tail + , nodeList = mappedLeaf :: builder.nodeList + , nodeListSize = builder.nodeListSize + 1 + } initialBuilder = { tail = JsArray.indexedMap func (tailIndex len) tail @@ -561,12 +605,13 @@ indexedMap func (Array_elm_builtin len _ tree tail) = , nodeListSize = 0 } in - builderToArray True (JsArray.foldl helper initialBuilder tree) + builderToArray True (JsArray.foldl helper initialBuilder tree) {-| Append two arrays to a new one. - append (repeat 2 42) (repeat 3 81) == fromList [42,42,81,81,81] + append (repeat 2 42) (repeat 3 81) == fromList [ 42, 42, 81, 81, 81 ] + -} append : Array a -> Array a -> Array a append ((Array_elm_builtin _ _ _ aTail) as a) (Array_elm_builtin bLen _ bTree bTail) = @@ -581,8 +626,9 @@ append ((Array_elm_builtin _ _ _ aTail) as a) (Array_elm_builtin bLen _ bTree bT Leaf leaf -> appendHelpTree leaf array in - JsArray.foldl foldHelper a bTree - |> appendHelpTree bTail + JsArray.foldl foldHelper a bTree + |> appendHelpTree bTail + else let foldHelper node builder = @@ -593,9 +639,9 @@ append ((Array_elm_builtin _ _ _ aTail) as a) (Array_elm_builtin bLen _ bTree bT Leaf leaf -> appendHelpBuilder leaf builder in - JsArray.foldl foldHelper (builderFromArray a) bTree - |> appendHelpBuilder bTail - |> builderToArray True + JsArray.foldl foldHelper (builderFromArray a) bTree + |> appendHelpBuilder bTail + |> builderToArray True appendHelpTree : JsArray a -> Array a -> Array a @@ -608,19 +654,20 @@ appendHelpTree toAppend ((Array_elm_builtin len _ tree tail) as array) = JsArray.length toAppend notAppended = - branchFactor - (JsArray.length tail) - itemsToAppend + branchFactor - JsArray.length tail - itemsToAppend newArray = unsafeReplaceTail appended array in - if notAppended < 0 then - let - nextTail = - JsArray.slice notAppended itemsToAppend toAppend - in - unsafeReplaceTail nextTail newArray - else - newArray + if notAppended < 0 then + let + nextTail = + JsArray.slice notAppended itemsToAppend toAppend + in + unsafeReplaceTail nextTail newArray + + else + newArray appendHelpBuilder : JsArray a -> Builder a -> Builder a @@ -633,23 +680,25 @@ appendHelpBuilder tail builder = JsArray.length tail notAppended = - branchFactor - (JsArray.length builder.tail) - tailLen + branchFactor - JsArray.length builder.tail - tailLen in - if notAppended < 0 then - { tail = JsArray.slice notAppended tailLen tail - , nodeList = Leaf appended :: builder.nodeList - , nodeListSize = builder.nodeListSize + 1 - } - else if notAppended == 0 then - { tail = JsArray.empty - , nodeList = Leaf appended :: builder.nodeList - , nodeListSize = builder.nodeListSize + 1 - } - else - { tail = appended - , nodeList = builder.nodeList - , nodeListSize = builder.nodeListSize - } + if notAppended < 0 then + { tail = JsArray.slice notAppended tailLen tail + , nodeList = Leaf appended :: builder.nodeList + , nodeListSize = builder.nodeListSize + 1 + } + + else if notAppended == 0 then + { tail = JsArray.empty + , nodeList = Leaf appended :: builder.nodeList + , nodeListSize = builder.nodeListSize + 1 + } + + else + { tail = appended + , nodeList = builder.nodeList + , nodeListSize = builder.nodeListSize + } {-| Get a sub-section of an array: `(slice start end array)`. The `start` is a @@ -657,17 +706,20 @@ zero-based index where we will start our slice. The `end` is a zero-based index that indicates the end of the slice. The slice extracts up to but not including `end`. - slice 0 3 (fromList [0,1,2,3,4]) == fromList [0,1,2] - slice 1 4 (fromList [0,1,2,3,4]) == fromList [1,2,3] + slice 0 3 (fromList [ 0, 1, 2, 3, 4 ]) == fromList [ 0, 1, 2 ] + + slice 1 4 (fromList [ 0, 1, 2, 3, 4 ]) == fromList [ 1, 2, 3 ] Both the `start` and `end` indexes can be negative, indicating an offset from the end of the array. - slice 1 -1 (fromList [0,1,2,3,4]) == fromList [1,2,3] - slice -2 5 (fromList [0,1,2,3,4]) == fromList [3,4] + slice 1 -1 (fromList [ 0, 1, 2, 3, 4 ]) == fromList [ 1, 2, 3 ] + + slice -2 5 (fromList [ 0, 1, 2, 3, 4 ]) == fromList [ 3, 4 ] This makes it pretty easy to `pop` the last element off of an array: `slice 0 -1 array` + -} slice : Int -> Int -> Array a -> Array a slice from to array = @@ -678,19 +730,23 @@ slice from to array = correctTo = translateIndex to array in - if correctFrom > correctTo then - empty - else - array - |> sliceRight correctTo - |> sliceLeft correctFrom + if correctFrom > correctTo then + empty + + else + array + |> sliceRight correctTo + |> sliceLeft correctFrom {-| Given a relative array index, convert it into an absolute one. translateIndex -1 someArray == someArray.length - 1 + translateIndex -10 someArray == someArray.length - 10 + translateIndex 5 someArray == 5 + -} translateIndex : Int -> Array a -> Int translateIndex index (Array_elm_builtin len _ _ _) = @@ -698,36 +754,44 @@ translateIndex index (Array_elm_builtin len _ _ _) = posIndex = if index < 0 then len + index + else index in - if posIndex < 0 then - 0 - else if posIndex > len then - len - else - posIndex + if posIndex < 0 then + 0 + + else if posIndex > len then + len + + else + posIndex {-| This function slices the tree from the right. First, two things are tested: -1. If the array does not need slicing, return the original array. -2. If the array can be sliced by only slicing the tail, slice the tail. + +1. If the array does not need slicing, return the original array. +2. If the array can be sliced by only slicing the tail, slice the tail. Otherwise, we do the following: -1. Find the new tail in the tree, promote it to the root tail position and -slice it. -2. Slice every sub tree. -3. Promote subTrees until the tree has the correct height. + +1. Find the new tail in the tree, promote it to the root tail position and + slice it. +2. Slice every sub tree. +3. Promote subTrees until the tree has the correct height. + -} sliceRight : Int -> Array a -> Array a sliceRight end ((Array_elm_builtin len startShift tree tail) as array) = if end == len then array + else if end >= tailIndex len then Array_elm_builtin end startShift tree <| JsArray.slice 0 (Bitwise.and bitMask end) tail + else let endIdx = @@ -743,14 +807,14 @@ sliceRight end ((Array_elm_builtin len startShift tree tail) as array) = newShift = max 5 <| depth * shiftStep in - Array_elm_builtin - end - newShift - (tree - |> sliceTree startShift endIdx - |> hoistTree startShift newShift - ) - (fetchNewTail startShift end endIdx tree) + Array_elm_builtin + end + newShift + (tree + |> sliceTree startShift endIdx + |> hoistTree startShift newShift + ) + (fetchNewTail startShift end endIdx tree) {-| Slice and return the `Leaf` node after what is to be the last node @@ -762,12 +826,12 @@ fetchNewTail shift end treeEnd tree = pos = Bitwise.and bitMask <| Bitwise.shiftRightZfBy shift treeEnd in - case JsArray.unsafeGet pos tree of - SubTree sub -> - fetchNewTail (shift - shiftStep) end treeEnd sub + case JsArray.unsafeGet pos tree of + SubTree sub -> + fetchNewTail (shift - shiftStep) end treeEnd sub - Leaf values -> - JsArray.slice 0 (Bitwise.and bitMask end) values + Leaf values -> + JsArray.slice 0 (Bitwise.and bitMask end) values {-| Shorten the root `Node` of the tree so it is long enough to contain @@ -780,25 +844,26 @@ sliceTree shift endIdx tree = lastPos = Bitwise.and bitMask <| Bitwise.shiftRightZfBy shift endIdx in - case JsArray.unsafeGet lastPos tree of - SubTree sub -> - let - newSub = - sliceTree (shift - shiftStep) endIdx sub - in - if JsArray.length newSub == 0 then - -- The sub is empty, slice it away - JsArray.slice 0 lastPos tree - else - tree - |> JsArray.slice 0 (lastPos + 1) - |> JsArray.unsafeSet lastPos (SubTree newSub) - - -- This is supposed to be the new tail. Fetched by `fetchNewTail`. - -- Slice up to, but not including, this point. - Leaf _ -> + case JsArray.unsafeGet lastPos tree of + SubTree sub -> + let + newSub = + sliceTree (shift - shiftStep) endIdx sub + in + if JsArray.length newSub == 0 then + -- The sub is empty, slice it away JsArray.slice 0 lastPos tree + else + tree + |> JsArray.slice 0 (lastPos + 1) + |> JsArray.unsafeSet lastPos (SubTree newSub) + + -- This is supposed to be the new tail. Fetched by `fetchNewTail`. + -- Slice up to, but not including, this point. + Leaf _ -> + JsArray.slice 0 lastPos tree + {-| The tree is supposed to be of a certain depth. Since slicing removes elements, it could be that the tree should have a smaller depth @@ -809,6 +874,7 @@ hoistTree : Int -> Int -> Tree a -> Tree a hoistTree oldShift newShift tree = if oldShift <= newShift || JsArray.length tree == 0 then tree + else case JsArray.unsafeGet 0 tree of SubTree sub -> @@ -823,24 +889,29 @@ the index of every element after the slice. Which means that we will have to rebuild the array. First, two things are tested: -1. If the array does not need slicing, return the original array. -2. If the slice removes every element but those in the tail, slice the tail and -set the tree to the empty array. + +1. If the array does not need slicing, return the original array. +2. If the slice removes every element but those in the tail, slice the tail and + set the tree to the empty array. Otherwise, we do the following: -1. Add every leaf node in the tree to a list. -2. Drop the nodes which are supposed to be sliced away. -3. Slice the head node of the list, which represents the start of the new array. -4. Create a builder with the tail set as the node from the previous step. -5. Append the remaining nodes into this builder, and create the array. + +1. Add every leaf node in the tree to a list. +2. Drop the nodes which are supposed to be sliced away. +3. Slice the head node of the list, which represents the start of the new array. +4. Create a builder with the tail set as the node from the previous step. +5. Append the remaining nodes into this builder, and create the array. + -} sliceLeft : Int -> Array a -> Array a sliceLeft from ((Array_elm_builtin len _ tree tail) as array) = if from == 0 then array + else if from >= tailIndex len then Array_elm_builtin (len - from) shiftStep JsArray.empty <| JsArray.slice (from - tailIndex len) (JsArray.length tail) tail + else let helper node acc = @@ -860,27 +931,27 @@ sliceLeft from ((Array_elm_builtin len _ tree tail) as array) = nodesToInsert = List.drop skipNodes leafNodes in - case nodesToInsert of - [] -> - empty + case nodesToInsert of + [] -> + empty - head :: rest -> - let - firstSlice = - from - (skipNodes * branchFactor) - - initialBuilder = - { tail = - JsArray.slice - firstSlice - (JsArray.length head) - head - , nodeList = [] - , nodeListSize = 0 - } - in - List.foldl appendHelpBuilder initialBuilder rest - |> builderToArray True + head :: rest -> + let + firstSlice = + from - (skipNodes * branchFactor) + + initialBuilder = + { tail = + JsArray.slice + firstSlice + (JsArray.length head) + head + , nodeList = [] + , nodeListSize = 0 + } + in + List.foldl appendHelpBuilder initialBuilder rest + |> builderToArray True {-| A builder contains all information necessary to build an array. Adding @@ -917,10 +988,10 @@ builderFromArray (Array_elm_builtin len _ tree tail) = Leaf _ -> node :: acc in - { tail = tail - , nodeList = JsArray.foldl helper [] tree - , nodeListSize = len // branchFactor - } + { tail = tail + , nodeList = JsArray.foldl helper [] tree + , nodeListSize = len // branchFactor + } {-| Construct an array with the information in a given builder. @@ -929,6 +1000,7 @@ Due to the nature of `List` the list of nodes in a builder will often be in reverse order (that is, the first leaf of the array is the last node in the node list). This function therefore allows the caller to specify if the node list should be reversed before building the array. + -} builderToArray : Bool -> Builder a -> Array a builderToArray reverseNodeList builder = @@ -938,6 +1010,7 @@ builderToArray reverseNodeList builder = shiftStep JsArray.empty builder.tail + else let treeLen = @@ -952,17 +1025,18 @@ builderToArray reverseNodeList builder = correctNodeList = if reverseNodeList then List.reverse builder.nodeList + else builder.nodeList tree = treeFromBuilder correctNodeList builder.nodeListSize in - Array_elm_builtin - (JsArray.length builder.tail + treeLen) - (max 5 <| depth * shiftStep) - tree - builder.tail + Array_elm_builtin + (JsArray.length builder.tail + treeLen) + (max 5 <| depth * shiftStep) + tree + builder.tail {-| Takes a list of leaves and an `Int` specifying how many leaves there are, @@ -972,16 +1046,17 @@ treeFromBuilder : List (Node a) -> Int -> Tree a treeFromBuilder nodeList nodeListSize = let newNodeSize = - ((toFloat nodeListSize) / (toFloat branchFactor)) + (toFloat nodeListSize / toFloat branchFactor) |> ceiling in - if newNodeSize == 1 then - JsArray.initializeFromList branchFactor nodeList - |> Tuple.first - else - treeFromBuilder - (compressNodes nodeList []) - newNodeSize + if newNodeSize == 1 then + JsArray.initializeFromList branchFactor nodeList + |> Tuple.first + + else + treeFromBuilder + (compressNodes nodeList []) + newNodeSize {-| Takes a list of nodes and return a list of `SubTree`s containing those @@ -994,11 +1069,11 @@ compressNodes nodes acc = JsArray.initializeFromList branchFactor nodes newAcc = - (SubTree node) :: acc + SubTree node :: acc in - case remainingNodes of - [] -> - List.reverse newAcc + case remainingNodes of + [] -> + List.reverse newAcc - _ -> - compressNodes remainingNodes newAcc + _ -> + compressNodes remainingNodes newAcc diff --git a/src/Basics.elm b/src/Basics.elm index fa05e402..f6c3f511 100644 --- a/src/Basics.elm +++ b/src/Basics.elm @@ -1,30 +1,36 @@ module Basics exposing - ( Int, Float - , (+), (-), (*), (/), (//), (^) - , toFloat, round, floor, ceiling, truncate - , (==), (/=) - , (<), (>), (<=), (>=), max, min, compare, Order(..) - , Bool(..), not, (&&), (||), xor - , (++) - , modBy, remainderBy, negate, abs, clamp, sqrt, logBase, e - , pi, cos, sin, tan, acos, asin, atan, atan2 - , degrees, radians, turns - , toPolar, fromPolar - , isNaN, isInfinite - , identity, always, (<|), (|>), (<<), (>>), Never, never - ) + ( Int, Float, (+), (-), (*), (/), (//), (^) + , toFloat, round, floor, ceiling, truncate + , (==), (/=) + , (<), (>), (<=), (>=), max, min, compare, Order(..) + , Bool(..), not, (&&), (||), xor + , (++) + , modBy, remainderBy, negate, abs, clamp, sqrt, logBase, e + , degrees, radians, turns + , pi, cos, sin, tan, acos, asin, atan, atan2 + , toPolar, fromPolar + , isNaN, isInfinite + , identity, always, (<|), (|>), (<<), (>>), Never, never + ) {-| Tons of useful functions that get imported by default. + # Math + @docs Int, Float, (+), (-), (*), (/), (//), (^) + # Int to Float / Float to Int + @docs toFloat, round, floor, ceiling, truncate + # Equality + @docs (==), (/=) + # Comparison These functions only work on `comparable` types. This includes numbers, @@ -33,33 +39,48 @@ things. @docs (<), (>), (<=), (>=), max, min, compare, Order + # Booleans + @docs Bool, not, (&&), (||), xor + # Append Strings and Lists + @docs (++) + # Fancier Math + @docs modBy, remainderBy, negate, abs, clamp, sqrt, logBase, e + # Angles + @docs degrees, radians, turns + # Trigonometry + @docs pi, cos, sin, tan, acos, asin, atan, atan2 + # Polar Coordinates + @docs toPolar, fromPolar + # Floating Point Checks + @docs isNaN, isInfinite + # Function Helpers + @docs identity, always, (<|), (|>), (<<), (>>), Never, never -} - import Elm.Kernel.Basics import Elm.Kernel.Utils @@ -74,17 +95,17 @@ infix right 2 (||) = or infix right 3 (&&) = and infix non 4 (==) = eq infix non 4 (/=) = neq -infix non 4 (<) = lt -infix non 4 (>) = gt +infix non 4 (<) = lt +infix non 4 (>) = gt infix non 4 (<=) = le infix non 4 (>=) = ge infix right 5 (++) = append -infix left 6 (+) = add -infix left 6 (-) = sub -infix left 7 (*) = mul -infix left 7 (/) = fdiv +infix left 6 (+) = add +infix left 6 (-) = sub +infix left 7 (*) = mul +infix left 7 (/) = fdiv infix left 7 (//) = idiv -infix right 8 (^) = pow +infix right 8 (^) = pow infix left 9 (<<) = composeL infix right 9 (>>) = composeR @@ -96,10 +117,14 @@ infix right 9 (>>) = composeR {-| An `Int` is a whole number. Valid syntax for integers includes: 0 + 42 + 9000 - 0xFF -- 255 in hexadecimal - 0x000A -- 10 in hexadecimal + + 0xFF -- 255 in hexadecimal + + 0x0A -- 10 in hexadecimal **Note:** `Int` math is well-defined in the range `-2^31` to `2^31 - 1`. Outside of that range, the behavior is determined by the compilation target. When @@ -108,7 +133,7 @@ operations, but if we generate WebAssembly some day, we would do the traditional [integer overflow][io]. This quirk is necessary to get good performance on quirky compilation targets. -**Historical Note:** The name `Int` comes from the term [integer][]. It appears +**Historical Note:** The name `Int` comes from the term [integer]. It appears that the `int` abbreviation was introduced in [ALGOL 68][68], shortening it from `integer` in [ALGOL 60][60]. Today, almost all programming languages use this abbreviation. @@ -117,8 +142,10 @@ this abbreviation. [integer]: https://en.wikipedia.org/wiki/Integer [60]: https://en.wikipedia.org/wiki/ALGOL_60 [68]: https://en.wikipedia.org/wiki/ALGOL_68 + -} -type Int = Int -- NOTE: The compiler provides the real implementation. +type Int + = Int -- NOTE: The compiler provides the real implementation. {-| A `Float` is a [floating-point number][fp]. Valid syntax for floats includes: @@ -140,101 +167,151 @@ compatible with any widely-used assembly language. [fp]: https://en.wikipedia.org/wiki/Floating-point_arithmetic [ieee]: https://en.wikipedia.org/wiki/IEEE_754 + -} -type Float = Float -- NOTE: The compiler provides the real implementation. +type Float + = Float -- NOTE: The compiler provides the real implementation. {-| Add two numbers. The `number` type variable means this operation can be specialized to `Int -> Int -> Int` or to `Float -> Float -> Float`. So you can do things like this: - 3002 + 4004 == 7006 -- all ints - 3.14 + 3.14 == 6.28 -- all floats + 3002 + 4004 == 7006 -- all ints + + 3.14 + 3.14 == 6.28 -- all floats You _cannot_ add an `Int` and a `Float` directly though. Use functions like [toFloat](#toFloat) or [round](#round) to convert both values to the same type. So if you needed to add a list length to a `Float` for some reason, you could say one of these: - 3.14 + toFloat (List.length [1,2,3]) == 6.14 - round 3.14 + List.length [1,2,3] == 6 + 3.14 + toFloat (List.length [ 1, 2, 3 ]) == 6.14 + + round 3.14 + List.length [ 1, 2, 3 ] == 6 **Note:** Languages like Java and JavaScript automatically convert `Int` values to `Float` values when you mix and match. This can make it difficult to be sure exactly what type of number you are dealing with. When you try to _infer_ these conversions (as Scala does) it can be even more confusing. Elm has opted for a design that makes all conversions explicit. + -} add : number -> number -> number -add = - Elm.Kernel.Basics.add +add lhs rhs = + let + sum = + add lhs rhs + in + sum {-| Subtract numbers like `4 - 3 == 1`. See [`(+)`](#+) for docs on the `number` type variable. + -} sub : number -> number -> number -sub = - Elm.Kernel.Basics.sub +sub lhs rhs = + let + difference = + sub lhs rhs + in + difference {-| Multiply numbers like `2 * 3 == 6`. See [`(+)`](#+) for docs on the `number` type variable. + -} mul : number -> number -> number -mul = - Elm.Kernel.Basics.mul +mul lhs rhs = + let + product = + mul lhs rhs + in + product {-| Floating-point division: 10 / 4 == 2.5 + 11 / 4 == 2.75 + 12 / 4 == 3 + 13 / 4 == 3.25 - 14 / 4 == 3.5 - -1 / 4 == -0.25 - -5 / 4 == -1.25 + 14 + / 4 + == 3.5 + - 1 + / 4 + == -0.25 + - 5 + / 4 + == -1.25 -} fdiv : Float -> Float -> Float -fdiv = - Elm.Kernel.Basics.fdiv +fdiv lhs rhs = + let + quotient = + fdiv lhs rhs + in + quotient {-| Integer division: 10 // 4 == 2 + 11 // 4 == 2 + 12 // 4 == 3 + 13 // 4 == 3 - 14 // 4 == 3 - -1 // 4 == 0 - -5 // 4 == -1 + 14 + // 4 + == 3 + - 1 + // 4 + == 0 + - 5 + // 4 + == -1 Notice that the remainder is discarded, so `3 // 4` is giving output similar to `truncate (3 / 4)`. It may sometimes be useful to pair this with the [`remainderBy`](#remainderBy) function. + +TODO(harry) fix example + -} idiv : Int -> Int -> Int -idiv = - Elm.Kernel.Basics.idiv +idiv lhs rhs = + let + quotient = + idiv lhs rhs + in + quotient {-| Exponentiation - 3^2 == 9 - 3^3 == 27 + 3 ^ 2 == 9 + + 3 ^ 3 == 27 + -} pow : number -> number -> number -pow = - Elm.Kernel.Basics.pow +pow base exponent = + Elm.Kernel.Basics.pow base exponent @@ -246,76 +323,108 @@ values like this: halfOf : Int -> Float halfOf number = - toFloat number / 2 + toFloat number / 2 -} toFloat : Int -> Float -toFloat = - Elm.Kernel.Basics.toFloat +toFloat x = + let + asFloat = + toFloat x + in + asFloat {-| Round a number to the nearest integer. round 1.0 == 1 + round 1.2 == 1 + round 1.5 == 2 + round 1.8 == 2 round -1.2 == -1 + round -1.5 == -1 + round -1.8 == -2 + -} round : Float -> Int round = - Elm.Kernel.Basics.round + Elm.Kernel.Basics.round {-| Floor function, rounding down. floor 1.0 == 1 + floor 1.2 == 1 + floor 1.5 == 1 + floor 1.8 == 1 floor -1.2 == -2 + floor -1.5 == -2 + floor -1.8 == -2 + -} floor : Float -> Int floor = - Elm.Kernel.Basics.floor + Elm.Kernel.Basics.floor {-| Ceiling function, rounding up. ceiling 1.0 == 1 + ceiling 1.2 == 2 + ceiling 1.5 == 2 + ceiling 1.8 == 2 ceiling -1.2 == -1 + ceiling -1.5 == -1 + ceiling -1.8 == -1 + -} ceiling : Float -> Int ceiling = - Elm.Kernel.Basics.ceiling + Elm.Kernel.Basics.ceiling {-| Truncate a number, rounding towards zero. truncate 1.0 == 1 + truncate 1.2 == 1 + truncate 1.5 == 1 + truncate 1.8 == 1 truncate -1.2 == -1 + truncate -1.5 == -1 + truncate -1.8 == -1 + -} truncate : Float -> Int -truncate = - Elm.Kernel.Basics.truncate +truncate x = + let + truncated = + truncate x + in + truncated @@ -335,7 +444,7 @@ possible. With JSON values, decode to Elm values before doing any equality checks! Why is it like this? Equality in the Elm sense can be difficult or impossible -to compute. Proving that functions are the same is [undecidable][], and JSON +to compute. Proving that functions are the same is [undecidable], and JSON values can come in through ports and have functions, cycles, and new JS data types that interact weirdly with our equality implementation. In a future release, the compiler will detect when `(==)` is used with problematic types @@ -344,67 +453,105 @@ pretty serious infrastructure work, so the stopgap is to crash as quickly as possible. [undecidable]: https://en.wikipedia.org/wiki/Undecidable_problem + -} eq : a -> a -> Bool -eq = - Elm.Kernel.Utils.equal +eq lhs rhs = + let + areEqual = + eq lhs rhs + in + areEqual {-| Check if values are not “the same”. So `(a /= b)` is the same as `(not (a == b))`. + -} neq : a -> a -> Bool -neq = - Elm.Kernel.Utils.notEqual +neq lhs rhs = + let + areNotEqual = + neq lhs rhs + in + areNotEqual -- COMPARISONS -{-|-} +{-| -} lt : comparable -> comparable -> Bool -lt = - Elm.Kernel.Utils.lt +lt lhs rhs = + let + lhsSmaller = + lt lhs rhs + in + lhsSmaller -{-|-} +{-| -} gt : comparable -> comparable -> Bool -gt = - Elm.Kernel.Utils.gt +gt lhs rhs = + let + lhsLarger = + gt lhs rhs + in + lhsLarger -{-|-} +{-| -} le : comparable -> comparable -> Bool -le = - Elm.Kernel.Utils.le +le lhs rhs = + let + lhsSmallerOrEqual = + le lhs rhs + in + lhsSmallerOrEqual -{-|-} +{-| -} ge : comparable -> comparable -> Bool -ge = - Elm.Kernel.Utils.ge +ge lhs rhs = + let + lhsLargerOrEqual = + ge lhs rhs + in + lhsLargerOrEqual {-| Find the smaller of two comparables. min 42 12345678 == 42 + min "abc" "xyz" == "abc" + -} min : comparable -> comparable -> comparable min x y = - if lt x y then x else y + if lt x y then + x + + else + y {-| Find the larger of two comparables. max 42 12345678 == 12345678 + max "abc" "xyz" == "xyz" + -} max : comparable -> comparable -> comparable max x y = - if gt x y then x else y + if gt x y then + x + + else + y {-| Compare any two comparable values. Comparable values include `String`, @@ -412,18 +559,36 @@ max x y = are also the only values that work as `Dict` keys or `Set` members. compare 3 4 == LT + compare 4 4 == EQ + compare 5 4 == GT + -} compare : comparable -> comparable -> Order -compare = - Elm.Kernel.Utils.compare +compare x y = + let + compared : Int + compared = + Elm.Kernel.Utils.compare x y + in + if lt compared 0 then + LT + + else if eq compared 0 then + EQ + + else + GT {-| Represents the relative ordering of two things. The relations are less than, equal to, and greater than. -} -type Order = LT | EQ | GT +type Order + = LT + | EQ + | GT @@ -440,62 +605,95 @@ from Richard [here][rt]. [ut]: https://guide.elm-lang.org/types/union_types.html [jf]: https://youtu.be/6TDKHGtAxeg?t=1m25s [rt]: https://youtu.be/IcgmSRJHu_8?t=1m14s + -} -type Bool = True | False +type Bool + = True + | False {-| Negate a boolean value. not True == False + not False == True + -} not : Bool -> Bool -not = - Elm.Kernel.Basics.not +not x = + let + complement = + not x + in + complement {-| The logical AND operator. `True` if both inputs are `True`. - True && True == True - True && False == False - False && True == False + True && True == True + + True && False == False + + False && True == False + False && False == False **Note:** When used in the infix position, like `(left && right)`, the operator short-circuits. This means if `left` is `False` we do not bother evaluating `right` and just return `False` overall. + -} and : Bool -> Bool -> Bool -and = - Elm.Kernel.Basics.and +and lhs rhs = + let + areBothTrue = + and lhs rhs + in + areBothTrue {-| The logical OR operator. `True` if one or both inputs are `True`. - True || True == True - True || False == True - False || True == True + True || True == True + + True || False == True + + False || True == True + False || False == False **Note:** When used in the infix position, like `(left || right)`, the operator short-circuits. This means if `left` is `True` we do not bother evaluating `right` and just return `True` overall. + -} or : Bool -> Bool -> Bool -or = - Elm.Kernel.Basics.or +or lhs rhs = + let + areEitherTrue = + or lhs rhs + in + areEitherTrue {-| The exclusive-or operator. `True` if exactly one input is `True`. - xor True True == False - xor True False == True - xor False True == True + xor True True == False + + xor True False == True + + xor False True == True + xor False False == False + -} xor : Bool -> Bool -> Bool -xor = - Elm.Kernel.Basics.xor +xor lhs rhs = + let + isOneTrue = + xor lhs rhs + in + isOneTrue @@ -505,11 +703,17 @@ xor = {-| Put two appendable things together. This includes strings and lists. "hello" ++ "world" == "helloworld" - [1,1,2] ++ [3,5,8] == [1,1,2,3,5,8] + + [ 1, 1, 2 ] ++ [ 3, 5, 8 ] == [ 1, 1, 2, 3, 5, 8 ] + -} append : appendable -> appendable -> appendable -append = - Elm.Kernel.Utils.append +append lhs rhs = + let + appended = + append lhs rhs + in + appended @@ -520,8 +724,11 @@ append = A common trick is to use (n mod 2) to detect even and odd numbers: modBy 2 0 == 0 + modBy 2 1 == 1 + modBy 2 2 == 0 + modBy 2 3 == 1 Our `modBy` function works in the typical mathematical way when you run into @@ -535,51 +742,82 @@ or read Daan Leijen’s [Division and Modulus for Computer Scientists][dm] for m information. [dm]: https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf + -} modBy : Int -> Int -> Int -modBy = - Elm.Kernel.Basics.modBy +modBy modulus x = + let + answer = + remainderBy modulus x + in + if eq modulus 0 then + Elm.Kernel.Basics.modBy0 () + else if or (and (gt answer 0) (lt modulus 0)) (and (lt answer 0) (gt modulus 0)) then + add answer modulus -{-| Get the remainder after division. Here are bunch of examples of dividing by four: + else + answer - List.map (remainderBy 4) [ -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5 ] - -- [ -1, 0, -3, -2, -1, 0, 1, 2, 3, 0, 1 ] + +{-| Get the remainder after division. Here are bunch of examples of dividing by four: +List.map (remainderBy 4) [ -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5 ][ -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5 ] +-- [ -1, 0, -3, -2, -1, 0, 1, 2, 3, 0, 1 ][ -1, 0, -3, -2, -1, 0, 1, 2, 3, 0, 1 ] Use [`modBy`](#modBy) for a different treatment of negative numbers, or read Daan Leijen’s [Division and Modulus for Computer Scientists][dm] for more information. [dm]: https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf + -} remainderBy : Int -> Int -> Int -remainderBy = - Elm.Kernel.Basics.remainderBy +remainderBy divisor dividend = + let + remainder = + remainderBy divisor dividend + in + remainder {-| Negate a number. negate 42 == -42 + negate -42 == 42 + negate 0 == 0 + -} negate : number -> number -negate n = - -n +negate x = + let + negated = + negate x + in + negated {-| Get the [absolute value][abs] of a number. - abs 16 == 16 - abs -4 == 4 + abs 16 == 16 + + abs -4 == 4 + abs -8.5 == 8.5 + abs 3.14 == 3.14 [abs]: https://en.wikipedia.org/wiki/Absolute_value + -} abs : number -> number abs n = - if lt n 0 then -n else n + if lt n 0 then + -n + + else + n {-| Clamps a number within a given range. With the expression @@ -588,46 +826,55 @@ abs n = 100 if x < 100 x if 100 <= x < 200 200 if 200 <= x + -} clamp : number -> number -> number -> number clamp low high number = - if lt number low then - low - else if gt number high then - high - else - number + if lt number low then + low + + else if gt number high then + high + + else + number {-| Take the square root of a number. - sqrt 4 == 2 - sqrt 9 == 3 + sqrt 4 == 2 + + sqrt 9 == 3 + sqrt 16 == 4 + sqrt 25 == 5 + -} sqrt : Float -> Float sqrt = - Elm.Kernel.Basics.sqrt + Elm.Kernel.Basics.sqrt {-| Calculate the logarithm of a number with a given base. logBase 10 100 == 2 + logBase 2 256 == 8 + -} logBase : Float -> Float -> Float logBase base number = - fdiv - (Elm.Kernel.Basics.log number) - (Elm.Kernel.Basics.log base) + fdiv + (Elm.Kernel.Basics.log number) + (Elm.Kernel.Basics.log base) {-| An approximation of e. -} e : Float e = - Elm.Kernel.Basics.e + 2.718281828459045 @@ -637,28 +884,31 @@ e = {-| Convert radians to standard Elm angles (radians). radians pi == 3.141592653589793 + -} radians : Float -> Float radians angleInRadians = - angleInRadians + angleInRadians {-| Convert degrees to standard Elm angles (radians). degrees 180 == 3.141592653589793 + -} degrees : Float -> Float degrees angleInDegrees = - fdiv (mul angleInDegrees pi) 180 + fdiv (mul angleInDegrees pi) 180 {-| Convert turns to standard Elm angles (radians). One turn is equal to 360°. - turns (1/2) == 3.141592653589793 + turns (1 / 2) == 3.141592653589793 + -} turns : Float -> Float turns angleInTurns = - mul (mul 2 pi) angleInTurns + mul (mul 2 pi) angleInTurns @@ -669,65 +919,75 @@ turns angleInTurns = -} pi : Float pi = - Elm.Kernel.Basics.pi + 3.141592653589793 {-| Figure out the cosine given an angle in radians. - cos (degrees 60) == 0.5000000000000001 - cos (turns (1/6)) == 0.5000000000000001 - cos (radians (pi/3)) == 0.5000000000000001 - cos (pi/3) == 0.5000000000000001 + cos (degrees 60) == 0.5000000000000001 + + cos (turns (1 / 6)) == 0.5000000000000001 + + cos (radians (pi / 3)) == 0.5000000000000001 + + cos (pi / 3) == 0.5000000000000001 -} cos : Float -> Float cos = - Elm.Kernel.Basics.cos + Elm.Kernel.Basics.cos {-| Figure out the sine given an angle in radians. - sin (degrees 30) == 0.49999999999999994 - sin (turns (1/12)) == 0.49999999999999994 - sin (radians (pi/6)) == 0.49999999999999994 - sin (pi/6) == 0.49999999999999994 + sin (degrees 30) == 0.49999999999999994 + + sin (turns (1 / 12)) == 0.49999999999999994 + + sin (radians (pi / 6)) == 0.49999999999999994 + + sin (pi / 6) == 0.49999999999999994 -} sin : Float -> Float sin = - Elm.Kernel.Basics.sin + Elm.Kernel.Basics.sin {-| Figure out the tangent given an angle in radians. - tan (degrees 45) == 0.9999999999999999 - tan (turns (1/8)) == 0.9999999999999999 - tan (radians (pi/4)) == 0.9999999999999999 - tan (pi/4) == 0.9999999999999999 + tan (degrees 45) == 0.9999999999999999 + + tan (turns (1 / 8)) == 0.9999999999999999 + + tan (radians (pi / 4)) == 0.9999999999999999 + + tan (pi / 4) == 0.9999999999999999 + -} tan : Float -> Float tan = - Elm.Kernel.Basics.tan + Elm.Kernel.Basics.tan {-| Figure out the arccosine for `adjacent / hypotenuse` in radians: - acos (1/2) == 1.0471975511965979 -- 60° or pi/3 radians + acos (1 / 2) == 1.0471975511965979 -- 60° or pi/3 radians -} acos : Float -> Float acos = - Elm.Kernel.Basics.acos + Elm.Kernel.Basics.acos {-| Figure out the arcsine for `opposite / hypotenuse` in radians: - asin (1/2) == 0.5235987755982989 -- 30° or pi/6 radians + asin (1 / 2) == 0.5235987755982989 -- 30° or pi/6 radians -} asin : Float -> Float asin = - Elm.Kernel.Basics.asin + Elm.Kernel.Basics.asin {-| This helps you find the angle (in radians) to an `(x,y)` coordinate, but @@ -739,33 +999,40 @@ the negative signs comes from the `y` or `x` value. So as we go counter-clockwis around the origin from point `(1,1)` to `(1,-1)` to `(-1,-1)` to `(-1,1)` we do not get angles that go in the full circle: - atan ( 1 / 1 ) == 0.7853981633974483 -- 45° or pi/4 radians - atan ( 1 / -1 ) == -0.7853981633974483 -- 315° or 7*pi/4 radians - atan ( -1 / -1 ) == 0.7853981633974483 -- 45° or pi/4 radians - atan ( -1 / 1 ) == -0.7853981633974483 -- 315° or 7*pi/4 radians + atan (1 / 1) == 0.7853981633974483 -- 45° or pi/4 radians + + atan (1 / -1) == -0.7853981633974483 -- 315° or 7*pi/4 radians + + atan (-1 / -1) == 0.7853981633974483 -- 45° or pi/4 radians + + atan (-1 / 1) == -0.7853981633974483 -- 315° or 7*pi/4 radians Notice that everything is between `pi/2` and `-pi/2`. That is pretty useless for figuring out angles in any sort of visualization, so again, check out [`atan2`](#atan2) instead! + -} atan : Float -> Float atan = - Elm.Kernel.Basics.atan + Elm.Kernel.Basics.atan {-| This helps you find the angle (in radians) to an `(x,y)` coordinate. So rather than saying `atan (y/x)` you say `atan2 y x` and you can get a full range of angles: - atan2 1 1 == 0.7853981633974483 -- 45° or pi/4 radians - atan2 1 -1 == 2.356194490192345 -- 135° or 3*pi/4 radians - atan2 -1 -1 == -2.356194490192345 -- 225° or 5*pi/4 radians - atan2 -1 1 == -0.7853981633974483 -- 315° or 7*pi/4 radians + atan2 1 1 == 0.7853981633974483 -- 45° or pi/4 radians + + atan2 1 -1 == 2.356194490192345 -- 135° or 3*pi/4 radians + + atan2 -1 -1 == -2.356194490192345 -- 225° or 5*pi/4 radians + + atan2 -1 1 == -0.7853981633974483 -- 315° or 7*pi/4 radians -} atan2 : Float -> Float -> Float atan2 = - Elm.Kernel.Basics.atan2 + Elm.Kernel.Basics.atan2 @@ -774,25 +1041,28 @@ atan2 = {-| Convert polar coordinates (r,θ) to Cartesian coordinates (x,y). - fromPolar (sqrt 2, degrees 45) == (1, 1) + fromPolar ( sqrt 2, degrees 45 ) == ( 1, 1 ) + -} -fromPolar : (Float,Float) -> (Float,Float) -fromPolar (radius, theta) = - ( mul radius (cos theta) - , mul radius (sin theta) - ) +fromPolar : ( Float, Float ) -> ( Float, Float ) +fromPolar ( radius, theta ) = + ( mul radius (cos theta) + , mul radius (sin theta) + ) {-| Convert Cartesian coordinates (x,y) to polar coordinates (r,θ). - toPolar (3, 4) == ( 5, 0.9272952180016122) - toPolar (5,12) == (13, 1.1760052070951352) + toPolar ( 3, 4 ) == ( 5, 0.9272952180016122 ) + + toPolar ( 5, 12 ) == ( 13, 1.1760052070951352 ) + -} -toPolar : (Float,Float) -> (Float,Float) +toPolar : ( Float, Float ) -> ( Float, Float ) toPolar ( x, y ) = - ( sqrt (add (mul x x) (mul y y)) - , atan2 y x - ) + ( sqrt (add (mul x x) (mul y y)) + , atan2 y x + ) @@ -800,32 +1070,40 @@ toPolar ( x, y ) = {-| Determine whether a float is an undefined or unrepresentable number. -NaN stands for *not a number* and it is [a standardized part of floating point +NaN stands for _not a number_ and it is [a standardized part of floating point numbers](https://en.wikipedia.org/wiki/NaN). - isNaN (0/0) == True + isNaN (0 / 0) == True + isNaN (sqrt -1) == True - isNaN (1/0) == False -- infinity is a number - isNaN 1 == False + + isNaN (1 / 0) == False -- infinity is a number + + isNaN 1 == False + -} isNaN : Float -> Bool -isNaN = - Elm.Kernel.Basics.isNaN +isNaN n = + neq n n {-| Determine whether a float is positive or negative infinity. - isInfinite (0/0) == False + isInfinite (0 / 0) == False + isInfinite (sqrt -1) == False - isInfinite (1/0) == True - isInfinite 1 == False + + isInfinite (1 / 0) == True + + isInfinite 1 == False Notice that NaN is not infinite! For float `n` to be finite implies that `not (isInfinite n || isNaN n)` evaluates to `True`. + -} isInfinite : Float -> Bool -isInfinite = - Elm.Kernel.Basics.isInfinite +isInfinite n = + eq (abs n) (fdiv 1 0) @@ -839,15 +1117,16 @@ example, the following code checks if the square root of a number is odd: You can think of this operator as equivalent to the following: - (g << f) == (\x -> g (f x)) + (g << f) == (\x -> g (f x)) So our example expands out to something like this: \n -> not (isEven (sqrt n)) + -} composeL : (b -> c) -> (a -> b) -> (a -> c) composeL g f x = - g (f x) + g (f x) {-| Function composition, passing results along in the suggested direction. For @@ -858,7 +1137,7 @@ example, the following code checks if the square root of a number is odd: -} composeR : (a -> b) -> (b -> c) -> (a -> c) composeR f g x = - g (f x) + g (f x) {-| Saying `x |> f` is exactly the same as `f x`. @@ -870,16 +1149,16 @@ integers: -- BEFORE sanitize : String -> Maybe Int sanitize input = - String.toInt (String.trim input) + String.toInt (String.trim input) We can rewrite it like this: -- AFTER sanitize : String -> Maybe Int sanitize input = - input - |> String.trim - |> String.toInt + input + |> String.trim + |> String.toInt Totally equivalent! I recommend trying to rewrite code that uses `x |> f` into code like `f x` until there are no pipes left. That can help you build @@ -890,20 +1169,30 @@ have three or four steps, the code often gets clearer if you break out a top-level helper function. Now the transformation has a name. The arguments are named. It has a type annotation. It is much more self-documenting that way! Testing the logic gets easier too. Nice side benefit! + -} apR : a -> (a -> b) -> b apR x f = - f x + let + applied = + apR x f + in + applied {-| Saying `f <| x` is exactly the same as `f x`. It can help you avoid parentheses, which can be nice sometimes. Maybe you want to apply a function to a `case` expression? That sort of thing. + -} apL : (a -> b) -> a -> b apL f x = - f x + let + applied = + apL f x + in + applied {-| Given a value, returns exactly the same value. This is called @@ -911,20 +1200,21 @@ apL f x = -} identity : a -> a identity x = - x + x -{-| Create a function that *always* returns the same value. Useful with +{-| Create a function that _always_ returns the same value. Useful with functions like `map`: List.map (always 0) [1,2,3,4,5] == [0,0,0,0,0] -- List.map (\_ -> 0) [1,2,3,4,5] == [0,0,0,0,0] -- always = (\x _ -> x) + -} always : a -> b -> a always a _ = - a + a {-| A value that can never happen! For context: @@ -940,31 +1230,34 @@ So there cannot be any event handlers on that HTML. You may also see this used with tasks that never fail, like `Task Never ()`. -The `Never` type is useful for restricting *arguments* to a function. Maybe my +The `Never` type is useful for restricting _arguments_ to a function. Maybe my API can only accept HTML without event handlers, so I require `Html Never` and users can give `Html msg` and everything will go fine. Generally speaking, you do not want `Never` in your return types though. + -} -type Never = JustOneMore Never +type Never + = JustOneMore Never {-| A function that can never be called. Seems extremely pointless, but it -*can* come in handy. Imagine you have some HTML that should never produce any -messages. And say you want to use it in some other HTML that *does* produce +_can_ come in handy. Imagine you have some HTML that should never produce any +messages. And say you want to use it in some other HTML that _does_ produce messages. You could say: import Html exposing (..) embedHtml : Html Never -> Html msg embedHtml staticStuff = - div [] - [ text "hello" - , Html.map never staticStuff - ] + div [] + [ text "hello" + , Html.map never staticStuff + ] So the `never` function is basically telling the type system, make sure no one ever calls me! + -} never : Never -> a never (JustOneMore nvr) = - never nvr + never nvr diff --git a/src/Bitwise.elm b/src/Bitwise.elm index bd488fc5..fbc4a4b9 100644 --- a/src/Bitwise.elm +++ b/src/Bitwise.elm @@ -1,67 +1,93 @@ module Bitwise exposing - ( and, or, xor, complement - , shiftLeftBy, shiftRightBy, shiftRightZfBy - ) + ( and, or, xor, complement + , shiftLeftBy, shiftRightBy, shiftRightZfBy + ) {-| Library for [bitwise operations](https://en.wikipedia.org/wiki/Bitwise_operation). + # Basic Operations + @docs and, or, xor, complement + # Bit Shifts + @docs shiftLeftBy, shiftRightBy, shiftRightZfBy --} +-} import Basics exposing (Int) -import Elm.Kernel.Bitwise - {-| Bitwise AND -} and : Int -> Int -> Int -and = - Elm.Kernel.Bitwise.and +and lhs rhs = + let + res = + and lhs rhs + in + res {-| Bitwise OR -} or : Int -> Int -> Int -or = - Elm.Kernel.Bitwise.or +or lhs rhs = + let + res = + or lhs rhs + in + res {-| Bitwise XOR -} xor : Int -> Int -> Int -xor = - Elm.Kernel.Bitwise.xor +xor lhs rhs = + let + res = + xor lhs rhs + in + res {-| Flip each bit individually, often called bitwise NOT -} complement : Int -> Int -complement = - Elm.Kernel.Bitwise.complement +complement x = + let + res = + complement x + in + res {-| Shift bits to the left by a given offset, filling new bits with zeros. This can be used to multiply numbers by powers of two. shiftLeftBy 1 5 == 10 + shiftLeftBy 5 1 == 32 + -} shiftLeftBy : Int -> Int -> Int -shiftLeftBy = - Elm.Kernel.Bitwise.shiftLeftBy +shiftLeftBy lhs rhs = + let + res = + shiftLeftBy lhs rhs + in + res {-| Shift bits to the right by a given offset, filling new bits with whatever is the topmost bit. This can be used to divide numbers by powers of two. - shiftRightBy 1 32 == 16 - shiftRightBy 2 32 == 8 + shiftRightBy 1 32 == 16 + + shiftRightBy 2 32 == 8 + shiftRightBy 1 -32 == -16 This is called an [arithmetic right shift][ars], often written `>>`, and @@ -69,16 +95,23 @@ sometimes called a sign-propagating right shift because it fills empty spots with copies of the highest bit. [ars]: https://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift + -} shiftRightBy : Int -> Int -> Int -shiftRightBy = - Elm.Kernel.Bitwise.shiftRightBy +shiftRightBy lhs rhs = + let + res = + shiftRightBy lhs rhs + in + res {-| Shift bits to the right by a given offset, filling new bits with zeros. - shiftRightZfBy 1 32 == 16 - shiftRightZfBy 2 32 == 8 + shiftRightZfBy 1 32 == 16 + + shiftRightZfBy 2 32 == 8 + shiftRightZfBy 1 -32 == 2147483632 This is called an [logical right shift][lrs], often written `>>>`, and @@ -86,8 +119,12 @@ sometimes called a zero-fill right shift because it fills empty spots with zeros. [lrs]: https://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift + -} shiftRightZfBy : Int -> Int -> Int -shiftRightZfBy = - Elm.Kernel.Bitwise.shiftRightZfBy - +shiftRightZfBy lhs rhs = + let + res = + shiftRightZfBy lhs rhs + in + res diff --git a/src/Char.elm b/src/Char.elm index 059c75a5..c3adac64 100644 --- a/src/Char.elm +++ b/src/Char.elm @@ -1,31 +1,42 @@ module Char exposing - ( Char - , isUpper, isLower, isAlpha, isAlphaNum - , isDigit, isOctDigit, isHexDigit - , toUpper, toLower, toLocaleUpper, toLocaleLower - , toCode, fromCode - ) + ( Char + , isUpper, isLower, isAlpha, isAlphaNum + , isDigit, isOctDigit, isHexDigit + , toUpper, toLower, toLocaleUpper, toLocaleLower + , toCode, fromCode + ) {-| Functions for working with characters. Character literals are enclosed in `'a'` pair of single quotes. + # Characters + @docs Char + # ASCII Letters + @docs isUpper, isLower, isAlpha, isAlphaNum + # Digits + @docs isDigit, isOctDigit, isHexDigit + # Conversion + @docs toUpper, toLower, toLocaleUpper, toLocaleLower + # Unicode Code Points + @docs toCode, fromCode + -} -import Basics exposing (Bool, Int, (&&), (||), (>=), (<=)) +import Basics exposing ((&&), (<=), (>=), (||), Bool, Int) import Elm.Kernel.Char @@ -36,17 +47,26 @@ import Elm.Kernel.Char {-| A `Char` is a single [unicode][u] character: 'a' + '0' + 'Z' + '?' + '"' + 'Σ' + '🙈' '\t' - '\"' + + '"' + '\'' - '\u{1F648}' -- '🙈' + + '🙈' -- '🙈' **Note 1:** You _cannot_ use single quotes around multiple characters like in JavaScript. This is how we distinguish [`String`](String#String) and `Char` @@ -58,8 +78,10 @@ characters directly. Using the escapes can be better if you need one of the many whitespace characters with different widths. [u]: https://en.wikipedia.org/wiki/Unicode + -} -type Char = Char -- NOTE: The compiler provides the real implementation. +type Char + = Char -- NOTE: The compiler provides the real implementation. @@ -69,115 +91,150 @@ type Char = Char -- NOTE: The compiler provides the real implementation. {-| Detect upper case ASCII characters. isUpper 'A' == True - isUpper 'B' == True - ... - isUpper 'Z' == True + + isUpper 'B' + == True + ... isUpper 'Z' + == True isUpper '0' == False + isUpper 'a' == False + isUpper '-' == False + isUpper 'Σ' == False + -} isUpper : Char -> Bool isUpper char = - let - code = - toCode char - in + let + code = + toCode char + in code <= 0x5A && 0x41 <= code {-| Detect lower case ASCII characters. isLower 'a' == True - isLower 'b' == True - ... - isLower 'z' == True + + isLower 'b' + == True + ... isLower 'z' + == True isLower '0' == False + isLower 'A' == False + isLower '-' == False + isLower 'π' == False + -} isLower : Char -> Bool isLower char = - let - code = - toCode char - in + let + code = + toCode char + in 0x61 <= code && code <= 0x7A {-| Detect upper case and lower case ASCII characters. isAlpha 'a' == True + isAlpha 'b' == True + isAlpha 'E' == True + isAlpha 'Y' == True isAlpha '0' == False + isAlpha '-' == False + isAlpha 'π' == False + -} isAlpha : Char -> Bool isAlpha char = - isLower char || isUpper char + isLower char || isUpper char {-| Detect upper case and lower case ASCII characters. isAlphaNum 'a' == True + isAlphaNum 'b' == True + isAlphaNum 'E' == True + isAlphaNum 'Y' == True + isAlphaNum '0' == True + isAlphaNum '7' == True isAlphaNum '-' == False + isAlphaNum 'π' == False + -} isAlphaNum : Char -> Bool isAlphaNum char = - isLower char || isUpper char || isDigit char + isLower char || isUpper char || isDigit char {-| Detect digits `0123456789` isDigit '0' == True - isDigit '1' == True - ... - isDigit '9' == True + + isDigit '1' + == True + ... isDigit '9' + == True isDigit 'a' == False + isDigit 'b' == False + isDigit 'A' == False + -} isDigit : Char -> Bool isDigit char = - let - code = - toCode char - in + let + code = + toCode char + in code <= 0x39 && 0x30 <= code {-| Detect octal digits `01234567` isOctDigit '0' == True - isOctDigit '1' == True - ... - isOctDigit '7' == True + + isOctDigit '1' + == True + ... isOctDigit '7' + == True isOctDigit '8' == False + isOctDigit 'a' == False + isOctDigit 'A' == False + -} isOctDigit : Char -> Bool isOctDigit char = - let - code = - toCode char - in + let + code = + toCode char + in code <= 0x37 && 0x30 <= code @@ -185,41 +242,45 @@ isOctDigit char = -} isHexDigit : Char -> Bool isHexDigit char = - let - code = - toCode char - in + let + code = + toCode char + in (0x30 <= code && code <= 0x39) - || (0x41 <= code && code <= 0x46) - || (0x61 <= code && code <= 0x66) + || (0x41 <= code && code <= 0x46) + || (0x61 <= code && code <= 0x66) -- CONVERSIONS -{-| Convert to upper case. -} +{-| Convert to upper case. +-} toUpper : Char -> Char toUpper = - Elm.Kernel.Char.toUpper + Elm.Kernel.Char.toUpper -{-| Convert to lower case. -} +{-| Convert to lower case. +-} toLower : Char -> Char toLower = - Elm.Kernel.Char.toLower + Elm.Kernel.Char.toLower -{-| Convert to upper case, according to any locale-specific case mappings. -} +{-| Convert to upper case, according to any locale-specific case mappings. +-} toLocaleUpper : Char -> Char toLocaleUpper = - Elm.Kernel.Char.toLocaleUpper + Elm.Kernel.Char.toLocaleUpper -{-| Convert to lower case, according to any locale-specific case mappings. -} +{-| Convert to lower case, according to any locale-specific case mappings. +-} toLocaleLower : Char -> Char toLocaleLower = - Elm.Kernel.Char.toLocaleLower + Elm.Kernel.Char.toLocaleLower {-| Convert to the corresponding Unicode [code point][cp]. @@ -227,31 +288,42 @@ toLocaleLower = [cp]: https://en.wikipedia.org/wiki/Code_point toCode 'A' == 65 + toCode 'B' == 66 + toCode '木' == 0x6728 - toCode '𝌆' == 0x1D306 - toCode '😃' == 0x1F603 + + toCode '𝌆' == 0x0001D306 + + toCode '😃' == 0x0001F603 + -} toCode : Char -> Int toCode = - Elm.Kernel.Char.toCode + Elm.Kernel.Char.toCode {-| Convert a Unicode [code point][cp] to a character. - fromCode 65 == 'A' - fromCode 66 == 'B' - fromCode 0x6728 == '木' - fromCode 0x1D306 == '𝌆' - fromCode 0x1F603 == '😃' - fromCode -1 == '�' + fromCode 65 == 'A' + + fromCode 66 == 'B' + + fromCode 0x6728 == '木' + + fromCode 0x0001D306 == '𝌆' + + fromCode 0x0001F603 == '😃' + + fromCode -1 == '�' The full range of unicode is from `0` to `0x10FFFF`. With numbers outside that range, you get [the replacement character][fffd]. [cp]: https://en.wikipedia.org/wiki/Code_point [fffd]: https://en.wikipedia.org/wiki/Specials_(Unicode_block)#Replacement_character + -} fromCode : Int -> Char fromCode = - Elm.Kernel.Char.fromCode + Elm.Kernel.Char.fromCode diff --git a/src/Debug.elm b/src/Debug.elm index cb8e32f3..fdaae093 100644 --- a/src/Debug.elm +++ b/src/Debug.elm @@ -1,16 +1,14 @@ -module Debug exposing - ( toString - , log - , todo - ) +module Debug exposing (toString, log, todo) {-| This module can be useful while _developing_ an application. It is not available for use in packages or production. + # Debugging + @docs toString, log, todo --} +-} import Elm.Kernel.Debug import String exposing (String) @@ -18,9 +16,12 @@ import String exposing (String) {-| Turn any kind of value into a string. - toString 42 == "42" - toString [1,2] == "[1,2]" - toString ('a', "cat", 13) == "('a', \"cat\", 13)" + toString 42 == "42" + + toString [ 1, 2 ] == "[1,2]" + + toString ( 'a', "cat", 13 ) == "('a', \"cat\", 13)" + toString "he said, \"hi\"" == "\"he said, \\\"hi\\\"\"" Notice that with strings, this is not the `identity` function. It escapes @@ -32,16 +33,18 @@ for viewing Elm data structures. a bunch of runtime metadata. For example, it shortens record field names, and we need that info to `toString` the value! As a consequence, packages cannot use `toString` because they may be used in `--optimize` mode. + -} toString : a -> String toString = - Elm.Kernel.Debug.toString + Elm.Kernel.Debug.toString {-| Log a tagged value on the developer console, and then return the value. - 1 + log "number" 1 -- equals 2, logs "number: 1" - length (log "start" []) -- equals 0, logs "start: []" + 1 + log "number" 1 -- equals 2, logs "number: 1" + + length (log "start" []) -- equals 0, logs "start: []" It is often possible to sprinkle this around to see if values are what you expect. It is kind of old-school to do it this way, but it works! @@ -55,10 +58,11 @@ compiler optimizations that move code around. use ports for now. That will give you full access to reading and writing in the terminal. We may have a package in Elm for this someday, but browser applications are the primary focus of platform development for now. + -} log : String -> a -> a log = - Elm.Kernel.Debug.log + Elm.Kernel.Debug.log {-| This is a placeholder for code that you will write later. @@ -90,8 +94,8 @@ exceptions should not appear in the resulting applications. **Note:** For the equivalent of try/catch error handling in Elm, use modules like [`Maybe`](#Maybe) and [`Result`](#Result) which guarantee that no error goes unhandled! + -} todo : String -> a todo = - Elm.Kernel.Debug.todo - + Elm.Kernel.Debug.todo diff --git a/src/Dict.elm b/src/Dict.elm index 3f80842c..840d1c9c 100644 --- a/src/Dict.elm +++ b/src/Dict.elm @@ -1,49 +1,60 @@ module Dict exposing - ( Dict - , empty, singleton, insert, update, remove - , isEmpty, member, get, size - , keys, values, toList, fromList - , map, foldl, foldr, filter, partition - , union, intersect, diff, merge - ) + ( Dict + , empty, singleton, insert, update, remove + , isEmpty, member, get, size + , keys, values, toList, fromList + , map, foldl, foldr, filter, partition + , union, intersect, diff, merge + ) {-| A dictionary mapping unique keys to values. The keys can be any comparable type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or lists of comparable types. -Insert, remove, and query operations all take *O(log n)* time. +Insert, remove, and query operations all take _O(log n)_ time. + # Dictionaries + @docs Dict + # Build + @docs empty, singleton, insert, update, remove + # Query + @docs isEmpty, member, get, size + # Lists + @docs keys, values, toList, fromList + # Transform + @docs map, foldl, foldr, filter, partition + # Combine + @docs union, intersect, diff, merge -} - import Basics exposing (..) -import Maybe exposing (..) import List exposing (..) +import Maybe exposing (..) -- DICTIONARIES +-- The color of a node. Leaves are considered Black. --- The color of a node. Leaves are considered Black. type NColor = Red | Black @@ -57,27 +68,29 @@ that lets you look up a `String` (such as user names) and find the associated users : Dict String User users = - Dict.fromList - [ ("Alice", User "Alice" 28 1.65) - , ("Bob" , User "Bob" 19 1.82) - , ("Chuck", User "Chuck" 33 1.75) - ] + Dict.fromList + [ ( "Alice", User "Alice" 28 1.65 ) + , ( "Bob", User "Bob" 19 1.82 ) + , ( "Chuck", User "Chuck" 33 1.75 ) + ] type alias User = - { name : String - , age : Int - , height : Float - } + { name : String + , age : Int + , height : Float + } + -} type Dict k v = RBNode_elm_builtin NColor k v (Dict k v) (Dict k v) | RBEmpty_elm_builtin -{-| Create an empty dictionary. -} +{-| Create an empty dictionary. +-} empty : Dict k v empty = - RBEmpty_elm_builtin + RBEmpty_elm_builtin {-| Get the value associated with a key. If the key is not found, return @@ -93,137 +106,142 @@ dictionary. -} get : comparable -> Dict comparable v -> Maybe v get targetKey dict = - case dict of - RBEmpty_elm_builtin -> - Nothing + case dict of + RBEmpty_elm_builtin -> + Nothing - RBNode_elm_builtin _ key value left right -> - case compare targetKey key of - LT -> - get targetKey left + RBNode_elm_builtin _ key value left right -> + case compare targetKey key of + LT -> + get targetKey left - EQ -> - Just value + EQ -> + Just value - GT -> - get targetKey right + GT -> + get targetKey right -{-| Determine if a key is in a dictionary. -} +{-| Determine if a key is in a dictionary. +-} member : comparable -> Dict comparable v -> Bool member key dict = - case get key dict of - Just _ -> - True + case get key dict of + Just _ -> + True - Nothing -> - False + Nothing -> + False -{-| Determine the number of key-value pairs in the dictionary. -} +{-| Determine the number of key-value pairs in the dictionary. +-} size : Dict k v -> Int size dict = - sizeHelp 0 dict + sizeHelp 0 dict sizeHelp : Int -> Dict k v -> Int sizeHelp n dict = - case dict of - RBEmpty_elm_builtin -> - n + case dict of + RBEmpty_elm_builtin -> + n - RBNode_elm_builtin _ _ _ left right -> - sizeHelp (sizeHelp (n+1) right) left + RBNode_elm_builtin _ _ _ left right -> + sizeHelp (sizeHelp (n + 1) right) left {-| Determine if a dictionary is empty. isEmpty empty == True + -} isEmpty : Dict k v -> Bool isEmpty dict = - case dict of - RBEmpty_elm_builtin -> - True + case dict of + RBEmpty_elm_builtin -> + True - RBNode_elm_builtin _ _ _ _ _ -> - False + RBNode_elm_builtin _ _ _ _ _ -> + False {-| Insert a key-value pair into a dictionary. Replaces value when there is -a collision. -} +a collision. +-} insert : comparable -> v -> Dict comparable v -> Dict comparable v insert key value dict = - -- Root node is always Black - case insertHelp key value dict of - RBNode_elm_builtin Red k v l r -> - RBNode_elm_builtin Black k v l r + -- Root node is always Black + case insertHelp key value dict of + RBNode_elm_builtin Red k v l r -> + RBNode_elm_builtin Black k v l r - x -> - x + x -> + x insertHelp : comparable -> v -> Dict comparable v -> Dict comparable v insertHelp key value dict = - case dict of - RBEmpty_elm_builtin -> - -- New nodes are always red. If it violates the rules, it will be fixed - -- when balancing. - RBNode_elm_builtin Red key value RBEmpty_elm_builtin RBEmpty_elm_builtin + case dict of + RBEmpty_elm_builtin -> + -- New nodes are always red. If it violates the rules, it will be fixed + -- when balancing. + RBNode_elm_builtin Red key value RBEmpty_elm_builtin RBEmpty_elm_builtin - RBNode_elm_builtin nColor nKey nValue nLeft nRight -> - case compare key nKey of - LT -> - balance nColor nKey nValue (insertHelp key value nLeft) nRight + RBNode_elm_builtin nColor nKey nValue nLeft nRight -> + case compare key nKey of + LT -> + balance nColor nKey nValue (insertHelp key value nLeft) nRight - EQ -> - RBNode_elm_builtin nColor nKey value nLeft nRight + EQ -> + RBNode_elm_builtin nColor nKey value nLeft nRight - GT -> - balance nColor nKey nValue nLeft (insertHelp key value nRight) + GT -> + balance nColor nKey nValue nLeft (insertHelp key value nRight) balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v balance color key value left right = - case right of - RBNode_elm_builtin Red rK rV rLeft rRight -> - case left of - RBNode_elm_builtin Red lK lV lLeft lRight -> - RBNode_elm_builtin - Red - key - value - (RBNode_elm_builtin Black lK lV lLeft lRight) - (RBNode_elm_builtin Black rK rV rLeft rRight) + case right of + RBNode_elm_builtin Red rK rV rLeft rRight -> + case left of + RBNode_elm_builtin Red lK lV lLeft lRight -> + RBNode_elm_builtin + Red + key + value + (RBNode_elm_builtin Black lK lV lLeft lRight) + (RBNode_elm_builtin Black rK rV rLeft rRight) + + _ -> + RBNode_elm_builtin color rK rV (RBNode_elm_builtin Red key value left rLeft) rRight _ -> - RBNode_elm_builtin color rK rV (RBNode_elm_builtin Red key value left rLeft) rRight - - _ -> - case left of - RBNode_elm_builtin Red lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight -> - RBNode_elm_builtin - Red - lK - lV - (RBNode_elm_builtin Black llK llV llLeft llRight) - (RBNode_elm_builtin Black key value lRight right) + case left of + RBNode_elm_builtin Red lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight -> + RBNode_elm_builtin + Red + lK + lV + (RBNode_elm_builtin Black llK llV llLeft llRight) + (RBNode_elm_builtin Black key value lRight right) - _ -> - RBNode_elm_builtin color key value left right + _ -> + RBNode_elm_builtin color key value left right {-| Remove a key-value pair from a dictionary. If the key is not found, -no changes are made. -} +no changes are made. +-} remove : comparable -> Dict comparable v -> Dict comparable v remove key dict = - -- Root node is always Black - case removeHelp key dict of - RBNode_elm_builtin Red k v l r -> - RBNode_elm_builtin Black k v l r + -- Root node is always Black + case removeHelp key dict of + RBNode_elm_builtin Red k v l r -> + RBNode_elm_builtin Black k v l r - x -> - x + x -> + x {-| The easiest thing to remove from the tree, is a red node. However, when searching for the @@ -234,53 +252,54 @@ up again. -} removeHelp : comparable -> Dict comparable v -> Dict comparable v removeHelp targetKey dict = - case dict of - RBEmpty_elm_builtin -> - RBEmpty_elm_builtin + case dict of + RBEmpty_elm_builtin -> + RBEmpty_elm_builtin + + RBNode_elm_builtin color key value left right -> + if targetKey < key then + case left of + RBNode_elm_builtin Black _ _ lLeft _ -> + case lLeft of + RBNode_elm_builtin Red _ _ _ _ -> + RBNode_elm_builtin color key value (removeHelp targetKey left) right - RBNode_elm_builtin color key value left right -> - if targetKey < key then - case left of - RBNode_elm_builtin Black _ _ lLeft _ -> - case lLeft of - RBNode_elm_builtin Red _ _ _ _ -> - RBNode_elm_builtin color key value (removeHelp targetKey left) right + _ -> + case moveRedLeft dict of + RBNode_elm_builtin nColor nKey nValue nLeft nRight -> + balance nColor nKey nValue (removeHelp targetKey nLeft) nRight - _ -> - case moveRedLeft dict of - RBNode_elm_builtin nColor nKey nValue nLeft nRight -> - balance nColor nKey nValue (removeHelp targetKey nLeft) nRight + RBEmpty_elm_builtin -> + RBEmpty_elm_builtin - RBEmpty_elm_builtin -> - RBEmpty_elm_builtin + _ -> + RBNode_elm_builtin color key value (removeHelp targetKey left) right - _ -> - RBNode_elm_builtin color key value (removeHelp targetKey left) right - else - removeHelpEQGT targetKey (removeHelpPrepEQGT targetKey dict color key value left right) + else + removeHelpEQGT targetKey (removeHelpPrepEQGT targetKey dict color key value left right) removeHelpPrepEQGT : comparable -> Dict comparable v -> NColor -> comparable -> v -> Dict comparable v -> Dict comparable v -> Dict comparable v removeHelpPrepEQGT targetKey dict color key value left right = - case left of - RBNode_elm_builtin Red lK lV lLeft lRight -> - RBNode_elm_builtin - color - lK - lV - lLeft - (RBNode_elm_builtin Red key value lRight right) - - _ -> - case right of - RBNode_elm_builtin Black _ _ (RBNode_elm_builtin Black _ _ _ _) _ -> - moveRedRight dict - - RBNode_elm_builtin Black _ _ RBEmpty_elm_builtin _ -> - moveRedRight dict + case left of + RBNode_elm_builtin Red lK lV lLeft lRight -> + RBNode_elm_builtin + color + lK + lV + lLeft + (RBNode_elm_builtin Red key value lRight right) _ -> - dict + case right of + RBNode_elm_builtin Black _ _ (RBNode_elm_builtin Black _ _ _ _) _ -> + moveRedRight dict + + RBNode_elm_builtin Black _ _ RBEmpty_elm_builtin _ -> + moveRedRight dict + + _ -> + dict {-| When we find the node we are looking for, we can remove by replacing the key-value @@ -288,139 +307,143 @@ pair with the key-value pair of the left-most node on the right side (the closes -} removeHelpEQGT : comparable -> Dict comparable v -> Dict comparable v removeHelpEQGT targetKey dict = - case dict of - RBNode_elm_builtin color key value left right -> - if targetKey == key then - case getMin right of - RBNode_elm_builtin _ minKey minValue _ _ -> - balance color minKey minValue left (removeMin right) - - RBEmpty_elm_builtin -> - RBEmpty_elm_builtin - else - balance color key value left (removeHelp targetKey right) + case dict of + RBNode_elm_builtin color key value left right -> + if targetKey == key then + case getMin right of + RBNode_elm_builtin _ minKey minValue _ _ -> + balance color minKey minValue left (removeMin right) + + RBEmpty_elm_builtin -> + RBEmpty_elm_builtin - RBEmpty_elm_builtin -> - RBEmpty_elm_builtin + else + balance color key value left (removeHelp targetKey right) + + RBEmpty_elm_builtin -> + RBEmpty_elm_builtin getMin : Dict k v -> Dict k v getMin dict = - case dict of - RBNode_elm_builtin _ _ _ ((RBNode_elm_builtin _ _ _ _ _) as left) _ -> - getMin left + case dict of + RBNode_elm_builtin _ _ _ ((RBNode_elm_builtin _ _ _ _ _) as left) _ -> + getMin left - _ -> - dict + _ -> + dict removeMin : Dict k v -> Dict k v removeMin dict = - case dict of - RBNode_elm_builtin color key value ((RBNode_elm_builtin lColor _ _ lLeft _) as left) right -> - case lColor of - Black -> - case lLeft of - RBNode_elm_builtin Red _ _ _ _ -> - RBNode_elm_builtin color key value (removeMin left) right - - _ -> - case moveRedLeft dict of - RBNode_elm_builtin nColor nKey nValue nLeft nRight -> - balance nColor nKey nValue (removeMin nLeft) nRight - - RBEmpty_elm_builtin -> - RBEmpty_elm_builtin + case dict of + RBNode_elm_builtin color key value ((RBNode_elm_builtin lColor _ _ lLeft _) as left) right -> + case lColor of + Black -> + case lLeft of + RBNode_elm_builtin Red _ _ _ _ -> + RBNode_elm_builtin color key value (removeMin left) right - _ -> - RBNode_elm_builtin color key value (removeMin left) right + _ -> + case moveRedLeft dict of + RBNode_elm_builtin nColor nKey nValue nLeft nRight -> + balance nColor nKey nValue (removeMin nLeft) nRight - _ -> - RBEmpty_elm_builtin + RBEmpty_elm_builtin -> + RBEmpty_elm_builtin + + _ -> + RBNode_elm_builtin color key value (removeMin left) right + + _ -> + RBEmpty_elm_builtin moveRedLeft : Dict k v -> Dict k v moveRedLeft dict = - case dict of - RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV ((RBNode_elm_builtin Red rlK rlV rlL rlR) as rLeft) rRight) -> - RBNode_elm_builtin - Red - rlK - rlV - (RBNode_elm_builtin Black k v (RBNode_elm_builtin Red lK lV lLeft lRight) rlL) - (RBNode_elm_builtin Black rK rV rlR rRight) - - RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) -> - case clr of - Black -> - RBNode_elm_builtin - Black - k - v - (RBNode_elm_builtin Red lK lV lLeft lRight) - (RBNode_elm_builtin Red rK rV rLeft rRight) - - Red -> - RBNode_elm_builtin - Black - k - v - (RBNode_elm_builtin Red lK lV lLeft lRight) - (RBNode_elm_builtin Red rK rV rLeft rRight) - - _ -> - dict + case dict of + RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV ((RBNode_elm_builtin Red rlK rlV rlL rlR) as rLeft) rRight) -> + RBNode_elm_builtin + Red + rlK + rlV + (RBNode_elm_builtin Black k v (RBNode_elm_builtin Red lK lV lLeft lRight) rlL) + (RBNode_elm_builtin Black rK rV rlR rRight) + + RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) -> + case clr of + Black -> + RBNode_elm_builtin + Black + k + v + (RBNode_elm_builtin Red lK lV lLeft lRight) + (RBNode_elm_builtin Red rK rV rLeft rRight) + + Red -> + RBNode_elm_builtin + Black + k + v + (RBNode_elm_builtin Red lK lV lLeft lRight) + (RBNode_elm_builtin Red rK rV rLeft rRight) + + _ -> + dict moveRedRight : Dict k v -> Dict k v moveRedRight dict = - case dict of - RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) -> - RBNode_elm_builtin - Red - lK - lV - (RBNode_elm_builtin Black llK llV llLeft llRight) - (RBNode_elm_builtin Black k v lRight (RBNode_elm_builtin Red rK rV rLeft rRight)) - - RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) -> - case clr of - Black -> - RBNode_elm_builtin - Black - k - v - (RBNode_elm_builtin Red lK lV lLeft lRight) - (RBNode_elm_builtin Red rK rV rLeft rRight) - - Red -> - RBNode_elm_builtin - Black - k - v - (RBNode_elm_builtin Red lK lV lLeft lRight) - (RBNode_elm_builtin Red rK rV rLeft rRight) - - _ -> - dict - - -{-| Update the value of a dictionary for a specific key with a given function. -} + case dict of + RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) -> + RBNode_elm_builtin + Red + lK + lV + (RBNode_elm_builtin Black llK llV llLeft llRight) + (RBNode_elm_builtin Black k v lRight (RBNode_elm_builtin Red rK rV rLeft rRight)) + + RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) -> + case clr of + Black -> + RBNode_elm_builtin + Black + k + v + (RBNode_elm_builtin Red lK lV lLeft lRight) + (RBNode_elm_builtin Red rK rV rLeft rRight) + + Red -> + RBNode_elm_builtin + Black + k + v + (RBNode_elm_builtin Red lK lV lLeft lRight) + (RBNode_elm_builtin Red rK rV rLeft rRight) + + _ -> + dict + + +{-| Update the value of a dictionary for a specific key with a given function. +-} update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v update targetKey alter dictionary = - case alter (get targetKey dictionary) of - Just value -> - insert targetKey value dictionary + case alter (get targetKey dictionary) of + Just value -> + insert targetKey value dictionary - Nothing -> - remove targetKey dictionary + Nothing -> + remove targetKey dictionary -{-| Create a dictionary with one key-value pair. -} +{-| Create a dictionary with one key-value pair. +-} singleton : comparable -> v -> Dict comparable v singleton key value = - -- Root node is always Black - RBNode_elm_builtin Black key value RBEmpty_elm_builtin RBEmpty_elm_builtin + -- Root node is always Black + RBNode_elm_builtin Black key value RBEmpty_elm_builtin RBEmpty_elm_builtin + -- COMBINE @@ -431,7 +454,7 @@ to the first dictionary. -} union : Dict comparable v -> Dict comparable v -> Dict comparable v union t1 t2 = - foldl insert t2 t1 + foldl insert t2 t1 {-| Keep a key-value pair when its key appears in the second dictionary. @@ -439,55 +462,56 @@ Preference is given to values in the first dictionary. -} intersect : Dict comparable v -> Dict comparable v -> Dict comparable v intersect t1 t2 = - filter (\k _ -> member k t2) t1 + filter (\k _ -> member k t2) t1 {-| Keep a key-value pair when its key does not appear in the second dictionary. -} diff : Dict comparable a -> Dict comparable b -> Dict comparable a diff t1 t2 = - foldl (\k v t -> remove k t) t1 t2 + foldl (\k v t -> remove k t) t1 t2 {-| The most general way of combining two dictionaries. You provide three accumulators for when a given key appears: - 1. Only in the left dictionary. - 2. In both dictionaries. - 3. Only in the right dictionary. +1. Only in the left dictionary. +2. In both dictionaries. +3. Only in the right dictionary. You then traverse all the keys from lowest to highest, building up whatever you want. + -} -merge - : (comparable -> a -> result -> result) - -> (comparable -> a -> b -> result -> result) - -> (comparable -> b -> result -> result) - -> Dict comparable a - -> Dict comparable b - -> result - -> result +merge : + (comparable -> a -> result -> result) + -> (comparable -> a -> b -> result -> result) + -> (comparable -> b -> result -> result) + -> Dict comparable a + -> Dict comparable b + -> result + -> result merge leftStep bothStep rightStep leftDict rightDict initialResult = - let - stepState rKey rValue (list, result) = - case list of - [] -> - (list, rightStep rKey rValue result) + let + stepState rKey rValue ( list, result ) = + case list of + [] -> + ( list, rightStep rKey rValue result ) - (lKey, lValue) :: rest -> - if lKey < rKey then - stepState rKey rValue (rest, leftStep lKey lValue result) + ( lKey, lValue ) :: rest -> + if lKey < rKey then + stepState rKey rValue ( rest, leftStep lKey lValue result ) - else if lKey > rKey then - (list, rightStep rKey rValue result) + else if lKey > rKey then + ( list, rightStep rKey rValue result ) - else - (rest, bothStep lKey lValue rValue result) + else + ( rest, bothStep lKey lValue rValue result ) - (leftovers, intermediateResult) = - foldl stepState (toList leftDict, initialResult) rightDict - in - List.foldl (\(k,v) result -> leftStep k v result) intermediateResult leftovers + ( leftovers, intermediateResult ) = + foldl stepState ( toList leftDict, initialResult ) rightDict + in + List.foldl (\( k, v ) result -> leftStep k v result) intermediateResult leftovers @@ -498,12 +522,12 @@ merge leftStep bothStep rightStep leftDict rightDict initialResult = -} map : (k -> a -> b) -> Dict k a -> Dict k b map func dict = - case dict of - RBEmpty_elm_builtin -> - RBEmpty_elm_builtin + case dict of + RBEmpty_elm_builtin -> + RBEmpty_elm_builtin - RBNode_elm_builtin color key value left right -> - RBNode_elm_builtin color key (func key value) (map func left) (map func right) + RBNode_elm_builtin color key value left right -> + RBNode_elm_builtin color key (func key value) (map func left) (map func right) {-| Fold over the key-value pairs in a dictionary from lowest key to highest key. @@ -512,22 +536,23 @@ map func dict = getAges : Dict String User -> List String getAges users = - Dict.foldl addAge [] users + Dict.foldl addAge [] users addAge : String -> User -> List String -> List String addAge _ user ages = - user.age :: ages + user.age :: ages -- getAges users == [33,19,28] + -} foldl : (k -> v -> b -> b) -> b -> Dict k v -> b foldl func acc dict = - case dict of - RBEmpty_elm_builtin -> - acc + case dict of + RBEmpty_elm_builtin -> + acc - RBNode_elm_builtin _ key value left right -> - foldl func (func key value (foldl func acc left)) right + RBNode_elm_builtin _ key value left right -> + foldl func (func key value (foldl func acc left)) right {-| Fold over the key-value pairs in a dictionary from highest key to lowest key. @@ -536,45 +561,57 @@ foldl func acc dict = getAges : Dict String User -> List String getAges users = - Dict.foldr addAge [] users + Dict.foldr addAge [] users addAge : String -> User -> List String -> List String addAge _ user ages = - user.age :: ages + user.age :: ages -- getAges users == [28,19,33] + -} foldr : (k -> v -> b -> b) -> b -> Dict k v -> b foldr func acc t = - case t of - RBEmpty_elm_builtin -> - acc + case t of + RBEmpty_elm_builtin -> + acc - RBNode_elm_builtin _ key value left right -> - foldr func (func key value (foldr func acc right)) left + RBNode_elm_builtin _ key value left right -> + foldr func (func key value (foldr func acc right)) left -{-| Keep only the key-value pairs that pass the given test. -} +{-| Keep only the key-value pairs that pass the given test. +-} filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v filter isGood dict = - foldl (\k v d -> if isGood k v then insert k v d else d) empty dict + foldl + (\k v d -> + if isGood k v then + insert k v d + + else + d + ) + empty + dict {-| Partition a dictionary according to some test. The first dictionary contains all key-value pairs which passed the test, and the second contains the pairs that did not. -} -partition : (comparable -> v -> Bool) -> Dict comparable v -> (Dict comparable v, Dict comparable v) +partition : (comparable -> v -> Bool) -> Dict comparable v -> ( Dict comparable v, Dict comparable v ) partition isGood dict = - let - add key value (t1, t2) = - if isGood key value then - (insert key value t1, t2) + let + add key value ( t1, t2 ) = + if isGood key value then + ( insert key value t1, t2 ) + + else + ( t1, insert key value t2 ) + in + foldl add ( empty, empty ) dict - else - (t1, insert key value t2) - in - foldl add (empty, empty) dict -- LISTS @@ -582,29 +619,33 @@ partition isGood dict = {-| Get all of the keys in a dictionary, sorted from lowest to highest. - keys (fromList [(0,"Alice"),(1,"Bob")]) == [0,1] + keys (fromList [ ( 0, "Alice" ), ( 1, "Bob" ) ]) == [ 0, 1 ] + -} keys : Dict k v -> List k keys dict = - foldr (\key value keyList -> key :: keyList) [] dict + foldr (\key value keyList -> key :: keyList) [] dict {-| Get all of the values in a dictionary, in the order of their keys. - values (fromList [(0,"Alice"),(1,"Bob")]) == ["Alice", "Bob"] + values (fromList [ ( 0, "Alice" ), ( 1, "Bob" ) ]) == [ "Alice", "Bob" ] + -} values : Dict k v -> List v values dict = - foldr (\key value valueList -> value :: valueList) [] dict + foldr (\key value valueList -> value :: valueList) [] dict -{-| Convert a dictionary into an association list of key-value pairs, sorted by keys. -} -toList : Dict k v -> List (k,v) +{-| Convert a dictionary into an association list of key-value pairs, sorted by keys. +-} +toList : Dict k v -> List ( k, v ) toList dict = - foldr (\key value list -> (key,value) :: list) [] dict + foldr (\key value list -> ( key, value ) :: list) [] dict -{-| Convert an association list into a dictionary. -} -fromList : List (comparable,v) -> Dict comparable v +{-| Convert an association list into a dictionary. +-} +fromList : List ( comparable, v ) -> Dict comparable v fromList assocs = - List.foldl (\(key,value) dict -> insert key value dict) empty assocs + List.foldl (\( key, value ) dict -> insert key value dict) empty assocs diff --git a/src/Elm/JsArray.elm b/src/Elm/JsArray.elm index 40076231..a29d4c79 100644 --- a/src/Elm/JsArray.elm +++ b/src/Elm/JsArray.elm @@ -1,47 +1,42 @@ -module Elm.JsArray - exposing - ( JsArray - , empty - , singleton - , length - , initialize - , initializeFromList - , unsafeGet - , unsafeSet - , push - , foldl - , foldr - , map - , indexedMap - , slice - , appendN - ) +module Elm.JsArray exposing + ( JsArray + , empty, singleton, initialize + , length, unsafeGet, unsafeSet, push + , foldl, foldr, map, slice + , appendN, indexedMap, initializeFromList + ) {-| This library provides an immutable version of native javascript arrays. NOTE: All manipulations causes a copy of the entire array, this can be slow. For general purpose use, try the `Array` module instead. + # Arrays + @docs JsArray + # Creation + @docs empty, singleton, initialize, listInitialize + # Basics + @docs length, unsafeGet, unsafeSet, push + # Transformation + @docs foldl, foldr, map, slice, merge -} - import Basics exposing (Int) import Elm.Kernel.JsArray - {-| Representation of a javascript array. -} type JsArray a @@ -75,7 +70,8 @@ with the element at index `i` initialized to the result of `(f (i + offset))`. The offset parameter is there so one can avoid creating a closure for this use case. This is an optimization that has proved useful in the `Array` module. - initialize 3 5 identity == [5,6,7] + initialize 3 5 identity == [ 5, 6, 7 ] + -} initialize : Int -> Int -> (Int -> a) -> JsArray a initialize = @@ -91,6 +87,7 @@ to create `JsArray`s above a certain size. That being said, because every manipulation of `JsArray` results in a copy, users should always try to keep these as small as possible. The `n` parameter should always be set to a reasonably small value. + -} initializeFromList : Int -> List a -> ( JsArray a, List a ) initializeFromList = @@ -101,6 +98,7 @@ initializeFromList = WARNING: This function does not perform bounds checking. Make sure you know the index is within bounds when using this function. + -} unsafeGet : Int -> JsArray a -> a unsafeGet = @@ -111,6 +109,7 @@ unsafeGet = WARNING: This function does not perform bounds checking. Make sure you know the index is within bounds when using this function. + -} unsafeSet : Int -> a -> JsArray a -> JsArray a unsafeSet = @@ -148,7 +147,8 @@ map = {-| Apply a function on every element and its index in an array. An offset allows to modify the index passed to the function. - indexedMap (,) 5 (repeat 3 3) == Array [(5,3), (6,3), (7,3)] + indexedMap (,) 5 (repeat 3 3) == Array [ ( 5, 3 ), ( 6, 3 ), ( 7, 3 ) ] + -} indexedMap : (Int -> a -> b) -> Int -> JsArray a -> JsArray b indexedMap = @@ -165,6 +165,7 @@ of the array. Popping the last element of the array is therefore: `slice 0 -1 arr`. In the case of an impossible slice, the empty array is returned. + -} slice : Int -> Int -> JsArray a -> JsArray a slice = @@ -175,6 +176,7 @@ slice = The `n` parameter is required by the `Array` module, which never wants to create `JsArray`s above a certain size, even when appending. + -} appendN : Int -> JsArray a -> JsArray a -> JsArray a appendN = diff --git a/src/Elm/Kernel/Basics.js b/src/Elm/Kernel/Basics.js index 049291f9..eed99a32 100644 --- a/src/Elm/Kernel/Basics.js +++ b/src/Elm/Kernel/Basics.js @@ -1,64 +1,44 @@ /* -import Elm.Kernel.Debug exposing (crash) +import Elm.Kernel.Debug exposing (crash, runtimeCrashReason) */ - // MATH -var _Basics_add = F2(function(a, b) { return a + b; }); -var _Basics_sub = F2(function(a, b) { return a - b; }); -var _Basics_mul = F2(function(a, b) { return a * b; }); -var _Basics_fdiv = F2(function(a, b) { return a / b; }); -var _Basics_idiv = F2(function(a, b) { return (a / b) | 0; }); -var _Basics_pow = F2(Math.pow); - -var _Basics_remainderBy = F2(function(b, a) { return a % b; }); - -// https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf -var _Basics_modBy = F2(function(modulus, x) -{ - var answer = x % modulus; - return modulus === 0 - ? __Debug_crash(11) - : - ((answer > 0 && modulus < 0) || (answer < 0 && modulus > 0)) - ? answer + modulus - : answer; -}); - - -// TRIGONOMETRY - -var _Basics_pi = Math.PI; -var _Basics_e = Math.E; -var _Basics_cos = Math.cos; -var _Basics_sin = Math.sin; -var _Basics_tan = Math.tan; -var _Basics_acos = Math.acos; -var _Basics_asin = Math.asin; -var _Basics_atan = Math.atan; -var _Basics_atan2 = F2(Math.atan2); - - -// MORE MATH - -function _Basics_toFloat(x) { return x; } -function _Basics_truncate(n) { return n | 0; } -function _Basics_isInfinite(n) { return n === Infinity || n === -Infinity; } - -var _Basics_ceiling = Math.ceil; -var _Basics_floor = Math.floor; -var _Basics_round = Math.round; -var _Basics_sqrt = Math.sqrt; -var _Basics_log = Math.log; -var _Basics_isNaN = isNaN; - - -// BOOLEANS - -function _Basics_not(bool) { return !bool; } -var _Basics_and = F2(function(a, b) { return a && b; }); -var _Basics_or = F2(function(a, b) { return a || b; }); -var _Basics_xor = F2(function(a, b) { return a !== b; }); +const _Basics_pow = F2(Math.pow); + +const _Basics_cos = Math.cos; +const _Basics_sin = Math.sin; +const _Basics_tan = Math.tan; +const _Basics_acos = Math.acos; +const _Basics_asin = Math.asin; +const _Basics_atan = Math.atan; +const _Basics_atan2 = F2(Math.atan2); + +const _Basics_ceiling = Math.ceil; +const _Basics_floor = Math.floor; +const _Basics_round = Math.round; +const _Basics_sqrt = Math.sqrt; +const _Basics_log = Math.log; + +const _Basics_modBy0 = () => __Debug_crash(11); + +const _Basics_fudgeType = (x) => x; + +const _Basics_unwrapTypeWrapper__DEBUG = (wrapped) => { + const entries = Object.entries(wrapped); + if (entries.length !== 2) { + __Debug_crash(12, __Debug_runtimeCrashReason("failedUnwrap"), wrapped); + } + if (entries[0][0] === "$") { + return entries[1][1]; + } else { + return entries[0][1]; + } +}; + +const _Basics_unwrapTypeWrapper__PROD = (wrapped) => wrapped; + +const _Basics_isDebug__DEBUG = true; +const _Basics_isDebug__PROD = false; diff --git a/src/Elm/Kernel/Bitwise.js b/src/Elm/Kernel/Bitwise.js deleted file mode 100644 index 612e8c7c..00000000 --- a/src/Elm/Kernel/Bitwise.js +++ /dev/null @@ -1,39 +0,0 @@ -/* - -*/ - - -var _Bitwise_and = F2(function(a, b) -{ - return a & b; -}); - -var _Bitwise_or = F2(function(a, b) -{ - return a | b; -}); - -var _Bitwise_xor = F2(function(a, b) -{ - return a ^ b; -}); - -function _Bitwise_complement(a) -{ - return ~a; -}; - -var _Bitwise_shiftLeftBy = F2(function(offset, a) -{ - return a << offset; -}); - -var _Bitwise_shiftRightBy = F2(function(offset, a) -{ - return a >> offset; -}); - -var _Bitwise_shiftRightZfBy = F2(function(offset, a) -{ - return a >>> offset; -}); diff --git a/src/Elm/Kernel/Channel.js b/src/Elm/Kernel/Channel.js new file mode 100644 index 00000000..e01fffab --- /dev/null +++ b/src/Elm/Kernel/Channel.js @@ -0,0 +1,88 @@ +/* + +import Maybe exposing (Just, Nothing) +import Elm.Kernel.Basics exposing (isDebug) +import Elm.Kernel.Debug exposing (crash, runtimeCrashReason) +import Elm.Kernel.Utils exposing (Tuple0, Tuple2) +*/ + +const _Channel_channels = new WeakMap(); +let _Channel_channelId = 0; + +const _Channel_rawUnbounded = (_) => { + const id = { + id: _Channel_channelId++, + }; + _Channel_channels.set(id, { + messages: [], + wakers: new Set(), + }); + return __Utils_Tuple2(_Channel_rawSendImpl(id), id); +}; + +const _Channel_rawTryRecv = (channelId) => { + const channel = _Channel_channels.get(channelId); + if (__Basics_isDebug && channel === undefined) { + __Debug_crash( + 12, + __Debug_runtimeCrashReason("channelIdNotRegistered"), + channelId && channelId.a && channelId.a.__$id + ); + } + + const msg = channel.messages.shift(); + if (msg === undefined) { + return __Maybe_Nothing; + } else { + return __Maybe_Just(msg); + } +}; + +const _Channel_rawRecv = F2((channelId, onMsg) => { + const channel = _Channel_channels.get(channelId); + if (__Basics_isDebug && channel === undefined) { + __Debug_crash( + 12, + __Debug_runtimeCrashReason("channelIdNotRegistered"), + channelId && channelId.a && channelId.a.__$id + ); + } + const msg = channel.messages.shift(); + if (msg !== undefined) { + onMsg(msg); + return (x) => x; + } + const onWake = (msg) => { + return onMsg(msg); + }; + channel.wakers.add(onWake); + return (x) => { + channel.wakers.delete(onWake); + return x; + }; +}); + +const _Channel_rawSendImpl = F2((channelId, msg) => { + const channel = _Channel_channels.get(channelId); + if (__Basics_isDebug && channel === undefined) { + __Debug_crash( + 12, + __Debug_runtimeCrashReason("channelIdNotRegistered"), + channelId && channelId.a && channelId.a.__$id + ); + } + + const wakerIter = channel.wakers[Symbol.iterator](); + const { value: nextWaker, done } = wakerIter.next(); + if (done) { + channel.messages.push(msg); + } else { + channel.wakers.delete(nextWaker); + nextWaker(msg); + } + return __Utils_Tuple0; +}); + +const _Channel_rawSend = F2((sender, msg) => { + sender(msg); +}); diff --git a/src/Elm/Kernel/Char.js b/src/Elm/Kernel/Char.js index 7cc9aa74..2af0be9f 100644 --- a/src/Elm/Kernel/Char.js +++ b/src/Elm/Kernel/Char.js @@ -4,48 +4,37 @@ import Elm.Kernel.Utils exposing (chr) */ - -function _Char_toCode(char) -{ - var code = char.charCodeAt(0); - if (0xD800 <= code && code <= 0xDBFF) - { - return (code - 0xD800) * 0x400 + char.charCodeAt(1) - 0xDC00 + 0x10000 - } - return code; +function _Char_toCode(char) { + const code = char.charCodeAt(0); + if (0xd800 <= code && code <= 0xdbff) { + return (code - 0xd800) * 0x400 + char.charCodeAt(1) - 0xdc00 + 0x10000; + } + return code; } -function _Char_fromCode(code) -{ - return __Utils_chr( - (code < 0 || 0x10FFFF < code) - ? '\uFFFD' - : - (code <= 0xFFFF) - ? String.fromCharCode(code) - : - (code -= 0x10000, - String.fromCharCode(Math.floor(code / 0x400) + 0xD800, code % 0x400 + 0xDC00) - ) - ); +function _Char_fromCode(code) { + return __Utils_chr( + code < 0 || 0x10ffff < code + ? "\uFFFD" + : code <= 0xffff + ? String.fromCharCode(code) + : ((code -= 0x10000), + String.fromCharCode(Math.floor(code / 0x400) + 0xd800, (code % 0x400) + 0xdc00)) + ); } -function _Char_toUpper(char) -{ - return __Utils_chr(char.toUpperCase()); +function _Char_toUpper(char) { + return __Utils_chr(char.toUpperCase()); } -function _Char_toLower(char) -{ - return __Utils_chr(char.toLowerCase()); +function _Char_toLower(char) { + return __Utils_chr(char.toLowerCase()); } -function _Char_toLocaleUpper(char) -{ - return __Utils_chr(char.toLocaleUpperCase()); +function _Char_toLocaleUpper(char) { + return __Utils_chr(char.toLocaleUpperCase()); } -function _Char_toLocaleLower(char) -{ - return __Utils_chr(char.toLocaleLowerCase()); +function _Char_toLocaleLower(char) { + return __Utils_chr(char.toLocaleLowerCase()); } diff --git a/src/Elm/Kernel/Debug.js b/src/Elm/Kernel/Debug.js index 07e3ba96..f5d4a151 100644 --- a/src/Elm/Kernel/Debug.js +++ b/src/Elm/Kernel/Debug.js @@ -3,300 +3,369 @@ import Array exposing (toList) import Dict exposing (toList) import Set exposing (toList) +import Elm.Kernel.List exposing (toArray) */ - // LOG -var _Debug_log__PROD = F2(function(tag, value) -{ - return value; +const _Debug_log__PROD = F2(function (tag, value) { + return value; }); -var _Debug_log__DEBUG = F2(function(tag, value) -{ - console.log(tag + ': ' + _Debug_toString(value)); - return value; +const _Debug_log__DEBUG = F2(function (tag, value) { + console.log(tag + ": " + _Debug_toString(value)); + return value; }); - // TODOS -function _Debug_todo(moduleName, region) -{ - return function(message) { - _Debug_crash(8, moduleName, region, message); - }; +function _Debug_todo(moduleName, region) { + return function (message) { + _Debug_crash(8, moduleName, region, message); + }; } -function _Debug_todoCase(moduleName, region, value) -{ - return function(message) { - _Debug_crash(9, moduleName, region, value, message); - }; +function _Debug_todoCase(moduleName, region, value) { + return function (message) { + _Debug_crash(9, moduleName, region, value, message); + }; } - // TO STRING -function _Debug_toString__PROD(value) -{ - return ''; +function _Debug_toString__PROD(value) { + return ""; } -function _Debug_toString__DEBUG(value) -{ - return _Debug_toAnsiString(false, value); +function _Debug_toString__DEBUG(value) { + return _Debug_toAnsiString(false, value); } -function _Debug_toAnsiString(ansi, value) -{ - if (typeof value === 'function') - { - return _Debug_internalColor(ansi, ''); - } - - if (typeof value === 'boolean') - { - return _Debug_ctorColor(ansi, value ? 'True' : 'False'); - } - - if (typeof value === 'number') - { - return _Debug_numberColor(ansi, value + ''); - } - - if (value instanceof String) - { - return _Debug_charColor(ansi, "'" + _Debug_addSlashes(value, true) + "'"); - } - - if (typeof value === 'string') - { - return _Debug_stringColor(ansi, '"' + _Debug_addSlashes(value, false) + '"'); - } - - if (typeof value === 'object' && '$' in value) - { - var tag = value.$; - - if (typeof tag === 'number') - { - return _Debug_internalColor(ansi, ''); - } - - if (tag[0] === '#') - { - var output = []; - for (var k in value) - { - if (k === '$') continue; - output.push(_Debug_toAnsiString(ansi, value[k])); - } - return '(' + output.join(',') + ')'; - } - - if (tag === 'Set_elm_builtin') - { - return _Debug_ctorColor(ansi, 'Set') - + _Debug_fadeColor(ansi, '.fromList') + ' ' - + _Debug_toAnsiString(ansi, __Set_toList(value)); - } - - if (tag === 'RBNode_elm_builtin' || tag === 'RBEmpty_elm_builtin') - { - return _Debug_ctorColor(ansi, 'Dict') - + _Debug_fadeColor(ansi, '.fromList') + ' ' - + _Debug_toAnsiString(ansi, __Dict_toList(value)); - } - - if (tag === 'Array_elm_builtin') - { - return _Debug_ctorColor(ansi, 'Array') - + _Debug_fadeColor(ansi, '.fromList') + ' ' - + _Debug_toAnsiString(ansi, __Array_toList(value)); - } - - if (tag === '::' || tag === '[]') - { - var output = '['; - - value.b && (output += _Debug_toAnsiString(ansi, value.a), value = value.b) - - for (; value.b; value = value.b) // WHILE_CONS - { - output += ',' + _Debug_toAnsiString(ansi, value.a); - } - return output + ']'; - } - - var output = ''; - for (var i in value) - { - if (i === '$') continue; - var str = _Debug_toAnsiString(ansi, value[i]); - var c0 = str[0]; - var parenless = c0 === '{' || c0 === '(' || c0 === '[' || c0 === '<' || c0 === '"' || str.indexOf(' ') < 0; - output += ' ' + (parenless ? str : '(' + str + ')'); - } - return _Debug_ctorColor(ansi, tag) + output; - } - - if (typeof DataView === 'function' && value instanceof DataView) - { - return _Debug_stringColor(ansi, '<' + value.byteLength + ' bytes>'); - } - - if (typeof File !== 'undefined' && value instanceof File) - { - return _Debug_internalColor(ansi, '<' + value.name + '>'); - } - - if (typeof value === 'object') - { - var output = []; - for (var key in value) - { - var field = key[0] === '_' ? key.slice(1) : key; - output.push(_Debug_fadeColor(ansi, field) + ' = ' + _Debug_toAnsiString(ansi, value[key])); - } - if (output.length === 0) - { - return '{}'; - } - return '{ ' + output.join(', ') + ' }'; - } - - return _Debug_internalColor(ansi, ''); +function _Debug_toAnsiString(ansi, value) { + if (typeof value === "function") { + return _Debug_internalColor(ansi, ""); + } + + if (typeof value === "boolean") { + return _Debug_ctorColor(ansi, value ? "True" : "False"); + } + + if (typeof value === "number") { + return _Debug_numberColor(ansi, value + ""); + } + + if (value instanceof String) { + return _Debug_charColor(ansi, "'" + _Debug_addSlashes(value, true) + "'"); + } + + if (typeof value === "string") { + return _Debug_stringColor(ansi, '"' + _Debug_addSlashes(value, false) + '"'); + } + + if (typeof value === "object" && "$" in value) { + const tag = value.$; + + if (typeof tag === "number") { + return _Debug_internalColor(ansi, ""); + } + + if (tag[0] === "#") { + const output = []; + for (const [k, v] of Object.entries(value)) { + if (k === "$") continue; + output.push(_Debug_toAnsiString(ansi, v)); + } + return "(" + output.join(",") + ")"; + } + + if (tag === "Set_elm_builtin") { + return ( + _Debug_ctorColor(ansi, "Set") + + _Debug_fadeColor(ansi, ".fromList") + + " " + + _Debug_toAnsiString(ansi, __Set_toList(value)) + ); + } + + if (tag === "RBNode_elm_builtin" || tag === "RBEmpty_elm_builtin") { + return ( + _Debug_ctorColor(ansi, "Dict") + + _Debug_fadeColor(ansi, ".fromList") + + " " + + _Debug_toAnsiString(ansi, __Dict_toList(value)) + ); + } + + if (tag === "Array_elm_builtin") { + return ( + _Debug_ctorColor(ansi, "Array") + + _Debug_fadeColor(ansi, ".fromList") + + " " + + _Debug_toAnsiString(ansi, __Array_toList(value)) + ); + } + + if (tag === "Cons_elm_builtin" || tag === "Nil_elm_builtin") { + return ( + "[" + + __List_toArray(value) + .map((v) => _Debug_toAnsiString(ansi, v)) + .join(",") + + "]" + ); + } + + const parts = Object.entries(value).map(([k, v]) => { + if (k === "$") { + return _Debug_ctorColor(ansi, v); + } + const str = _Debug_toAnsiString(ansi, v); + const c0 = str[0]; + const parenless = + c0 === "{" || c0 === "(" || c0 === "[" || c0 === "<" || c0 === '"' || str.indexOf(" ") < 0; + return parenless ? str : "(" + str + ")"; + }); + return parts.join(" "); + } + + if (typeof DataView === "function" && value instanceof DataView) { + return _Debug_stringColor(ansi, "<" + value.byteLength + " bytes>"); + } + + if (typeof File !== "undefined" && value instanceof File) { + return _Debug_internalColor(ansi, "<" + value.name + ">"); + } + + if (typeof value === "object") { + const keyValuePairs = Object.entries(value).map(([k, v]) => { + const field = k[0] === "_" ? k.slice(1) : k; + return _Debug_fadeColor(ansi, field) + " = " + _Debug_toAnsiString(ansi, v); + }); + return "{ " + keyValuePairs.join(", ") + " }"; + } + + return _Debug_internalColor(ansi, ""); } -function _Debug_addSlashes(str, isChar) -{ - var s = str - .replace(/\\/g, '\\\\') - .replace(/\n/g, '\\n') - .replace(/\t/g, '\\t') - .replace(/\r/g, '\\r') - .replace(/\v/g, '\\v') - .replace(/\0/g, '\\0'); - - if (isChar) - { - return s.replace(/\'/g, '\\\''); - } - else - { - return s.replace(/\"/g, '\\"'); - } +function _Debug_addSlashes(str, isChar) { + const s = str + .replace(/\\/g, "\\\\") + .replace(/\n/g, "\\n") + .replace(/\t/g, "\\t") + .replace(/\r/g, "\\r") + .replace(/\v/g, "\\v") + .replace(/\0/g, "\\0"); + + if (isChar) { + return s.replace(/\'/g, "\\'"); + } else { + return s.replace(/\"/g, '\\"'); + } } -function _Debug_ctorColor(ansi, string) -{ - return ansi ? '\x1b[96m' + string + '\x1b[0m' : string; +function _Debug_ctorColor(ansi, string) { + return ansi ? "\x1b[96m" + string + "\x1b[0m" : string; } -function _Debug_numberColor(ansi, string) -{ - return ansi ? '\x1b[95m' + string + '\x1b[0m' : string; +function _Debug_numberColor(ansi, string) { + return ansi ? "\x1b[95m" + string + "\x1b[0m" : string; } -function _Debug_stringColor(ansi, string) -{ - return ansi ? '\x1b[93m' + string + '\x1b[0m' : string; +function _Debug_stringColor(ansi, string) { + return ansi ? "\x1b[93m" + string + "\x1b[0m" : string; } -function _Debug_charColor(ansi, string) -{ - return ansi ? '\x1b[92m' + string + '\x1b[0m' : string; +function _Debug_charColor(ansi, string) { + return ansi ? "\x1b[92m" + string + "\x1b[0m" : string; } -function _Debug_fadeColor(ansi, string) -{ - return ansi ? '\x1b[37m' + string + '\x1b[0m' : string; +function _Debug_fadeColor(ansi, string) { + return ansi ? "\x1b[37m" + string + "\x1b[0m" : string; } -function _Debug_internalColor(ansi, string) -{ - return ansi ? '\x1b[36m' + string + '\x1b[0m' : string; +function _Debug_internalColor(ansi, string) { + return ansi ? "\x1b[36m" + string + "\x1b[0m" : string; } -function _Debug_toHexDigit(n) -{ - return String.fromCharCode(n < 10 ? 48 + n : 55 + n); +function _Debug_toHexDigit(n) { + return String.fromCharCode(n < 10 ? 48 + n : 55 + n); } - // CRASH - -function _Debug_crash__PROD(identifier) -{ - throw new Error('https://github.com/elm/core/blob/1.0.0/hints/' + identifier + '.md'); +function _Debug_runtimeCrashReason__PROD(reason) {} + +function _Debug_runtimeCrashReason__DEBUG(reason) { + switch (reason) { + case "subMap": + return function (fact2, fact3, fact4) { + throw new Error( + "Bug in elm runtime: attempting to subMap an effect from a command only effect module." + ); + }; + + case "cmdMap": + return function (fact2, fact3, fact4) { + throw new Error( + "Bug in elm runtime: attempting to cmdMap an effect from a subscription only effect module." + ); + }; + + case "procIdAlreadyRegistered": + return function (fact2, fact3, fact4) { + throw new Error(`Bug in elm runtime: state for process ${fact2} is already registered!`); + }; + + case "procIdNotRegistered": + return function (fact2, fact3, fact4) { + throw new Error(`Bug in elm runtime: state for process ${fact2} been has not registered!`); + }; + + case "cannotBeStepped": + return function (fact2, fact3, fact4) { + throw new Error( + `Bug in elm runtime: attempting to step process with id ${fact2} whilst it is processing an async action!` + ); + }; + + case "procIdAlreadyReady": + return function (fact2, fact3, fact4) { + throw new Error( + `Bug in elm runtime: process ${fact2} already has a ready flag set (with value ${fact3}). Refusing to reset the value before it is cleared` + ); + }; + + case "subscriptionProcessMissing": + return function (fact2, fact3, fact4) { + throw new Error( + `Bug in elm runtime: expected there to be a subscriptionProcess with id ${fact2}.` + ); + }; + + case "failedUnwrap": + return function (fact2, fact3, fact4) { + throw new Error( + `Bug in elm runtime: trying to unwrap an new type but the js object had the following keys: ${Object.keys( + fact2 + ).join(", ")}` + ); + }; + + case "EffectModule": + return function (fact2, fact3, fact4) { + throw new Error( + `Effect modules are not supported, if you are using elm/* libraries you will need to switch to a custom version.` + ); + }; + + case "PlatformLeaf": + return function (home, fact3, fact4) { + throw new Error( + `Trying to create a command or a subscription for event manager ${home}. +Effect modules are not supported, if you are using elm/* libraries you will need to switch to a custom version.` + ); + }; + } + throw new Error(`Unknown reason for runtime crash: ${fact1}!`); } +function _Debug_crash__PROD(identifier) { + throw new Error("https://github.com/elm/core/blob/1.0.0/hints/" + identifier + ".md"); +} -function _Debug_crash__DEBUG(identifier, fact1, fact2, fact3, fact4) -{ - switch(identifier) - { - case 0: - throw new Error('What node should I take over? In JavaScript I need something like:\n\n Elm.Main.init({\n node: document.getElementById("elm-node")\n })\n\nYou need to do this with any Browser.sandbox or Browser.element program.'); - - case 1: - throw new Error('Browser.application programs cannot handle URLs like this:\n\n ' + document.location.href + '\n\nWhat is the root? The root of your file system? Try looking at this program with `elm reactor` or some other server.'); - - case 2: - var jsonErrorString = fact1; - throw new Error('Problem with the flags given to your Elm program on initialization.\n\n' + jsonErrorString); - - case 3: - var portName = fact1; - throw new Error('There can only be one port named `' + portName + '`, but your program has multiple.'); - - case 4: - var portName = fact1; - var problem = fact2; - throw new Error('Trying to send an unexpected type of value through port `' + portName + '`:\n' + problem); - - case 5: - throw new Error('Trying to use `(==)` on functions.\nThere is no way to know if functions are "the same" in the Elm sense.\nRead more about this at https://package.elm-lang.org/packages/elm/core/latest/Basics#== which describes why it is this way and what the better version will look like.'); - - case 6: - var moduleName = fact1; - throw new Error('Your page is loading multiple Elm scripts with a module named ' + moduleName + '. Maybe a duplicate script is getting loaded accidentally? If not, rename one of them so I know which is which!'); - - case 8: - var moduleName = fact1; - var region = fact2; - var message = fact3; - throw new Error('TODO in module `' + moduleName + '` ' + _Debug_regionToString(region) + '\n\n' + message); - - case 9: - var moduleName = fact1; - var region = fact2; - var value = fact3; - var message = fact4; - throw new Error( - 'TODO in module `' + moduleName + '` from the `case` expression ' - + _Debug_regionToString(region) + '\n\nIt received the following value:\n\n ' - + _Debug_toString(value).replace('\n', '\n ') - + '\n\nBut the branch that handles it says:\n\n ' + message.replace('\n', '\n ') - ); - - case 10: - throw new Error('Bug in https://github.com/elm/virtual-dom/issues'); - - case 11: - throw new Error('Cannot perform mod 0. Division by zero error.'); - } +function _Debug_crash__DEBUG(identifier, fact1, fact2, fact3, fact4) { + switch (identifier) { + case 0: + throw new Error( + 'What node should I take over? In JavaScript I need something like:\n\n Elm.Main.init({\n node: document.getElementById("elm-node")\n })\n\nYou need to do this with any Browser.sandbox or Browser.element program.' + ); + + case 1: + throw new Error( + "Browser.application programs cannot handle URLs like this:\n\n " + + document.location.href + + "\n\nWhat is the root? The root of your file system? Try looking at this program with `elm reactor` or some other server." + ); + + case 2: { + const jsonErrorString = fact1; + throw new Error( + "Problem with the flags given to your Elm program on initialization.\n\n" + jsonErrorString + ); + } + + case 3: { + const portName = fact1; + throw new Error( + "There can only be one port named `" + portName + "`, but your program has multiple." + ); + } + + case 4: { + const portName = fact1; + const problem = fact2; + throw new Error( + "Trying to send an unexpected type of value through port `" + portName + "`:\n" + problem + ); + } + + case 5: + throw new Error( + 'Trying to use `(==)` on functions.\nThere is no way to know if functions are "the same" in the Elm sense.\nRead more about this at https://package.elm-lang.org/packages/elm/core/latest/Basics#== which describes why it is this way and what the better version will look like.' + ); + + case 6: { + const moduleName = fact1; + throw new Error( + "Your page is loading multiple Elm scripts with a module named " + + moduleName + + ". Maybe a duplicate script is getting loaded accidentally? If not, rename one of them so I know which is which!" + ); + } + + case 8: { + const moduleName = fact1; + const region = fact2; + const message = fact3; + throw new Error( + "TODO in module `" + moduleName + "` " + _Debug_regionToString(region) + "\n\n" + message + ); + } + + case 9: { + const moduleName = fact1; + const region = fact2; + const value = fact3; + const message = fact4; + throw new Error( + "TODO in module `" + + moduleName + + "` from the `case` expression " + + _Debug_regionToString(region) + + "\n\nIt received the following value:\n\n " + + _Debug_toString(value).replace("\n", "\n ") + + "\n\nBut the branch that handles it says:\n\n " + + message.replace("\n", "\n ") + ); + } + + case 10: + throw new Error("Bug in https://github.com/elm/virtual-dom/issues"); + + case 11: + throw new Error("Cannot perform mod 0. Division by zero error."); + + case 12: { + fact1(fact2, fact3, fact4); + throw new Error(`Unknown bug in elm runtime tag: ${fact1}!`); + } + } } -function _Debug_regionToString(region) -{ - if (region.__$start.__$line === region.__$end.__$line) - { - return 'on line ' + region.__$start.__$line; - } - return 'on lines ' + region.__$start.__$line + ' through ' + region.__$end.__$line; +function _Debug_regionToString(region) { + if (region.__$start.__$line === region.__$end.__$line) { + return "on line " + region.__$start.__$line; + } + return "on lines " + region.__$start.__$line + " through " + region.__$end.__$line; } diff --git a/src/Elm/Kernel/JsArray.js b/src/Elm/Kernel/JsArray.js index deeafc32..61f06b26 100644 --- a/src/Elm/Kernel/JsArray.js +++ b/src/Elm/Kernel/JsArray.js @@ -4,153 +4,128 @@ import Elm.Kernel.Utils exposing (Tuple2) */ - var _JsArray_empty = []; -function _JsArray_singleton(value) -{ - return [value]; +function _JsArray_singleton(value) { + return [value]; } -function _JsArray_length(array) -{ - return array.length; +function _JsArray_length(array) { + return array.length; } -var _JsArray_initialize = F3(function(size, offset, func) -{ - var result = new Array(size); +var _JsArray_initialize = F3(function (size, offset, func) { + var result = new Array(size); - for (var i = 0; i < size; i++) - { - result[i] = func(offset + i); - } + for (var i = 0; i < size; i++) { + result[i] = func(offset + i); + } - return result; + return result; }); -var _JsArray_initializeFromList = F2(function (max, ls) -{ - var result = new Array(max); +var _JsArray_initializeFromList = F2(function (max, ls) { + var result = new Array(max); - for (var i = 0; i < max && ls.b; i++) - { - result[i] = ls.a; - ls = ls.b; - } + for (var i = 0; i < max && ls.b; i++) { + result[i] = ls.a; + ls = ls.b; + } - result.length = i; - return __Utils_Tuple2(result, ls); + result.length = i; + return __Utils_Tuple2(result, ls); }); -var _JsArray_unsafeGet = F2(function(index, array) -{ - return array[index]; +var _JsArray_unsafeGet = F2(function (index, array) { + return array[index]; }); -var _JsArray_unsafeSet = F3(function(index, value, array) -{ - var length = array.length; - var result = new Array(length); +var _JsArray_unsafeSet = F3(function (index, value, array) { + var length = array.length; + var result = new Array(length); - for (var i = 0; i < length; i++) - { - result[i] = array[i]; - } + for (var i = 0; i < length; i++) { + result[i] = array[i]; + } - result[index] = value; - return result; + result[index] = value; + return result; }); -var _JsArray_push = F2(function(value, array) -{ - var length = array.length; - var result = new Array(length + 1); +var _JsArray_push = F2(function (value, array) { + var length = array.length; + var result = new Array(length + 1); - for (var i = 0; i < length; i++) - { - result[i] = array[i]; - } + for (var i = 0; i < length; i++) { + result[i] = array[i]; + } - result[length] = value; - return result; + result[length] = value; + return result; }); -var _JsArray_foldl = F3(function(func, acc, array) -{ - var length = array.length; +var _JsArray_foldl = F3(function (func, acc, array) { + var length = array.length; - for (var i = 0; i < length; i++) - { - acc = A2(func, array[i], acc); - } + for (var i = 0; i < length; i++) { + acc = A2(func, array[i], acc); + } - return acc; + return acc; }); -var _JsArray_foldr = F3(function(func, acc, array) -{ - for (var i = array.length - 1; i >= 0; i--) - { - acc = A2(func, array[i], acc); - } +var _JsArray_foldr = F3(function (func, acc, array) { + for (var i = array.length - 1; i >= 0; i--) { + acc = A2(func, array[i], acc); + } - return acc; + return acc; }); -var _JsArray_map = F2(function(func, array) -{ - var length = array.length; - var result = new Array(length); +var _JsArray_map = F2(function (func, array) { + var length = array.length; + var result = new Array(length); - for (var i = 0; i < length; i++) - { - result[i] = func(array[i]); - } + for (var i = 0; i < length; i++) { + result[i] = func(array[i]); + } - return result; + return result; }); -var _JsArray_indexedMap = F3(function(func, offset, array) -{ - var length = array.length; - var result = new Array(length); +var _JsArray_indexedMap = F3(function (func, offset, array) { + var length = array.length; + var result = new Array(length); - for (var i = 0; i < length; i++) - { - result[i] = A2(func, offset + i, array[i]); - } + for (var i = 0; i < length; i++) { + result[i] = A2(func, offset + i, array[i]); + } - return result; + return result; }); -var _JsArray_slice = F3(function(from, to, array) -{ - return array.slice(from, to); +var _JsArray_slice = F3(function (from, to, array) { + return array.slice(from, to); }); -var _JsArray_appendN = F3(function(n, dest, source) -{ - var destLen = dest.length; - var itemsToCopy = n - destLen; +var _JsArray_appendN = F3(function (n, dest, source) { + var destLen = dest.length; + var itemsToCopy = n - destLen; - if (itemsToCopy > source.length) - { - itemsToCopy = source.length; - } + if (itemsToCopy > source.length) { + itemsToCopy = source.length; + } - var size = destLen + itemsToCopy; - var result = new Array(size); + var size = destLen + itemsToCopy; + var result = new Array(size); - for (var i = 0; i < destLen; i++) - { - result[i] = dest[i]; - } + for (var i = 0; i < destLen; i++) { + result[i] = dest[i]; + } - for (var i = 0; i < itemsToCopy; i++) - { - result[i + destLen] = source[i]; - } + for (var i = 0; i < itemsToCopy; i++) { + result[i + destLen] = source[i]; + } - return result; + return result; }); diff --git a/src/Elm/Kernel/List.js b/src/Elm/Kernel/List.js index 2441718b..fad002f6 100644 --- a/src/Elm/Kernel/List.js +++ b/src/Elm/Kernel/List.js @@ -1,86 +1,47 @@ /* -import Elm.Kernel.Utils exposing (cmp) import Basics exposing (EQ, LT) +import List exposing (Nil_elm_builtin, Cons_elm_builtin) */ - -var _List_Nil__PROD = { $: 0 }; -var _List_Nil__DEBUG = { $: '[]' }; - -function _List_Cons__PROD(hd, tl) { return { $: 1, a: hd, b: tl }; } -function _List_Cons__DEBUG(hd, tl) { return { $: '::', a: hd, b: tl }; } - - -var _List_cons = F2(_List_Cons); - -function _List_fromArray(arr) -{ - var out = _List_Nil; - for (var i = arr.length; i--; ) - { - out = _List_Cons(arr[i], out); - } - return out; -} - -function _List_toArray(xs) -{ - for (var out = []; xs.b; xs = xs.b) // WHILE_CONS - { - out.push(xs.a); - } - return out; -} - -var _List_map2 = F3(function(f, xs, ys) -{ - for (var arr = []; xs.b && ys.b; xs = xs.b, ys = ys.b) // WHILE_CONSES - { - arr.push(A2(f, xs.a, ys.a)); - } - return _List_fromArray(arr); -}); - -var _List_map3 = F4(function(f, xs, ys, zs) -{ - for (var arr = []; xs.b && ys.b && zs.b; xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES - { - arr.push(A3(f, xs.a, ys.a, zs.a)); - } - return _List_fromArray(arr); -}); - -var _List_map4 = F5(function(f, ws, xs, ys, zs) -{ - for (var arr = []; ws.b && xs.b && ys.b && zs.b; ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES - { - arr.push(A4(f, ws.a, xs.a, ys.a, zs.a)); - } - return _List_fromArray(arr); -}); - -var _List_map5 = F6(function(f, vs, ws, xs, ys, zs) -{ - for (var arr = []; vs.b && ws.b && xs.b && ys.b && zs.b; vs = vs.b, ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES - { - arr.push(A5(f, vs.a, ws.a, xs.a, ys.a, zs.a)); - } - return _List_fromArray(arr); -}); - -var _List_sortBy = F2(function(f, xs) -{ - return _List_fromArray(_List_toArray(xs).sort(function(a, b) { - return __Utils_cmp(f(a), f(b)); - })); -}); - -var _List_sortWith = F2(function(f, xs) -{ - return _List_fromArray(_List_toArray(xs).sort(function(a, b) { - var ord = A2(f, a, b); - return ord === __Basics_EQ ? 0 : ord === __Basics_LT ? -1 : 1; - })); -}); +/* Ideally we would write + * + * ``` + * const \_List_Nil = \_\_List_Nil; + * ``` + * + * to forward this call `elm/core:List.Nil_elm_builtin` however the elm + * compiler puts the javascript for `elm/core:List.Nil_elm_builtin` after the + * javascript below in the elm.js file and so with the above definition we get + * "XXX is undefined" errors. + * + */ +const _List_nilKey__PROD = 0; +const _List_nilKey__DEBUG = "Nil_elm_builtin"; +const _List_Nil = { $: _List_nilKey }; + +const _List_Cons = (hd, tl) => A2(__List_Cons_elm_builtin, hd, tl); + +const _List_fromArray = (arr) => + arr.reduceRight((out, val) => A2(__List_Cons_elm_builtin, val, out), __List_Nil_elm_builtin); + +const _List_toArray = (xs) => { + const out = []; + while (true) { + if (xs.$ === _List_nilKey) { + return out; + } + out.push(xs.a); + xs = xs.b; + } +}; + +const _List_sortWith = F2((f, xs) => + _List_fromArray( + _List_toArray(xs).sort((a, b) => { + const ord = A2(f, a, b); + return ord === __Basics_EQ ? 0 : ord === __Basics_LT ? -1 : 1; + }) + ) +); diff --git a/src/Elm/Kernel/Platform.js b/src/Elm/Kernel/Platform.js index d28ab33f..267dc8af 100644 --- a/src/Elm/Kernel/Platform.js +++ b/src/Elm/Kernel/Platform.js @@ -1,60 +1,113 @@ /* -import Elm.Kernel.Debug exposing (crash) +import Elm.Kernel.Debug exposing (crash, runtimeCrashReason) import Elm.Kernel.Json exposing (run, wrap, unwrap, errorToString) -import Elm.Kernel.List exposing (Cons, Nil) -import Elm.Kernel.Process exposing (sleep) -import Elm.Kernel.Scheduler exposing (andThen, binding, rawSend, rawSpawn, receive, send, succeed) -import Elm.Kernel.Utils exposing (Tuple0) +import Elm.Kernel.List exposing (Cons, Nil, toArray) +import Elm.Kernel.Utils exposing (Tuple0, Tuple2) +import Elm.Kernel.Channel exposing (rawUnbounded, rawSend) +import Elm.Kernel.Basics exposing (isDebug) import Result exposing (isOk) +import Maybe exposing (Nothing) +import Platform exposing (Task, ProcessId, initializeHelperFunctions) +import Platform.Raw.Scheduler as RawScheduler exposing (rawSpawn) +import Platform.Raw.Task as RawTask exposing (execImpure, andThen) +import Platform.Raw.Channel as RawChannel exposing (recv) +import Platform.Scheduler as Scheduler exposing (execImpure) */ +// State +var _Platform_outgoingPorts = new Map(); +var _Platform_incomingPorts = new Map(); -// PROGRAMS - - -var _Platform_worker = F4(function(impl, flagDecoder, debugMetadata, args) -{ - return _Platform_initialize( - flagDecoder, - args, - impl.__$init, - impl.__$update, - impl.__$subscriptions, - function() { return function() {} } - ); -}); - +var _Platform_effectsQueue = []; +var _Platform_effectDispatchInProgress = false; +let _Platform_runAfterLoadQueue = []; +const _Platform_runAfterLoad = (f) => { + if (_Platform_runAfterLoadQueue == null) { + f(); + } else { + _Platform_runAfterLoadQueue.push(f); + } +}; // INITIALIZE A PROGRAM - -function _Platform_initialize(flagDecoder, args, init, update, subscriptions, stepperBuilder) -{ - var result = A2(__Json_run, flagDecoder, __Json_wrap(args ? args['flags'] : undefined)); - __Result_isOk(result) || __Debug_crash(2 /**__DEBUG/, __Json_errorToString(result.a) /**/); - var managers = {}; - result = init(result.a); - var model = result.a; - var stepper = stepperBuilder(sendToApp, model); - var ports = _Platform_setupEffects(managers, sendToApp); - - function sendToApp(msg, viewMetadata) - { - result = A2(update, msg, model); - stepper(model = result.a, viewMetadata); - _Platform_enqueueEffects(managers, result.b, subscriptions(model)); - } - - _Platform_enqueueEffects(managers, result.b, subscriptions(model)); - - return ports ? { ports: ports } : {}; -} - - +const _Platform_initialize = F3((flagDecoder, args, impl) => { + // Elm.Kernel.Json.wrap : RawJsObject -> Json.Decode.Value + // Elm.Kernel.Json.run : Json.Decode.Decoder a -> Json.Decode.Value -> Result Json.Decode.Error a + const flagsResult = A2(__Json_run, flagDecoder, __Json_wrap(args ? args["flags"] : undefined)); + + if (!__Result_isOk(flagsResult)) { + if (__Basics_isDebug) { + __Debug_crash(2, __Json_errorToString(result.a)); + } else { + __Debug_crash(2); + } + } + + let cmdSender; + const ports = {}; + + const dispatch = (model, cmds) => { + _Platform_effectsQueue.push({ + __cmds: cmds, + __subs: impl.__$subscriptions(model), + }); + + if (_Platform_effectDispatchInProgress) { + return; + } + + _Platform_effectDispatchInProgress = true; + while (true) { + const fx = _Platform_effectsQueue.shift(); + if (fx === undefined) { + _Platform_effectDispatchInProgress = false; + return; + } + const tuple = A3( + __Platform_initializeHelperFunctions.__$dispatchEffects, + fx.__cmds, + fx.__subs, + cmdSender + ); + tuple.a(sendToApp); + __RawScheduler_rawSpawn(tuple.b); + } + }; + + const sendToApp = F2((msg, viewMetadata) => { + const updateValue = A2(impl.__$update, msg, model); + model = updateValue.a; + A2(stepper, model, viewMetadata); + dispatch(model, updateValue.b); + }); + + for (const f of _Platform_runAfterLoadQueue) { + f(); + } + _Platform_runAfterLoadQueue = null; + + cmdSender = __Platform_initializeHelperFunctions.__$setupEffectsChannel(sendToApp); + + for (const [key, { port }] of _Platform_outgoingPorts.entries()) { + ports[key] = port; + } + for (const [key, { port }] of _Platform_incomingPorts.entries()) { + ports[key] = port; + } + + const initValue = impl.__$init(flagsResult.a); + let model = initValue.a; + const stepper = A2(__Platform_initializeHelperFunctions.__$stepperBuilder, sendToApp, model); + + dispatch(model, initValue.b); + + return ports ? { ports } : {}; +}); // TRACK PRELOADS // @@ -62,415 +115,178 @@ function _Platform_initialize(flagDecoder, args, init, update, subscriptions, st // to register any HTTP requests that are triggered by init. // - var _Platform_preload; - -function _Platform_registerPreload(url) -{ - _Platform_preload.add(url); +function _Platform_registerPreload(url) { + _Platform_preload.add(url); } - - // EFFECT MANAGERS - -var _Platform_effectManagers = {}; - - -function _Platform_setupEffects(managers, sendToApp) -{ - var ports; - - // setup all necessary effect managers - for (var key in _Platform_effectManagers) - { - var manager = _Platform_effectManagers[key]; - - if (manager.__portSetup) - { - ports = ports || {}; - ports[key] = manager.__portSetup(key, sendToApp); - } - - managers[key] = _Platform_instantiateManager(manager, sendToApp); - } - - return ports; -} - - -function _Platform_createManager(init, onEffects, onSelfMsg, cmdMap, subMap) -{ - return { - __init: init, - __onEffects: onEffects, - __onSelfMsg: onSelfMsg, - __cmdMap: cmdMap, - __subMap: subMap - }; -} - - -function _Platform_instantiateManager(info, sendToApp) -{ - var router = { - __sendToApp: sendToApp, - __selfProcess: undefined - }; - - var onEffects = info.__onEffects; - var onSelfMsg = info.__onSelfMsg; - var cmdMap = info.__cmdMap; - var subMap = info.__subMap; - - function loop(state) - { - return A2(__Scheduler_andThen, loop, __Scheduler_receive(function(msg) - { - var value = msg.a; - - if (msg.$ === __2_SELF) - { - return A3(onSelfMsg, router, value, state); - } - - return cmdMap && subMap - ? A4(onEffects, router, value.__cmds, value.__subs, state) - : A3(onEffects, router, cmdMap ? value.__cmds : value.__subs, state); - })); - } - - return router.__selfProcess = __Scheduler_rawSpawn(A2(__Scheduler_andThen, loop, info.__init)); +function _Platform_createManager(init, onEffects, onSelfMsg, cmdMap, subMap) { + __Debug_crash(12, __Debug_runtimeCrashReason("EffectModule")); } - - -// ROUTING - - -var _Platform_sendToApp = F2(function(router, msg) -{ - return __Scheduler_binding(function(callback) - { - router.__sendToApp(msg); - callback(__Scheduler_succeed(__Utils_Tuple0)); - }); -}); - - -var _Platform_sendToSelf = F2(function(router, msg) -{ - return A2(__Scheduler_send, router.__selfProcess, { - $: __2_SELF, - a: msg - }); -}); - - - // BAGS - -function _Platform_leaf(home) -{ - return function(value) - { - return { - $: __2_LEAF, - __home: home, - __value: value - }; - }; -} - - -function _Platform_batch(list) -{ - return { - $: __2_NODE, - __bags: list - }; -} - - -var _Platform_map = F2(function(tagger, bag) -{ - return { - $: __2_MAP, - __func: tagger, - __bag: bag - } -}); - - - -// PIPE BAGS INTO EFFECT MANAGERS -// -// Effects must be queued! -// -// Say your init contains a synchronous command, like Time.now or Time.here -// -// - This will produce a batch of effects (FX_1) -// - The synchronous task triggers the subsequent `update` call -// - This will produce a batch of effects (FX_2) -// -// If we just start dispatching FX_2, subscriptions from FX_2 can be processed -// before subscriptions from FX_1. No good! Earlier versions of this code had -// this problem, leading to these reports: -// -// https://github.com/elm/core/issues/980 -// https://github.com/elm/core/pull/981 -// https://github.com/elm/compiler/issues/1776 -// -// The queue is necessary to avoid ordering issues for synchronous commands. - - -// Why use true/false here? Why not just check the length of the queue? -// The goal is to detect "are we currently dispatching effects?" If we -// are, we need to bail and let the ongoing while loop handle things. -// -// Now say the queue has 1 element. When we dequeue the final element, -// the queue will be empty, but we are still actively dispatching effects. -// So you could get queue jumping in a really tricky category of cases. -// -var _Platform_effectsQueue = []; -var _Platform_effectsActive = false; - - -function _Platform_enqueueEffects(managers, cmdBag, subBag) -{ - _Platform_effectsQueue.push({ __managers: managers, __cmdBag: cmdBag, __subBag: subBag }); - - if (_Platform_effectsActive) return; - - _Platform_effectsActive = true; - for (var fx; fx = _Platform_effectsQueue.shift(); ) - { - _Platform_dispatchEffects(fx.__managers, fx.__cmdBag, fx.__subBag); - } - _Platform_effectsActive = false; -} - - -function _Platform_dispatchEffects(managers, cmdBag, subBag) -{ - var effectsDict = {}; - _Platform_gatherEffects(true, cmdBag, effectsDict, null); - _Platform_gatherEffects(false, subBag, effectsDict, null); - - for (var home in managers) - { - __Scheduler_rawSend(managers[home], { - $: 'fx', - a: effectsDict[home] || { __cmds: __List_Nil, __subs: __List_Nil } - }); - } -} - - -function _Platform_gatherEffects(isCmd, bag, effectsDict, taggers) -{ - switch (bag.$) - { - case __2_LEAF: - var home = bag.__home; - var effect = _Platform_toEffect(isCmd, home, taggers, bag.__value); - effectsDict[home] = _Platform_insert(isCmd, effect, effectsDict[home]); - return; - - case __2_NODE: - for (var list = bag.__bags; list.b; list = list.b) // WHILE_CONS - { - _Platform_gatherEffects(isCmd, list.a, effectsDict, taggers); - } - return; - - case __2_MAP: - _Platform_gatherEffects(isCmd, bag.__bag, effectsDict, { - __tagger: bag.__func, - __rest: taggers - }); - return; - } -} - - -function _Platform_toEffect(isCmd, home, taggers, value) -{ - function applyTaggers(x) - { - for (var temp = taggers; temp; temp = temp.__rest) - { - x = temp.__tagger(x); - } - return x; - } - - var map = isCmd - ? _Platform_effectManagers[home].__cmdMap - : _Platform_effectManagers[home].__subMap; - - return A2(map, applyTaggers, value) -} - - -function _Platform_insert(isCmd, newEffect, effects) -{ - effects = effects || { __cmds: __List_Nil, __subs: __List_Nil }; - - isCmd - ? (effects.__cmds = __List_Cons(newEffect, effects.__cmds)) - : (effects.__subs = __List_Cons(newEffect, effects.__subs)); - - return effects; -} - - +/* Called by compiler generated js for event managers for the + * `command` or `subscription` function within an event manager + */ +const _Platform_leaf = (home) => (value) => { + __Debug_crash(12, __Debug_runtimeCrashReason("PlatformLeaf", home)); +}; // PORTS - -function _Platform_checkPortName(name) -{ - if (_Platform_effectManagers[name]) - { - __Debug_crash(3, name) - } -} - - - -// OUTGOING PORTS - - -function _Platform_outgoingPort(name, converter) -{ - _Platform_checkPortName(name); - _Platform_effectManagers[name] = { - __cmdMap: _Platform_outgoingPortMap, - __converter: converter, - __portSetup: _Platform_setupOutgoingPort - }; - return _Platform_leaf(name); +function _Platform_checkPortName(name) { + if (_Platform_outgoingPorts.has(name) || _Platform_incomingPorts.has(name)) { + __Debug_crash(3, name); + } } - -var _Platform_outgoingPortMap = F2(function(tagger, value) { return value; }); - - -function _Platform_setupOutgoingPort(name) -{ - var subs = []; - var converter = _Platform_effectManagers[name].__converter; - - // CREATE MANAGER - - var init = __Process_sleep(0); - - _Platform_effectManagers[name].__init = init; - _Platform_effectManagers[name].__onEffects = F3(function(router, cmdList, state) - { - for ( ; cmdList.b; cmdList = cmdList.b) // WHILE_CONS - { - // grab a separate reference to subs in case unsubscribe is called - var currentSubs = subs; - var value = __Json_unwrap(converter(cmdList.a)); - for (var i = 0; i < currentSubs.length; i++) - { - currentSubs[i](value); - } - } - return init; - }); - - // PUBLIC API - - function subscribe(callback) - { - subs.push(callback); - } - - function unsubscribe(callback) - { - // copy subs into a new array in case unsubscribe is called within a - // subscribed callback - subs = subs.slice(); - var index = subs.indexOf(callback); - if (index >= 0) - { - subs.splice(index, 1); - } - } - - return { - subscribe: subscribe, - unsubscribe: unsubscribe - }; -} - - - -// INCOMING PORTS - - -function _Platform_incomingPort(name, converter) -{ - _Platform_checkPortName(name); - _Platform_effectManagers[name] = { - __subMap: _Platform_incomingPortMap, - __converter: converter, - __portSetup: _Platform_setupIncomingPort - }; - return _Platform_leaf(name); +function _Platform_outgoingPort(name, converter) { + _Platform_checkPortName(name); + let subs = []; + const subscribe = (callback) => { + subs.push(callback); + }; + const unsubscribe = (callback) => { + // copy subs into a new array in case unsubscribe is called within + // a subscribed callback + subs = subs.slice(); + var index = subs.indexOf(callback); + if (index >= 0) { + subs.splice(index, 1); + } + }; + const execSubscribers = (payload) => { + const value = __Json_unwrap(converter(payload)); + for (const sub of subs) { + sub(value); + } + return __Utils_Tuple0; + }; + _Platform_outgoingPorts.set(name, { + port: { + subscribe, + unsubscribe, + }, + }); + + return (payload) => + _Platform_command( + __Scheduler_execImpure((_) => { + execSubscribers(payload); + return __Maybe_Nothing; + }) + ); } +function _Platform_incomingPort(name, converter) { + _Platform_checkPortName(name); -var _Platform_incomingPortMap = F2(function(tagger, finalTagger) -{ - return function(value) - { - return tagger(finalTagger(value)); - }; -}); - - -function _Platform_setupIncomingPort(name, sendToApp) -{ - var subs = __List_Nil; - var converter = _Platform_effectManagers[name].__converter; - - // CREATE MANAGER + const tuple = _Platform_createSubProcess((_) => __Utils_Tuple0); + const key = tuple.a; + const sender = tuple.b; - var init = __Scheduler_succeed(null); + function send(incomingValue) { + var result = A2(__Json_run, converter, __Json_wrap(incomingValue)); - _Platform_effectManagers[name].__init = init; - _Platform_effectManagers[name].__onEffects = F3(function(router, subList, state) - { - subs = subList; - return init; - }); + __Result_isOk(result) || __Debug_crash(4, name, result.a); - // PUBLIC API + var value = result.a; + A2(__Channel_rawSend, sender, value); + } - function send(incomingValue) - { - var result = A2(__Json_run, converter, __Json_wrap(incomingValue)); + _Platform_incomingPorts.set(name, { + port: { + send, + }, + }); - __Result_isOk(result) || __Debug_crash(4, name, result.a); - - var value = result.a; - for (var temp = subs; temp.b; temp = temp.b) // WHILE_CONS - { - sendToApp(temp.a(value)); - } - } - - return { send: send }; + return _Platform_subscription(key); } - +// Functions exported to elm + +const _Platform_subscriptionStates = new Map(); +let _Platform_subscriptionProcessIds = 0; + +const _Platform_createSubProcess = (onSubUpdate) => { + const channel = __Channel_rawUnbounded(); + const key = { id: _Platform_subscriptionProcessIds++ }; + const msgHandler = (hcst) => + __RawTask_execImpure((_) => { + const subscriptionState = _Platform_subscriptionStates.get(key); + if (__Basics_isDebug && subscriptionState === undefined) { + __Debug_crash(12, __Debug_runtimeCrashReason("subscriptionProcessMissing"), key && key.id); + } + for (const sendToApp of subscriptionState.__$listeners) { + sendToApp(hcst); + } + return __Utils_Tuple0; + }); + + const onSubEffects = (_) => + A2(__RawTask_andThen, onSubEffects, A2(__RawChannel_recv, msgHandler, channel.b)); + + _Platform_subscriptionStates.set(key, { + __$listeners: [], + __$onSubUpdate: onSubUpdate, + }); + _Platform_runAfterLoad(() => __RawScheduler_rawSpawn(onSubEffects(__Utils_Tuple0))); + + return __Utils_Tuple2(key, channel.a); +}; + +const _Platform_resetSubscriptions = (newSubs) => { + for (const subState of _Platform_subscriptionStates.values()) { + subState.__$listeners.length = 0; + } + for (const tuple of __List_toArray(newSubs)) { + const key = tuple.a; + const sendToApp = tuple.b; + const subState = _Platform_subscriptionStates.get(key); + if (__Basics_isDebug && subState.__$listeners === undefined) { + __Debug_crash(12, __Debug_runtimeCrashReason("subscriptionProcessMissing"), key && key.id); + } + subState.__$listeners.push(sendToApp); + } + for (const subState of _Platform_subscriptionStates.values()) { + subState.__$onSubUpdate(subState.__$listeners.length); + } + return __Utils_Tuple0; +}; + +const _Platform_effectManagerNameToString = (name) => name; + +const _Platform_wrapTask = (task) => __Platform_Task(task); + +const _Platform_wrapProcessId = (processId) => __Platform_ProcessId(processId); + +// command : Platform.Task Never (Maybe msg) -> Cmd msg +const _Platform_command = (task) => { + const cmdData = __List_Cons(task, __List_Nil); + if (__Basics_isDebug) { + return { + $: "Cmd", + a: cmdData, + }; + } + return cmdData; +}; + +// subscription : RawSub.Id -> (RawSub.HiddenConvertedSubType -> msg) -> Sub msg +const _Platform_subscription = (id) => (tagger) => { + const subData = __List_Cons(__Utils_Tuple2(id, tagger), __List_Nil); + if (__Basics_isDebug) { + return { + $: "Sub", + a: subData, + }; + } + return subData; +}; // EXPORT ELM MODULES // @@ -478,44 +294,32 @@ function _Platform_setupIncomingPort(name, sendToApp) // debug mode and (2) not pay for the bits needed for that in prod mode. // - -function _Platform_export__PROD(exports) -{ - scope['Elm'] - ? _Platform_mergeExportsProd(scope['Elm'], exports) - : scope['Elm'] = exports; +function _Platform_export__PROD(exports) { + scope["Elm"] ? _Platform_mergeExportsProd(scope["Elm"], exports) : (scope["Elm"] = exports); } - -function _Platform_mergeExportsProd(obj, exports) -{ - for (var name in exports) - { - (name in obj) - ? (name == 'init') - ? __Debug_crash(6) - : _Platform_mergeExportsProd(obj[name], exports[name]) - : (obj[name] = exports[name]); - } +function _Platform_mergeExportsProd(obj, exports) { + for (var name in exports) { + name in obj + ? name == "init" + ? __Debug_crash(6) + : _Platform_mergeExportsProd(obj[name], exports[name]) + : (obj[name] = exports[name]); + } } - -function _Platform_export__DEBUG(exports) -{ - scope['Elm'] - ? _Platform_mergeExportsDebug('Elm', scope['Elm'], exports) - : scope['Elm'] = exports; +function _Platform_export__DEBUG(exports) { + scope["Elm"] + ? _Platform_mergeExportsDebug("Elm", scope["Elm"], exports) + : (scope["Elm"] = exports); } - -function _Platform_mergeExportsDebug(moduleName, obj, exports) -{ - for (var name in exports) - { - (name in obj) - ? (name == 'init') - ? __Debug_crash(6, moduleName) - : _Platform_mergeExportsDebug(moduleName + '.' + name, obj[name], exports[name]) - : (obj[name] = exports[name]); - } +function _Platform_mergeExportsDebug(moduleName, obj, exports) { + for (var name in exports) { + name in obj + ? name == "init" + ? __Debug_crash(6, moduleName) + : _Platform_mergeExportsDebug(moduleName + "." + name, obj[name], exports[name]) + : (obj[name] = exports[name]); + } } diff --git a/src/Elm/Kernel/Process.js b/src/Elm/Kernel/Process.js deleted file mode 100644 index 4a750f32..00000000 --- a/src/Elm/Kernel/Process.js +++ /dev/null @@ -1,18 +0,0 @@ -/* - -import Elm.Kernel.Scheduler exposing (binding, succeed) -import Elm.Kernel.Utils exposing (Tuple0) - -*/ - - -function _Process_sleep(time) -{ - return __Scheduler_binding(function(callback) { - var id = setTimeout(function() { - callback(__Scheduler_succeed(__Utils_Tuple0)); - }, time); - - return function() { clearTimeout(id); }; - }); -} diff --git a/src/Elm/Kernel/Process.server.js b/src/Elm/Kernel/Process.server.js deleted file mode 100644 index 9230604a..00000000 --- a/src/Elm/Kernel/Process.server.js +++ /dev/null @@ -1,11 +0,0 @@ -/* - -import Elm.Kernel.Scheduler exposing (binding) - -*/ - - -function _Process_sleep() -{ - return __Scheduler_binding(function() {}); -} diff --git a/src/Elm/Kernel/Scheduler.js b/src/Elm/Kernel/Scheduler.js index 37a68be8..48417421 100644 --- a/src/Elm/Kernel/Scheduler.js +++ b/src/Elm/Kernel/Scheduler.js @@ -1,195 +1,106 @@ /* -import Elm.Kernel.Utils exposing (Tuple0) - +import Platform.Scheduler as NiceScheduler exposing (succeed, binding, rawSpawn) +import Maybe exposing (Just, Nothing) +import Elm.Kernel.Debug exposing (crash, runtimeCrashReason) +import Elm.Kernel.Basics exposing (isDebug) */ +// COMPATIBILITY -// TASKS - -function _Scheduler_succeed(value) -{ - return { - $: __1_SUCCEED, - __value: value - }; -} - -function _Scheduler_fail(error) -{ - return { - $: __1_FAIL, - __value: error - }; +/* + * We include these to avoid having to change code in other `elm/*` packages. + * + * We have to define these as functions rather than variables as the + * implementations of elm/core:Platform.Scheduler.* functions may come later in + * the generated javascript file. + * + * **IMPORTANT**: these functions return `Process.Task`s and + * `Process.ProcessId`s rather than `RawScheduler.Task`s and + * `RawScheduler.ProcessId`s for compatability with `elm/*` package code. + */ + +function _Scheduler_succeed(value) { + return __NiceScheduler_succeed(value); } -function _Scheduler_binding(callback) -{ - return { - $: __1_BINDING, - __callback: callback, - __kill: null - }; +function _Scheduler_binding(future) { + return __NiceScheduler_binding(future); } -var _Scheduler_andThen = F2(function(callback, task) -{ - return { - $: __1_AND_THEN, - __callback: callback, - __task: task - }; -}); - -var _Scheduler_onError = F2(function(callback, task) -{ - return { - $: __1_ON_ERROR, - __callback: callback, - __task: task - }; -}); - -function _Scheduler_receive(callback) -{ - return { - $: __1_RECEIVE, - __callback: callback - }; +function _Scheduler_rawSpawn(task) { + return __NiceScheduler_rawSpawn(task); } - -// PROCESSES +// SCHEDULER var _Scheduler_guid = 0; +var _Scheduler_processes = new WeakMap(); -function _Scheduler_rawSpawn(task) -{ - var proc = { - $: __2_PROCESS, - __id: _Scheduler_guid++, - __root: task, - __stack: null, - __mailbox: [] - }; - - _Scheduler_enqueue(proc); - - return proc; -} - -function _Scheduler_spawn(task) -{ - return _Scheduler_binding(function(callback) { - callback(_Scheduler_succeed(_Scheduler_rawSpawn(task))); - }); -} - -function _Scheduler_rawSend(proc, msg) -{ - proc.__mailbox.push(msg); - _Scheduler_enqueue(proc); +function _Scheduler_getGuid() { + return _Scheduler_guid++; } -var _Scheduler_send = F2(function(proc, msg) -{ - return _Scheduler_binding(function(callback) { - _Scheduler_rawSend(proc, msg); - callback(_Scheduler_succeed(__Utils_Tuple0)); - }); -}); - -function _Scheduler_kill(proc) -{ - return _Scheduler_binding(function(callback) { - var task = proc.__root; - if (task.$ === __1_BINDING && task.__kill) - { - task.__kill(); - } - - proc.__root = null; - - callback(_Scheduler_succeed(__Utils_Tuple0)); - }); -} - - -/* STEP PROCESSES - -type alias Process = - { $ : tag - , id : unique_id - , root : Task - , stack : null | { $: SUCCEED | FAIL, a: callback, b: stack } - , mailbox : [msg] +function _Scheduler_getProcessState(id) { + const procState = _Scheduler_processes.get(id); + if (procState === undefined) { + return __Maybe_Nothing; } - -*/ - - -var _Scheduler_working = false; -var _Scheduler_queue = []; - - -function _Scheduler_enqueue(proc) -{ - _Scheduler_queue.push(proc); - if (_Scheduler_working) - { - return; - } - _Scheduler_working = true; - while (proc = _Scheduler_queue.shift()) - { - _Scheduler_step(proc); - } - _Scheduler_working = false; + return __Maybe_Just(procState); } +var _Scheduler_registerNewProcess = F2((procId, procState) => { + if (__Basics_isDebug && _Scheduler_processes.has(procId)) { + __Debug_crash( + 12, + __Debug_runtimeCrashReason("procIdAlreadyRegistered"), + procId && procId.a && procId.a.__$id + ); + } + _Scheduler_processes.set(procId, procState); + return procId; +}); -function _Scheduler_step(proc) -{ - while (proc.__root) - { - var rootTag = proc.__root.$; - if (rootTag === __1_SUCCEED || rootTag === __1_FAIL) - { - while (proc.__stack && proc.__stack.$ !== rootTag) - { - proc.__stack = proc.__stack.__rest; - } - if (!proc.__stack) - { - return; - } - proc.__root = proc.__stack.__callback(proc.__root.__value); - proc.__stack = proc.__stack.__rest; - } - else if (rootTag === __1_BINDING) - { - proc.__root.__kill = proc.__root.__callback(function(newRoot) { - proc.__root = newRoot; - _Scheduler_enqueue(proc); - }); - return; - } - else if (rootTag === __1_RECEIVE) - { - if (proc.__mailbox.length === 0) - { - return; - } - proc.__root = proc.__root.__callback(proc.__mailbox.shift()); - } - else // if (rootTag === __1_AND_THEN || rootTag === __1_ON_ERROR) - { - proc.__stack = { - $: rootTag === __1_AND_THEN ? __1_SUCCEED : __1_FAIL, - __callback: proc.__root.__callback, - __rest: proc.__stack - }; - proc.__root = proc.__root.__task; - } - } -} +const _Scheduler_enqueueWithStepper = (stepper) => { + let working = false; + const queue = []; + + return (procId) => (rootTask) => { + if (__Basics_isDebug && queue.some((p) => p[0].a.__$id === procId.a.__$id)) { + __Debug_crash( + 12, + __Debug_runtimeCrashReason("procIdAlreadyInQueue"), + procId && procId.a && procId.a.__$id + ); + } + queue.push([procId, rootTask]); + if (working) { + return procId; + } + working = true; + while (true) { + const next = queue.shift(); + if (next === undefined) { + working = false; + return procId; + } + const [newProcId, newRootTask] = next; + _Scheduler_processes.set(newProcId, A2(stepper, newProcId, newRootTask)); + } + }; +}; + +const _Scheduler_delay = F2((time, value) => ({ + __$then_: (callback) => { + let id = setTimeout(() => { + callback(value); + }, time); + return (x) => { + if (id !== null) { + clearTimeout(id); + id = null; + } + return x; + }; + }, +})); diff --git a/src/Elm/Kernel/String.js b/src/Elm/Kernel/String.js index 1a005e7f..82be3ae0 100644 --- a/src/Elm/Kernel/String.js +++ b/src/Elm/Kernel/String.js @@ -1,318 +1,259 @@ /* -import Elm.Kernel.List exposing (fromArray, toArray, Nil) +import Elm.Kernel.List exposing (fromArray, toArray) import Elm.Kernel.Utils exposing (chr, Tuple2) import Maybe exposing (Just, Nothing) +import List exposing (Nil_elm_builtin) */ - -var _String_cons = F2(function(chr, str) -{ - return chr + str; +var _String_cons = F2(function (chr, str) { + return chr + str; }); -function _String_uncons(string) -{ - var word = string.charCodeAt(0); - return !isNaN(word) - ? __Maybe_Just( - 0xD800 <= word && word <= 0xDBFF - ? __Utils_Tuple2(__Utils_chr(string[0] + string[1]), string.slice(2)) - : __Utils_Tuple2(__Utils_chr(string[0]), string.slice(1)) - ) - : __Maybe_Nothing; +function _String_uncons(string) { + var word = string.charCodeAt(0); + return !isNaN(word) + ? __Maybe_Just( + 0xd800 <= word && word <= 0xdbff + ? __Utils_Tuple2(__Utils_chr(string[0] + string[1]), string.slice(2)) + : __Utils_Tuple2(__Utils_chr(string[0]), string.slice(1)) + ) + : __Maybe_Nothing; } -var _String_append = F2(function(a, b) -{ - return a + b; +var _String_append = F2(function (a, b) { + return a + b; }); -function _String_length(str) -{ - return str.length; +function _String_length(str) { + return str.length; } -var _String_map = F2(function(func, string) -{ - var len = string.length; - var array = new Array(len); - var i = 0; - while (i < len) - { - var word = string.charCodeAt(i); - if (0xD800 <= word && word <= 0xDBFF) - { - array[i] = func(__Utils_chr(string[i] + string[i+1])); - i += 2; - continue; - } - array[i] = func(__Utils_chr(string[i])); - i++; - } - return array.join(''); +var _String_map = F2(function (func, string) { + var len = string.length; + var array = new Array(len); + var i = 0; + while (i < len) { + var word = string.charCodeAt(i); + if (0xd800 <= word && word <= 0xdbff) { + array[i] = func(__Utils_chr(string[i] + string[i + 1])); + i += 2; + continue; + } + array[i] = func(__Utils_chr(string[i])); + i++; + } + return array.join(""); }); -var _String_filter = F2(function(isGood, str) -{ - var arr = []; - var len = str.length; - var i = 0; - while (i < len) - { - var char = str[i]; - var word = str.charCodeAt(i); - i++; - if (0xD800 <= word && word <= 0xDBFF) - { - char += str[i]; - i++; - } - - if (isGood(__Utils_chr(char))) - { - arr.push(char); - } - } - return arr.join(''); +var _String_filter = F2(function (isGood, str) { + var arr = []; + var len = str.length; + var i = 0; + while (i < len) { + var char = str[i]; + var word = str.charCodeAt(i); + i++; + if (0xd800 <= word && word <= 0xdbff) { + char += str[i]; + i++; + } + + if (isGood(__Utils_chr(char))) { + arr.push(char); + } + } + return arr.join(""); }); -function _String_reverse(str) -{ - var len = str.length; - var arr = new Array(len); - var i = 0; - while (i < len) - { - var word = str.charCodeAt(i); - if (0xD800 <= word && word <= 0xDBFF) - { - arr[len - i] = str[i + 1]; - i++; - arr[len - i] = str[i - 1]; - i++; - } - else - { - arr[len - i] = str[i]; - i++; - } - } - return arr.join(''); +function _String_reverse(str) { + var len = str.length; + var arr = new Array(len); + var i = 0; + while (i < len) { + var word = str.charCodeAt(i); + if (0xd800 <= word && word <= 0xdbff) { + arr[len - i] = str[i + 1]; + i++; + arr[len - i] = str[i - 1]; + i++; + } else { + arr[len - i] = str[i]; + i++; + } + } + return arr.join(""); } -var _String_foldl = F3(function(func, state, string) -{ - var len = string.length; - var i = 0; - while (i < len) - { - var char = string[i]; - var word = string.charCodeAt(i); - i++; - if (0xD800 <= word && word <= 0xDBFF) - { - char += string[i]; - i++; - } - state = A2(func, __Utils_chr(char), state); - } - return state; +var _String_foldl = F3(function (func, state, string) { + var len = string.length; + var i = 0; + while (i < len) { + var char = string[i]; + var word = string.charCodeAt(i); + i++; + if (0xd800 <= word && word <= 0xdbff) { + char += string[i]; + i++; + } + state = A2(func, __Utils_chr(char), state); + } + return state; }); -var _String_foldr = F3(function(func, state, string) -{ - var i = string.length; - while (i--) - { - var char = string[i]; - var word = string.charCodeAt(i); - if (0xDC00 <= word && word <= 0xDFFF) - { - i--; - char = string[i] + char; - } - state = A2(func, __Utils_chr(char), state); - } - return state; +var _String_foldr = F3(function (func, state, string) { + var i = string.length; + while (i--) { + var char = string[i]; + var word = string.charCodeAt(i); + if (0xdc00 <= word && word <= 0xdfff) { + i--; + char = string[i] + char; + } + state = A2(func, __Utils_chr(char), state); + } + return state; }); -var _String_split = F2(function(sep, str) -{ - return str.split(sep); +var _String_split = F2(function (sep, str) { + return str.split(sep); }); -var _String_join = F2(function(sep, strs) -{ - return strs.join(sep); +var _String_join = F2(function (sep, strs) { + return strs.join(sep); }); -var _String_slice = F3(function(start, end, str) { - return str.slice(start, end); +var _String_slice = F3(function (start, end, str) { + return str.slice(start, end); }); -function _String_trim(str) -{ - return str.trim(); +function _String_trim(str) { + return str.trim(); } -function _String_trimLeft(str) -{ - return str.replace(/^\s+/, ''); +function _String_trimLeft(str) { + return str.replace(/^\s+/, ""); } -function _String_trimRight(str) -{ - return str.replace(/\s+$/, ''); +function _String_trimRight(str) { + return str.replace(/\s+$/, ""); } -function _String_words(str) -{ - return __List_fromArray(str.trim().split(/\s+/g)); +function _String_words(str) { + return __List_fromArray(str.trim().split(/\s+/g)); } -function _String_lines(str) -{ - return __List_fromArray(str.split(/\r\n|\r|\n/g)); +function _String_lines(str) { + return __List_fromArray(str.split(/\r\n|\r|\n/g)); } -function _String_toUpper(str) -{ - return str.toUpperCase(); +function _String_toUpper(str) { + return str.toUpperCase(); } -function _String_toLower(str) -{ - return str.toLowerCase(); +function _String_toLower(str) { + return str.toLowerCase(); } -var _String_any = F2(function(isGood, string) -{ - var i = string.length; - while (i--) - { - var char = string[i]; - var word = string.charCodeAt(i); - if (0xDC00 <= word && word <= 0xDFFF) - { - i--; - char = string[i] + char; - } - if (isGood(__Utils_chr(char))) - { - return true; - } - } - return false; +var _String_any = F2(function (isGood, string) { + var i = string.length; + while (i--) { + var char = string[i]; + var word = string.charCodeAt(i); + if (0xdc00 <= word && word <= 0xdfff) { + i--; + char = string[i] + char; + } + if (isGood(__Utils_chr(char))) { + return true; + } + } + return false; }); -var _String_all = F2(function(isGood, string) -{ - var i = string.length; - while (i--) - { - var char = string[i]; - var word = string.charCodeAt(i); - if (0xDC00 <= word && word <= 0xDFFF) - { - i--; - char = string[i] + char; - } - if (!isGood(__Utils_chr(char))) - { - return false; - } - } - return true; +var _String_all = F2(function (isGood, string) { + var i = string.length; + while (i--) { + var char = string[i]; + var word = string.charCodeAt(i); + if (0xdc00 <= word && word <= 0xdfff) { + i--; + char = string[i] + char; + } + if (!isGood(__Utils_chr(char))) { + return false; + } + } + return true; }); -var _String_contains = F2(function(sub, str) -{ - return str.indexOf(sub) > -1; +var _String_contains = F2(function (sub, str) { + return str.indexOf(sub) > -1; }); -var _String_startsWith = F2(function(sub, str) -{ - return str.indexOf(sub) === 0; +var _String_startsWith = F2(function (sub, str) { + return str.indexOf(sub) === 0; }); -var _String_endsWith = F2(function(sub, str) -{ - return str.length >= sub.length && - str.lastIndexOf(sub) === str.length - sub.length; +var _String_endsWith = F2(function (sub, str) { + return str.length >= sub.length && str.lastIndexOf(sub) === str.length - sub.length; }); -var _String_indexes = F2(function(sub, str) -{ - var subLen = sub.length; +var _String_indexes = F2(function (sub, str) { + var subLen = sub.length; - if (subLen < 1) - { - return __List_Nil; - } + if (subLen < 1) { + return __List_Nil_elm_builtin; + } - var i = 0; - var is = []; + var i = 0; + var is = []; - while ((i = str.indexOf(sub, i)) > -1) - { - is.push(i); - i = i + subLen; - } + while ((i = str.indexOf(sub, i)) > -1) { + is.push(i); + i = i + subLen; + } - return __List_fromArray(is); + return __List_fromArray(is); }); - // TO STRING -function _String_fromNumber(number) -{ - return number + ''; +function _String_fromNumber(number) { + return number + ""; } - // INT CONVERSIONS -function _String_toInt(str) -{ - var total = 0; - var code0 = str.charCodeAt(0); - var start = code0 == 0x2B /* + */ || code0 == 0x2D /* - */ ? 1 : 0; - - for (var i = start; i < str.length; ++i) - { - var code = str.charCodeAt(i); - if (code < 0x30 || 0x39 < code) - { - return __Maybe_Nothing; - } - total = 10 * total + code - 0x30; - } - - return i == start - ? __Maybe_Nothing - : __Maybe_Just(code0 == 0x2D ? -total : total); -} +function _String_toInt(str) { + var total = 0; + var code0 = str.charCodeAt(0); + var start = code0 == 0x2b /* + */ || code0 == 0x2d /* - */ ? 1 : 0; + for (var i = start; i < str.length; ++i) { + var code = str.charCodeAt(i); + if (code < 0x30 || 0x39 < code) { + return __Maybe_Nothing; + } + total = 10 * total + code - 0x30; + } + + return i == start ? __Maybe_Nothing : __Maybe_Just(code0 == 0x2d ? -total : total); +} // FLOAT CONVERSIONS -function _String_toFloat(s) -{ - // check if it is a hex, octal, or binary number - if (s.length === 0 || /[\sxbo]/.test(s)) - { - return __Maybe_Nothing; - } - var n = +s; - // faster isNaN check - return n === n ? __Maybe_Just(n) : __Maybe_Nothing; +function _String_toFloat(s) { + // check if it is a hex, octal, or binary number + if (s.length === 0 || /[\sxbo]/.test(s)) { + return __Maybe_Nothing; + } + var n = +s; + // faster isNaN check + return n === n ? __Maybe_Just(n) : __Maybe_Nothing; } -function _String_fromList(chars) -{ - return __List_toArray(chars).join(''); +function _String_fromList(chars) { + return __List_toArray(chars).join(""); } - diff --git a/src/Elm/Kernel/Time.js b/src/Elm/Kernel/Time.js new file mode 100644 index 00000000..dd10931e --- /dev/null +++ b/src/Elm/Kernel/Time.js @@ -0,0 +1,72 @@ +/* + +import Time exposing (customZone, Name) +import Elm.Kernel.List exposing (Nil) +import Elm.Kernel.Platform exposing (createSubProcess) +import Platform.Scheduler as Scheduler exposing (execImpure) +import Elm.Kernel.Channel exposing (rawSend) +import Elm.Kernel.Utils exposing (Tuple0) + +*/ + +function _Time_now(millisToPosix) { + return __Scheduler_execImpure((_) => millisToPosix(Date.now())); +} + +const _Time_intervals = new WeakMap(); + +/** + * There is no way to do clean up in js. This implementation is fundamentally + * broken as the intervals created are never cleaned up. TODO(harry): fix this. + * + * This function is impure and should _really_ return a Task. That would be a + * breaking API change though. + */ +function _Time_setInterval(interval) { + const roundedInterval = Math.round(interval); + const existingKey = _Time_intervals.get(roundedInterval); + if (existingKey !== undefined) { + return existingKey; + } else { + const handle = setInterval(() => { + A2(__Channel_rawSend, sender, Date.now()); + }, roundedInterval); + + // Unless we are carefull here, creating any Time.every subscription has + // the potential of preventing and elm app from terminating when we run in + // nodejs. We use the node specific [`TimeOut.ref()`](ref) and + // [`TimeOut.unref()`](unref) API's to ensure our app terminates. + // + // [ref]: https://nodejs.org/api/timers.html#timers_timeout_ref + // [unref]: https://nodejs.org/api/timers.html#timers_timeout_unref + const onSubReset = + typeof handle.ref === "function" + ? (n) => { + if (n == 0) { + handle.unref(); + } else { + handle.ref(); + } + return __Utils_Tuple0; + } + : (_) => __Utils_Tuple0; + + const tuple = __Platform_createSubProcess(onSubReset); + const key = tuple.a; + const sender = tuple.b; + + return key; + } +} + +function _Time_here() { + return __Scheduler_execImpure((_) => + A2(__Time_customZone, -new Date().getTimezoneOffset(), __List_Nil) + ); +} + +function _Time_getZoneName() { + return __Scheduler_execImpure((_) => + __Time_Name(Intl.DateTimeFormat().resolvedOptions().timeZone) + ); +} diff --git a/src/Elm/Kernel/Utils.js b/src/Elm/Kernel/Utils.js index 951dff4b..0a14d52e 100644 --- a/src/Elm/Kernel/Utils.js +++ b/src/Elm/Kernel/Utils.js @@ -1,193 +1,160 @@ /* -import Array exposing (toList) -import Basics exposing (LT, EQ, GT) import Dict exposing (toList) import Elm.Kernel.Debug exposing (crash) -import Elm.Kernel.List exposing (Cons, Nil) +import Elm.Kernel.List exposing (nilKey) +import Elm.Kernel.Basics exposing (isDebug) import Set exposing (toList) +import List exposing (append) */ - // EQUALITY -function _Utils_eq(x, y) -{ - for ( - var pair, stack = [], isEqual = _Utils_eqHelp(x, y, 0, stack); - isEqual && (pair = stack.pop()); - isEqual = _Utils_eqHelp(pair.a, pair.b, 0, stack) - ) - {} - - return isEqual; +const _Utils_eq = (x, y) => { + const stack = []; + while (_Utils_eqHelp(x, y, 0, stack)) { + const pair = stack.pop(); + if (pair === undefined) { + return true; + } + [x, y] = pair; + } + return false; +}; + +function _Utils_eqHelp(x, y, depth, stack) { + if (x === y) { + return true; + } + + if (typeof x !== "object" || x === null || y === null) { + if (typeof x === "function") { + __Debug_crash(5); + } + return false; + } + + if (depth > 100) { + stack.push([x, y]); + return true; + } + + if (__Basics_isDebug) { + if (x.$ === "Set_elm_builtin") { + x = __Set_toList(x); + y = __Set_toList(y); + } else if (x.$ === "RBNode_elm_builtin" || x.$ === "RBEmpty_elm_builtin") { + x = __Dict_toList(x); + y = __Dict_toList(y); + } + } else { + if (x.$ < 0) { + x = __Dict_toList(x); + y = __Dict_toList(y); + } + } + + /* The compiler ensures that the elm types of x and y are the same. + * Therefore, x and y must have the same keys. + */ + for (const key of Object.keys(x)) { + if (!_Utils_eqHelp(x[key], y[key], depth + 1, stack)) { + return false; + } + } + return true; } -function _Utils_eqHelp(x, y, depth, stack) -{ - if (x === y) - { - return true; - } - - if (typeof x !== 'object' || x === null || y === null) - { - typeof x === 'function' && __Debug_crash(5); - return false; - } - - if (depth > 100) - { - stack.push(_Utils_Tuple2(x,y)); - return true; - } - - /**__DEBUG/ - if (x.$ === 'Set_elm_builtin') - { - x = __Set_toList(x); - y = __Set_toList(y); - } - if (x.$ === 'RBNode_elm_builtin' || x.$ === 'RBEmpty_elm_builtin') - { - x = __Dict_toList(x); - y = __Dict_toList(y); - } - //*/ - - /**__PROD/ - if (x.$ < 0) - { - x = __Dict_toList(x); - y = __Dict_toList(y); - } - //*/ - - for (var key in x) - { - if (!_Utils_eqHelp(x[key], y[key], depth + 1, stack)) - { - return false; - } - } - return true; -} - -var _Utils_equal = F2(_Utils_eq); -var _Utils_notEqual = F2(function(a, b) { return !_Utils_eq(a,b); }); - - +const _Utils_equal = F2(_Utils_eq); +const _Utils_notEqual = F2(function (a, b) { + return !_Utils_eq(a, b); +}); // COMPARISONS -// Code in Generate/JavaScript.hs, Basics.js, and List.js depends on -// the particular integer values assigned to LT, EQ, and GT. - -function _Utils_cmp(x, y, ord) -{ - if (typeof x !== 'object') - { - return x === y ? /*EQ*/ 0 : x < y ? /*LT*/ -1 : /*GT*/ 1; - } - - /**__DEBUG/ - if (x instanceof String) - { - var a = x.valueOf(); - var b = y.valueOf(); - return a === b ? 0 : a < b ? -1 : 1; - } - //*/ - - /**__PROD/ - if (typeof x.$ === 'undefined') - //*/ - /**__DEBUG/ - if (x.$[0] === '#') - //*/ - { - return (ord = _Utils_cmp(x.a, y.a)) - ? ord - : (ord = _Utils_cmp(x.b, y.b)) - ? ord - : _Utils_cmp(x.c, y.c); - } - - // traverse conses until end of a list or a mismatch - for (; x.b && y.b && !(ord = _Utils_cmp(x.a, y.a)); x = x.b, y = y.b) {} // WHILE_CONSES - return ord || (x.b ? /*GT*/ 1 : y.b ? /*LT*/ -1 : /*EQ*/ 0); +// Code in Generate/JavaScript/Expression.hs and Basics.elm depends on the +// particular integer values assigned to LT, EQ, and GT. Comparable types are: +// numbers, characters, strings, lists of comparable things, and tuples of +// comparable things. +function _Utils_cmp(x, y, ord) { + // Handle numbers, strings and characters in production mode. + if (typeof x !== "object") { + return x === y ? /*EQ*/ 0 : x < y ? /*LT*/ -1 : /*GT*/ 1; + } + + // Handle characters in debug mode. + if (__Basics_isDebug && x instanceof String) { + const a = x.valueOf(); + const b = y.valueOf(); + return a === b ? 0 : a < b ? -1 : 1; + } + + // Handle tuples. + const isTuple = __Basics_isDebug ? x.$[0] === "#" : x.$ === undefined; + if (isTuple) { + const ordA = _Utils_cmp(x.a, y.a); + if (ordA !== 0) { + return ordA; + } + const ordB = _Utils_cmp(x.a, y.a); + if (ordB !== 0) { + return ordB; + } + return _Utils_cmp(x.c, y.c); + } + + // Handle lists: traverse conses until end of a list or a mismatch. If the + // all the elements in one list are equal to all the elements in other list + // but the first list is longer than the first list is greater (and visa + // versa). + while (true) { + if (x.$ === __List_nilKey) { + if (y.$ === __List_nilKey) { + return 0; + } else { + return -1; + } + } else if (y.$ === __List_nilKey) { + return 1; + } + const ord = _Utils_cmp(x.a, y.a); + if (ord !== 0) { + return ord; + } + x = x.b; + y = y.b; + } } -var _Utils_lt = F2(function(a, b) { return _Utils_cmp(a, b) < 0; }); -var _Utils_le = F2(function(a, b) { return _Utils_cmp(a, b) < 1; }); -var _Utils_gt = F2(function(a, b) { return _Utils_cmp(a, b) > 0; }); -var _Utils_ge = F2(function(a, b) { return _Utils_cmp(a, b) >= 0; }); - -var _Utils_compare = F2(function(x, y) -{ - var n = _Utils_cmp(x, y); - return n < 0 ? __Basics_LT : n ? __Basics_GT : __Basics_EQ; -}); - +const _Utils_compare = F2((x, y) => _Utils_cmp(x, y)); // COMMON VALUES -var _Utils_Tuple0__PROD = 0; -var _Utils_Tuple0__DEBUG = { $: '#0' }; - -function _Utils_Tuple2__PROD(a, b) { return { a: a, b: b }; } -function _Utils_Tuple2__DEBUG(a, b) { return { $: '#2', a: a, b: b }; } +const _Utils_Tuple0__PROD = 0; +const _Utils_Tuple0__DEBUG = { $: "#0" }; -function _Utils_Tuple3__PROD(a, b, c) { return { a: a, b: b, c: c }; } -function _Utils_Tuple3__DEBUG(a, b, c) { return { $: '#3', a: a, b: b, c: c }; } +const _Utils_Tuple2__PROD = (a, b) => ({ a, b }); +const _Utils_Tuple2__DEBUG = (a, b) => ({ $: "#2", a, b }); -function _Utils_chr__PROD(c) { return c; } -function _Utils_chr__DEBUG(c) { return new String(c); } +const _Utils_Tuple3__PROD = (a, b, c) => ({ a, b, c }); +const _Utils_Tuple3__DEBUG = (a, b, c) => ({ $: "#3", a, b, c }); +const _Utils_chr__PROD = (c) => c; +const _Utils_chr__DEBUG = (c) => new String(c); // RECORDS -function _Utils_update(oldRecord, updatedFields) -{ - var newRecord = {}; - - for (var key in oldRecord) - { - newRecord[key] = oldRecord[key]; - } - - for (var key in updatedFields) - { - newRecord[key] = updatedFields[key]; - } - - return newRecord; -} - +const _Utils_update = (oldRecord, updatedFields) => Object.assign({}, oldRecord, updatedFields); // APPEND -var _Utils_append = F2(_Utils_ap); - -function _Utils_ap(xs, ys) -{ - // append Strings - if (typeof xs === 'string') - { - return xs + ys; - } - - // append Lists - if (!xs.b) - { - return ys; - } - var root = __List_Cons(xs.a, ys); - xs = xs.b - for (var curr = root; xs.b; xs = xs.b) // WHILE_CONS - { - curr = curr.b = __List_Cons(xs.a, ys); - } - return root; -} +const _Utils_ap = (xs, ys) => { + // append Strings + if (typeof xs === "string") { + return xs + ys; + } + + // append Lists + return A2(__List_append, xs, ys); +}; diff --git a/src/List.elm b/src/List.elm index 83f411c0..a16a07b4 100644 --- a/src/List.elm +++ b/src/List.elm @@ -1,111 +1,140 @@ module List exposing - ( singleton, repeat, range, (::) - , map, indexedMap, foldl, foldr, filter, filterMap - , length, reverse, member, all, any, maximum, minimum, sum, product - , append, concat, concatMap, intersperse, map2, map3, map4, map5 - , sort, sortBy, sortWith - , isEmpty, head, tail, take, drop, partition, unzip - ) - -{-| You can create a `List` in Elm with the `[1,2,3]` syntax, so lists are -used all over the place. This module has a bunch of functions to help you work -with them! + ( singleton, repeat, range, (::) + , map, indexedMap, foldl, foldr, filter, filterMap + , length, reverse, member, all, any, maximum, minimum, sum, product + , append, concat, concatMap, intersperse, map2, map3, map4, map5 + , sort, sortBy, sortWith + , isEmpty, head, tail, take, drop, partition, unzip + ) + +{-| You can create a `List` in Elm with the `[1,2,3]` syntax, so lists are used +all over the place. This module has a bunch of functions to help you work with +them! + # Create + @docs singleton, repeat, range, (::) + # Transform + @docs map, indexedMap, foldl, foldr, filter, filterMap + # Utilities + @docs length, reverse, member, all, any, maximum, minimum, sum, product + # Combine + @docs append, concat, concatMap, intersperse, map2, map3, map4, map5 + # Sort + @docs sort, sortBy, sortWith + # Deconstruct + @docs isEmpty, head, tail, take, drop, partition, unzip + +# Future work + +Benchmark the mapN functions and sortBy. Optimise to get comparible performance +with the official elm/core implementation. (This official elm/core +implementation uses kernel code.) + -} import Basics exposing (..) import Elm.Kernel.List -import Maybe exposing ( Maybe(..) ) +import Maybe exposing (Maybe(..)) +infix right 5 (::) = cons -infix right 5 (::) = cons +type List a + = Nil_elm_builtin + | Cons_elm_builtin a (List a) -- CREATE - {-| Create a list with only one element: - singleton 1234 == [1234] - singleton "hi" == ["hi"] + singleton 1234 == [ 1234 ] + + singleton "hi" == [ "hi" ] + -} singleton : a -> List a singleton value = - [value] + [ value ] + +{-| Create a list with _n_ copies of a value: -{-| Create a list with *n* copies of a value: + repeat 3 ( 0, 0 ) == [ ( 0, 0 ), ( 0, 0 ), ( 0, 0 ) ] - repeat 3 (0,0) == [(0,0),(0,0),(0,0)] -} repeat : Int -> a -> List a repeat n value = - repeatHelp [] n value + repeatHelp [] n value repeatHelp : List a -> Int -> a -> List a repeatHelp result n value = - if n <= 0 then - result + if n <= 0 then + result - else - repeatHelp (cons value result) (n-1) value + else + repeatHelp (cons value result) (n - 1) value {-| Create a list of numbers, every element increasing by one. You give the lowest and highest number that should be in the list. - range 3 6 == [3, 4, 5, 6] - range 3 3 == [3] + range 3 6 == [ 3, 4, 5, 6 ] + + range 3 3 == [ 3 ] + range 6 3 == [] + -} range : Int -> Int -> List Int range lo hi = - rangeHelp lo hi [] + rangeHelp lo hi [] rangeHelp : Int -> Int -> List Int -> List Int rangeHelp lo hi list = - if lo <= hi then - rangeHelp lo (hi - 1) (cons hi list) + if lo <= hi then + rangeHelp lo (hi - 1) (cons hi list) - else - list + else + list {-| Add an element to the front of a list. - 1 :: [2,3] == [1,2,3] - 1 :: [] == [1] + 1 :: [ 2, 3 ] == [ 1, 2, 3 ] -This operator is pronounced *cons* for historical reasons, but you can think + 1 :: [] == [ 1 ] + +This operator is pronounced _cons_ for historical reasons, but you can think of it like pushing an entry onto a stack. + -} cons : a -> List a -> List a cons = - Elm.Kernel.List.cons + Cons_elm_builtin @@ -114,60 +143,66 @@ cons = {-| Apply a function to every element of a list. - map sqrt [1,4,9] == [1,2,3] + map sqrt [ 1, 4, 9 ] == [ 1, 2, 3 ] - map not [True,False,True] == [False,True,False] + map not [ True, False, True ] == [ False, True, False ] So `map func [ a, b, c ]` is the same as `[ func a, func b, func c ]` + -} map : (a -> b) -> List a -> List b map f xs = - foldr (\x acc -> cons (f x) acc) [] xs + foldr (\x acc -> cons (f x) acc) [] xs {-| Same as `map` but the function is also applied to the index of each element (starting at zero). - indexedMap Tuple.pair ["Tom","Sue","Bob"] == [ (0,"Tom"), (1,"Sue"), (2,"Bob") ] + indexedMap Tuple.pair [ "Tom", "Sue", "Bob" ] == [ ( 0, "Tom" ), ( 1, "Sue" ), ( 2, "Bob" ) ] + -} indexedMap : (Int -> a -> b) -> List a -> List b indexedMap f xs = - map2 f (range 0 (length xs - 1)) xs + map2 f (range 0 (length xs - 1)) xs {-| Reduce a list from the left. - foldl (+) 0 [1,2,3] == 6 - foldl (::) [] [1,2,3] == [3,2,1] + foldl (+) 0 [ 1, 2, 3 ] == 6 + + foldl (::) [] [ 1, 2, 3 ] == [ 3, 2, 1 ] So `foldl step state [1,2,3]` is like saying: state - |> step 1 - |> step 2 - |> step 3 + |> step 1 + |> step 2 + |> step 3 + -} foldl : (a -> b -> b) -> b -> List a -> b foldl func acc list = - case list of - [] -> - acc + case list of + [] -> + acc - x :: xs -> - foldl func (func x acc) xs + x :: xs -> + foldl func (func x acc) xs {-| Reduce a list from the right. - foldr (+) 0 [1,2,3] == 6 - foldr (::) [] [1,2,3] == [1,2,3] + foldr (+) 0 [ 1, 2, 3 ] == 6 + + foldr (::) [] [ 1, 2, 3 ] == [ 1, 2, 3 ] So `foldr step state [1,2,3]` is like saying: state - |> step 3 - |> step 2 - |> step 1 + |> step 3 + |> step 2 + |> step 1 + -} foldr : (a -> b -> b) -> b -> List a -> b foldr fn acc ls = @@ -200,44 +235,57 @@ foldrHelper fn acc ctr ls = res = if ctr > 500 then foldl fn acc (reverse r4) + else foldrHelper fn acc (ctr + 1) r4 in - fn a (fn b (fn c (fn d res))) + fn a (fn b (fn c (fn d res))) {-| Keep elements that satisfy the test. - filter isEven [1,2,3,4,5,6] == [2,4,6] + filter isEven [ 1, 2, 3, 4, 5, 6 ] == [ 2, 4, 6 ] + -} filter : (a -> Bool) -> List a -> List a filter isGood list = - foldr (\x xs -> if isGood x then cons x xs else xs) [] list + foldr + (\x xs -> + if isGood x then + cons x xs + + else + xs + ) + [] + list {-| Filter out certain values. For example, maybe you have a bunch of strings from an untrusted source and you want to turn them into numbers: + numbers : List Int numbers = - filterMap String.toInt ["3", "hi", "12", "4th", "May"] + filterMap String.toInt [ "3", "hi", "12", "4th", "May" ] -- numbers == [3, 12] -} filterMap : (a -> Maybe b) -> List a -> List b filterMap f xs = - foldr (maybeCons f) [] xs + foldr (maybeCons f) [] xs maybeCons : (a -> Maybe b) -> a -> List b -> List b maybeCons f mx xs = - case f mx of - Just x -> - cons x xs + case f mx of + Just x -> + cons x xs + + Nothing -> + xs - Nothing -> - xs -- UTILITIES @@ -245,116 +293,134 @@ maybeCons f mx xs = {-| Determine the length of a list. - length [1,2,3] == 3 + length [ 1, 2, 3 ] == 3 + -} length : List a -> Int length xs = - foldl (\_ i -> i + 1) 0 xs + foldl (\_ i -> i + 1) 0 xs {-| Reverse a list. - reverse [1,2,3,4] == [4,3,2,1] + reverse [ 1, 2, 3, 4 ] == [ 4, 3, 2, 1 ] + -} reverse : List a -> List a reverse list = - foldl cons [] list + foldl cons [] list {-| Figure out whether a list contains a value. - member 9 [1,2,3,4] == False - member 4 [1,2,3,4] == True + member 9 [ 1, 2, 3, 4 ] == False + + member 4 [ 1, 2, 3, 4 ] == True + -} member : a -> List a -> Bool member x xs = - any (\a -> a == x) xs + any (\a -> a == x) xs {-| Determine if all elements satisfy some test. - all isEven [2,4] == True - all isEven [2,3] == False + all isEven [ 2, 4 ] == True + + all isEven [ 2, 3 ] == False + all isEven [] == True + -} all : (a -> Bool) -> List a -> Bool all isOkay list = - not (any (not << isOkay) list) + not (any (not << isOkay) list) {-| Determine if any elements satisfy some test. - any isEven [2,3] == True - any isEven [1,3] == False + any isEven [ 2, 3 ] == True + + any isEven [ 1, 3 ] == False + any isEven [] == False + -} any : (a -> Bool) -> List a -> Bool any isOkay list = - case list of - [] -> - False + case list of + [] -> + False - x :: xs -> - -- note: (isOkay x || any isOkay xs) would not get TCO - if isOkay x then - True + x :: xs -> + -- note: (isOkay x || any isOkay xs) would not get TCO + if isOkay x then + True - else - any isOkay xs + else + any isOkay xs {-| Find the maximum element in a non-empty list. - maximum [1,4,2] == Just 4 - maximum [] == Nothing + maximum [ 1, 4, 2 ] == Just 4 + + maximum [] == Nothing + -} maximum : List comparable -> Maybe comparable maximum list = - case list of - x :: xs -> - Just (foldl max x xs) + case list of + x :: xs -> + Just (foldl max x xs) - _ -> - Nothing + _ -> + Nothing {-| Find the minimum element in a non-empty list. - minimum [3,2,1] == Just 1 - minimum [] == Nothing + minimum [ 3, 2, 1 ] == Just 1 + + minimum [] == Nothing + -} minimum : List comparable -> Maybe comparable minimum list = - case list of - x :: xs -> - Just (foldl min x xs) + case list of + x :: xs -> + Just (foldl min x xs) - _ -> - Nothing + _ -> + Nothing {-| Get the sum of the list elements. - sum [1,2,3] == 6 - sum [1,1,1] == 3 - sum [] == 0 + sum [ 1, 2, 3 ] == 6 + + sum [ 1, 1, 1 ] == 3 + + sum [] == 0 -} sum : List number -> number sum numbers = - foldl (+) 0 numbers + foldl (+) 0 numbers {-| Get the product of the list elements. - product [2,2,2] == 8 - product [3,3,3] == 27 - product [] == 1 + product [ 2, 2, 2 ] == 8 + + product [ 3, 3, 3 ] == 27 + + product [] == 1 -} product : List number -> number product numbers = - foldl (*) 1 numbers + foldl (*) 1 numbers @@ -363,98 +429,143 @@ product numbers = {-| Put two lists together. - append [1,1,2] [3,5,8] == [1,1,2,3,5,8] - append ['a','b'] ['c'] == ['a','b','c'] + append [ 1, 1, 2 ] [ 3, 5, 8 ] == [ 1, 1, 2, 3, 5, 8 ] + + append [ 'a', 'b' ] [ 'c' ] == [ 'a', 'b', 'c' ] You can also use [the `(++)` operator](Basics#++) to append lists. + -} append : List a -> List a -> List a append xs ys = - case ys of - [] -> - xs + case ys of + [] -> + xs - _ -> - foldr cons ys xs + _ -> + foldr cons ys xs {-| Concatenate a bunch of lists into a single list: - concat [[1,2],[3],[4,5]] == [1,2,3,4,5] + concat [ [ 1, 2 ], [ 3 ], [ 4, 5 ] ] == [ 1, 2, 3, 4, 5 ] + -} concat : List (List a) -> List a concat lists = - foldr append [] lists + foldr append [] lists {-| Map a given function onto a list and flatten the resulting lists. concatMap f xs == concat (map f xs) + -} concatMap : (a -> List b) -> List a -> List b concatMap f list = - concat (map f list) + concat (map f list) {-| Places the given value between all members of the given list. - intersperse "on" ["turtles","turtles","turtles"] == ["turtles","on","turtles","on","turtles"] + intersperse "on" [ "turtles", "turtles", "turtles" ] == [ "turtles", "on", "turtles", "on", "turtles" ] + -} intersperse : a -> List a -> List a intersperse sep xs = - case xs of - [] -> - [] + case xs of + [] -> + [] - hd :: tl -> - let - step x rest = - cons sep (cons x rest) + hd :: tl -> + let + step x rest = + cons sep (cons x rest) - spersed = - foldr step [] tl - in - cons hd spersed + spersed = + foldr step [] tl + in + cons hd spersed {-| Combine two lists, combining them with the given function. If one list is longer, the extra elements are dropped. + totals : List Int -> List Int -> List Int totals xs ys = - List.map2 (+) xs ys + List.map2 (+) xs ys -- totals [1,2,3] [4,5,6] == [5,7,9] - - pairs : List a -> List b -> List (a,b) + pairs : List a -> List b -> List ( a, b ) pairs xs ys = - List.map2 Tuple.pair xs ys + List.map2 Tuple.pair xs ys -- pairs ["alice","bob","chuck"] [2,5,7,8] -- == [("alice",2),("bob",5),("chuck",7)] -} map2 : (a -> b -> result) -> List a -> List b -> List result -map2 = - Elm.Kernel.List.map2 +map2 f xs1 xs2 = + reverse (map2Help f xs1 xs2 []) -{-|-} +{-| -} map3 : (a -> b -> c -> result) -> List a -> List b -> List c -> List result -map3 = - Elm.Kernel.List.map3 +map3 f xs1 xs2 xs3 = + reverse (map3Help f xs1 xs2 xs3 []) -{-|-} +{-| -} map4 : (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result -map4 = - Elm.Kernel.List.map4 +map4 f xs1 xs2 xs3 xs4 = + reverse (map4Help f xs1 xs2 xs3 xs4 []) -{-|-} +{-| -} map5 : (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result -map5 = - Elm.Kernel.List.map5 +map5 f xs1 xs2 xs3 xs4 xs5 = + reverse (map5Help f xs1 xs2 xs3 xs4 xs5 []) + + +map2Help : (a -> b -> result) -> List a -> List b -> List result -> List result +map2Help f xs1 xs2 ys = + case ( xs1, xs2 ) of + ( head1 :: rest1, head2 :: rest2 ) -> + map2Help f rest1 rest2 (cons (f head1 head2) ys) + + _ -> + ys + + +map3Help : (a -> b -> c -> result) -> List a -> List b -> List c -> List result -> List result +map3Help f xs1 xs2 xs3 ys = + case ( xs1, xs2, xs3 ) of + ( head1 :: rest1, head2 :: rest2, head3 :: rest3 ) -> + map3Help f rest1 rest2 rest3 (cons (f head1 head2 head3) ys) + + _ -> + ys + + +map4Help : (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result -> List result +map4Help f xs1 xs2 xs3 xs4 ys = + case ( xs1, xs2, ( xs3, xs4 ) ) of + ( head1 :: rest1, head2 :: rest2, ( head3 :: rest3, head4 :: rest4 ) ) -> + map4Help f rest1 rest2 rest3 rest4 (cons (f head1 head2 head3 head4) ys) + + _ -> + ys + + +map5Help : (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result -> List result +map5Help f xs1 xs2 xs3 xs4 xs5 ys = + case ( xs1, xs2, ( xs3, xs4, xs5 ) ) of + ( head1 :: rest1, head2 :: rest2, ( head3 :: rest3, head4 :: rest4, head5 :: rest5 ) ) -> + map5Help f rest1 rest2 rest3 rest4 rest5 (cons (f head1 head2 head3 head4 head5) ys) + + _ -> + ys @@ -463,11 +574,12 @@ map5 = {-| Sort values from lowest to highest - sort [3,1,5] == [1,3,5] + sort [ 3, 1, 5 ] == [ 1, 3, 5 ] + -} sort : List comparable -> List comparable sort xs = - sortBy identity xs + sortBy identity xs {-| Sort values by a derived property. @@ -480,10 +592,11 @@ sort xs = sortBy .height [chuck,alice,bob] == [alice,chuck,bob] sortBy String.length ["mouse","cat"] == ["cat","mouse"] + -} sortBy : (a -> comparable) -> List a -> List a -sortBy = - Elm.Kernel.List.sortBy +sortBy f = + sortWith (\a b -> compare (f a) (f b)) {-| Sort values with a custom comparison function. @@ -498,10 +611,11 @@ sortBy = This is also the most general sort function, allowing you to define any other: `sort == sortWith compare` + -} sortWith : (a -> a -> Order) -> List a -> List a sortWith = - Elm.Kernel.List.sortWith + Elm.Kernel.List.sortWith @@ -514,152 +628,166 @@ sortWith = **Note:** It is usually preferable to use a `case` to test this so you do not forget to handle the `(x :: xs)` case as well! + -} isEmpty : List a -> Bool isEmpty xs = - case xs of - [] -> - True + case xs of + [] -> + True - _ -> - False + _ -> + False {-| Extract the first element of a list. - head [1,2,3] == Just 1 + head [ 1, 2, 3 ] == Just 1 + head [] == Nothing **Note:** It is usually preferable to use a `case` to deconstruct a `List` because it gives you `(x :: xs)` and you can work with both subparts. + -} head : List a -> Maybe a head list = - case list of - x :: xs -> - Just x + case list of + x :: xs -> + Just x - [] -> - Nothing + [] -> + Nothing {-| Extract the rest of the list. - tail [1,2,3] == Just [2,3] + tail [ 1, 2, 3 ] == Just [ 2, 3 ] + tail [] == Nothing **Note:** It is usually preferable to use a `case` to deconstruct a `List` because it gives you `(x :: xs)` and you can work with both subparts. + -} tail : List a -> Maybe (List a) tail list = - case list of - x :: xs -> - Just xs + case list of + x :: xs -> + Just xs + + [] -> + Nothing - [] -> - Nothing +{-| Take the first _n_ members of a list. -{-| Take the first *n* members of a list. + take 2 [ 1, 2, 3, 4 ] == [ 1, 2 ] - take 2 [1,2,3,4] == [1,2] -} take : Int -> List a -> List a take n list = - takeFast 0 n list + takeFast 0 n list takeFast : Int -> Int -> List a -> List a takeFast ctr n list = - if n <= 0 then - [] - else - case ( n, list ) of - ( _, [] ) -> - list + if n <= 0 then + [] - ( 1, x :: _ ) -> - [ x ] + else + case ( n, list ) of + ( _, [] ) -> + list - ( 2, x :: y :: _ ) -> - [ x, y ] + ( 1, x :: _ ) -> + [ x ] - ( 3, x :: y :: z :: _ ) -> - [ x, y, z ] + ( 2, x :: y :: _ ) -> + [ x, y ] - ( _, x :: y :: z :: w :: tl ) -> - if ctr > 1000 then - cons x (cons y (cons z (cons w (takeTailRec (n - 4) tl)))) - else - cons x (cons y (cons z (cons w (takeFast (ctr + 1) (n - 4) tl)))) + ( 3, x :: y :: z :: _ ) -> + [ x, y, z ] + + ( _, x :: y :: z :: w :: tl ) -> + if ctr > 1000 then + cons x (cons y (cons z (cons w (takeTailRec (n - 4) tl)))) + + else + cons x (cons y (cons z (cons w (takeFast (ctr + 1) (n - 4) tl)))) + + _ -> + list - _ -> - list takeTailRec : Int -> List a -> List a takeTailRec n list = - reverse (takeReverse n list []) + reverse (takeReverse n list []) takeReverse : Int -> List a -> List a -> List a takeReverse n list kept = - if n <= 0 then - kept - else - case list of - [] -> + if n <= 0 then kept - x :: xs -> - takeReverse (n - 1) xs (cons x kept) + else + case list of + [] -> + kept + + x :: xs -> + takeReverse (n - 1) xs (cons x kept) -{-| Drop the first *n* members of a list. +{-| Drop the first _n_ members of a list. + + drop 2 [ 1, 2, 3, 4 ] == [ 3, 4 ] - drop 2 [1,2,3,4] == [3,4] -} drop : Int -> List a -> List a drop n list = - if n <= 0 then - list - - else - case list of - [] -> + if n <= 0 then list - x :: xs -> - drop (n-1) xs + else + case list of + [] -> + list + + x :: xs -> + drop (n - 1) xs {-| Partition a list based on some test. The first list contains all values that satisfy the test, and the second list contains all the value that do not. - partition (\x -> x < 3) [0,1,2,3,4,5] == ([0,1,2], [3,4,5]) - partition isEven [0,1,2,3,4,5] == ([0,2,4], [1,3,5]) + partition (\x -> x < 3) [ 0, 1, 2, 3, 4, 5 ] == ( [ 0, 1, 2 ], [ 3, 4, 5 ] ) + + partition isEven [ 0, 1, 2, 3, 4, 5 ] == ( [ 0, 2, 4 ], [ 1, 3, 5 ] ) + -} -partition : (a -> Bool) -> List a -> (List a, List a) +partition : (a -> Bool) -> List a -> ( List a, List a ) partition pred list = - let - step x (trues, falses) = - if pred x then - (cons x trues, falses) + let + step x ( trues, falses ) = + if pred x then + ( cons x trues, falses ) - else - (trues, cons x falses) - in - foldr step ([],[]) list + else + ( trues, cons x falses ) + in + foldr step ( [], [] ) list {-| Decompose a list of tuples into a tuple of lists. - unzip [(0, True), (17, False), (1337, True)] == ([0,17,1337], [True,False,True]) + unzip [ ( 0, True ), ( 17, False ), ( 1337, True ) ] == ( [ 0, 17, 1337 ], [ True, False, True ] ) + -} -unzip : List (a,b) -> (List a, List b) +unzip : List ( a, b ) -> ( List a, List b ) unzip pairs = - let - step (x,y) (xs,ys) = - (cons x xs, cons y ys) - in - foldr step ([], []) pairs + let + step ( x, y ) ( xs, ys ) = + ( cons x xs, cons y ys ) + in + foldr step ( [], [] ) pairs diff --git a/src/Maybe.elm b/src/Maybe.elm index 7cb5a5bf..5affd6d1 100644 --- a/src/Maybe.elm +++ b/src/Maybe.elm @@ -1,28 +1,32 @@ module Maybe exposing - ( Maybe(..) - , andThen - , map, map2, map3, map4, map5 - , withDefault - ) + ( Maybe(..) + , withDefault, map, map2, map3, map4, map5 + , andThen + ) {-| This library fills a bunch of important niches in Elm. A `Maybe` can help you with optional arguments, error handling, and records with optional fields. + # Definition + @docs Maybe + # Common Helpers + @docs withDefault, map, map2, map3, map4, map5 + # Chaining Maybes + @docs andThen --} +-} import Basics exposing (Bool(..)) - {-| Represent values that may or may not exist. It can be useful if you have a record field that is only filled in sometimes. Or if a function takes a value sometimes, but does not absolutely need it. @@ -33,8 +37,12 @@ sometimes, but does not absolutely need it. , age : Maybe Int } - tom = { name = "Tom", age = Just 42 } - sue = { name = "Sue", age = Nothing } + tom = + { name = "Tom", age = Just 42 } + + sue = + { name = "Sue", age = Nothing } + -} type Maybe a = Just a @@ -42,147 +50,159 @@ type Maybe a {-| Provide a default value, turning an optional value into a normal -value. This comes in handy when paired with functions like +value. This comes in handy when paired with functions like [`Dict.get`](Dict#get) which gives back a `Maybe`. - withDefault 100 (Just 42) -- 42 - withDefault 100 Nothing -- 100 + withDefault 100 (Just 42) -- 42 - withDefault "unknown" (Dict.get "Tom" Dict.empty) -- "unknown" + withDefault 100 Nothing -- 100 + + withDefault "unknown" (Dict.get "Tom" Dict.empty) -- "unknown" **Note:** This can be overused! Many cases are better handled by a `case` expression. And if you end up using `withDefault` a lot, it can be a good sign that a [custom type][ct] will clean your code up quite a bit! [ct]: https://guide.elm-lang.org/types/custom_types.html + -} withDefault : a -> Maybe a -> a withDefault default maybe = case maybe of - Just value -> value - Nothing -> default + Just value -> + value + + Nothing -> + default {-| Transform a `Maybe` value with a given function: map sqrt (Just 9) == Just 3 - map sqrt Nothing == Nothing + + map sqrt Nothing == Nothing map sqrt (String.toFloat "9") == Just 3 + map sqrt (String.toFloat "x") == Nothing -} map : (a -> b) -> Maybe a -> Maybe b map f maybe = - case maybe of - Just value -> - Just (f value) + case maybe of + Just value -> + Just (f value) - Nothing -> - Nothing + Nothing -> + Nothing {-| Apply a function if all the arguments are `Just` a value. map2 (+) (Just 3) (Just 4) == Just 7 + map2 (+) (Just 3) Nothing == Nothing + map2 (+) Nothing (Just 4) == Nothing map2 (+) (String.toInt "1") (String.toInt "123") == Just 124 + map2 (+) (String.toInt "x") (String.toInt "123") == Nothing + map2 (+) (String.toInt "1") (String.toInt "1.3") == Nothing + -} map2 : (a -> b -> value) -> Maybe a -> Maybe b -> Maybe value map2 func ma mb = - case ma of - Nothing -> - Nothing - - Just a -> - case mb of + case ma of Nothing -> - Nothing + Nothing + + Just a -> + case mb of + Nothing -> + Nothing - Just b -> - Just (func a b) + Just b -> + Just (func a b) -{-|-} +{-| -} map3 : (a -> b -> c -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe value map3 func ma mb mc = - case ma of - Nothing -> - Nothing - - Just a -> - case mb of + case ma of Nothing -> - Nothing + Nothing - Just b -> - case mc of - Nothing -> - Nothing + Just a -> + case mb of + Nothing -> + Nothing + + Just b -> + case mc of + Nothing -> + Nothing - Just c -> - Just (func a b c) + Just c -> + Just (func a b c) -{-|-} +{-| -} map4 : (a -> b -> c -> d -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe value map4 func ma mb mc md = - case ma of - Nothing -> - Nothing - - Just a -> - case mb of + case ma of Nothing -> - Nothing - - Just b -> - case mc of - Nothing -> - Nothing + Nothing - Just c -> - case md of + Just a -> + case mb of Nothing -> - Nothing + Nothing + + Just b -> + case mc of + Nothing -> + Nothing - Just d -> - Just (func a b c d) + Just c -> + case md of + Nothing -> + Nothing + Just d -> + Just (func a b c d) -{-|-} + +{-| -} map5 : (a -> b -> c -> d -> e -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe e -> Maybe value map5 func ma mb mc md me = - case ma of - Nothing -> - Nothing - - Just a -> - case mb of + case ma of Nothing -> - Nothing - - Just b -> - case mc of - Nothing -> - Nothing + Nothing - Just c -> - case md of + Just a -> + case mb of Nothing -> - Nothing + Nothing + + Just b -> + case mc of + Nothing -> + Nothing + + Just c -> + case md of + Nothing -> + Nothing - Just d -> - case me of - Nothing -> - Nothing + Just d -> + case me of + Nothing -> + Nothing - Just e -> - Just (func a b c d e) + Just e -> + Just (func a b c d e) {-| Chain together many computations that may fail. It is helpful to see its @@ -203,12 +223,13 @@ example, say you need to parse some user input as a month: parseMonth : String -> Maybe Int parseMonth userInput = String.toInt userInput - |> andThen toValidMonth + |> andThen toValidMonth toValidMonth : Int -> Maybe Int toValidMonth month = if 1 <= month && month <= 12 then Just month + else Nothing @@ -216,6 +237,7 @@ In the `parseMonth` function, if `String.toInt` produces `Nothing` (because the `userInput` was not an integer) this entire chain of operations will short-circuit and result in `Nothing`. If `toValidMonth` results in `Nothing`, again the chain of computations will result in `Nothing`. + -} andThen : (a -> Maybe b) -> Maybe a -> Maybe b andThen callback maybeValue = @@ -235,19 +257,19 @@ andThen callback maybeValue = isJust : Maybe a -> Bool isJust maybe = - case maybe of - Just _ -> - True + case maybe of + Just _ -> + True - Nothing -> - False + Nothing -> + False destruct : b -> (a -> b) -> Maybe a -> b destruct default func maybe = - case maybe of - Just a -> - func a + case maybe of + Just a -> + func a - Nothing -> - default + Nothing -> + default diff --git a/src/Platform.elm b/src/Platform.elm index aced3829..72c4c9d3 100644 --- a/src/Platform.elm +++ b/src/Platform.elm @@ -1,35 +1,83 @@ module Platform exposing - ( Program, worker - , Task, ProcessId - , Router, sendToApp, sendToSelf - ) + ( Program, worker + , Task, ProcessId + , Router, sendToApp, sendToSelf + ) {-| + # Programs + @docs Program, worker + # Platform Internals + ## Tasks and Processes + @docs Task, ProcessId + ## Effect Manager Helpers -An extremely tiny portion of library authors should ever write effect managers. -Fundamentally, Elm needs maybe 10 of them total. I get that people are smart, -curious, etc. but that is not a substitute for a legitimate reason to make an -effect manager. Do you have an *organic need* this fills? Or are you just -curious? Public discussions of your explorations should be framed accordingly. +Effect managers are dead (long live the effect managers). Conseqently you can +**never** get access to a Router, and thus never call `sendToApp` or +`sendToSelf`. If you do not believe that you can _really_ never do this, have a +look at the definitions. We keep them around for now to keep `elm diff` happy. @docs Router, sendToApp, sendToSelf + -} -import Basics exposing (Never) +import Basics exposing (..) +import Dict exposing (Dict) +import Elm.Kernel.Basics import Elm.Kernel.Platform -import Elm.Kernel.Scheduler +import Json.Decode exposing (Decoder) +import Json.Encode as Encode +import List exposing ((::)) +import Maybe exposing (Maybe(..)) import Platform.Cmd exposing (Cmd) +import Platform.Raw.Channel as Channel +import Platform.Raw.Impure as Impure +import Platform.Raw.Scheduler as RawScheduler +import Platform.Raw.Sub as RawSub +import Platform.Raw.Task as RawTask import Platform.Sub exposing (Sub) +import Result exposing (Result(..)) +import String exposing (String) +import Tuple + + + +-- DEFINTIONS TO BE USED BY KERNEL CODE + + +{-| Kernel code relies on this this type alias. Must be kept consistant with +code in Elm/Kernel/Platform.js. +-} +type alias InitializeHelperFunctions model appMsg = + { stepperBuilder : ImpureSendToApp appMsg -> model -> appMsg -> UpdateMetadata -> () + , setupEffectsChannel : + ImpureSendToApp appMsg -> Channel.Sender (AppMsgPayload appMsg) + , dispatchEffects : + Cmd appMsg + -> Sub appMsg + -> Channel.Sender (AppMsgPayload appMsg) + -> ( Impure.Function (ImpureSendToApp appMsg) (), RawTask.Task () ) + } + + +{-| Kernel code relies on this definitions type and on the behaviour of these functions. +-} +initializeHelperFunctions : InitializeHelperFunctions model msg +initializeHelperFunctions = + { stepperBuilder = \_ _ -> \_ _ -> () + , dispatchEffects = dispatchEffects + , setupEffectsChannel = setupEffectsChannel + } @@ -39,10 +87,21 @@ import Platform.Sub exposing (Sub) {-| A `Program` describes an Elm program! How does it react to input? Does it show anything on screen? Etc. -} -type Program flags model msg = Program +type Program flags model msg + = Program -{-| Create a [headless][] program with no user interface. +{-| This is the actual type of a Program. This is the value that will be called +by javascript so it **must** be this type. +-} +type alias ActualProgram flags = + Decoder flags + -> DebugMetadata + -> RawJsObject + -> RawJsObject + + +{-| Create a [headless] program with no user interface. This is great if you want to use Elm as the “brain” for something else. For example, you could send messages out ports to modify the DOM, but do @@ -53,7 +112,7 @@ all the complex logic in Elm. Initializing a headless program from JavaScript looks like this: ```javascript -var app = Elm.MyThing.init(); +const app = Elm.MyThing.init(); ``` If you _do_ want to control the user interface in Elm, the [`Browser`][browser] @@ -61,15 +120,22 @@ module has a few ways to create that kind of `Program` instead! [headless]: https://en.wikipedia.org/wiki/Headless_software [browser]: /packages/elm/browser/latest/Browser + -} -worker - : { init : flags -> ( model, Cmd msg ) +worker : + { init : flags -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) , subscriptions : model -> Sub msg } - -> Program flags model msg -worker = - Elm.Kernel.Platform.worker + -> Program flags model msg +worker impl = + makeProgram + (\flagsDecoder _ args -> + initialize + flagsDecoder + args + impl + ) @@ -80,14 +146,16 @@ worker = information on this. It is only defined here because it is a platform primitive. -} -type Task err ok = Task +type Task err ok + = Task (RawTask.Task (Result err ok)) {-| Head over to the documentation for the [`Process`](Process) module for information on this. It is only defined here because it is a platform primitive. -} -type ProcessId = ProcessId +type ProcessId + = ProcessId RawScheduler.ProcessId @@ -97,16 +165,16 @@ type ProcessId = ProcessId {-| An effect manager has access to a “router” that routes messages between the main app and your individual effect manager. -} -type Router appMsg selfMsg = - Router +type Router appMsg selfMsg + = Router Never {-| Send the router a message for the main loop of your app. This message will be handled by the overall `update` function, just like events from `Html`. -} sendToApp : Router msg a -> msg -> Task x () -sendToApp = - Elm.Kernel.Platform.sendToApp +sendToApp (Router router) = + never router {-| Send the router a message for your effect manager. This message will @@ -114,7 +182,190 @@ be routed to the `onSelfMsg` function, where you can update the state of your effect manager as necessary. As an example, the effect manager for web sockets + -} sendToSelf : Router a msg -> msg -> Task x () -sendToSelf = - Elm.Kernel.Platform.sendToSelf +sendToSelf (Router router) = + never router + + + +-- HELPERS -- + + +{-| Multiple channels at play here and type fudging means the compiler cannot +always help us if we get confused so be careful! + +The channel who's sender we return is a runtime specific channel, the thunk +returned by dispatchEffects will use the sender to notify this function that we +have command and/or subscriptions to process. + +Each command is a `Platform.Task Never (Maybe msg)`. If the Task resolves with +`Just something` we must send that `something` to the app. + +Each sub is a tuple `( RawSub.Id, RawSub.HiddenConvertedSubType -> msg )` we +can collect these id's and functions and pass them to `resetSubscriptions`. + +-} +setupEffectsChannel : ImpureSendToApp appMsg -> Channel.Sender (AppMsgPayload appMsg) +setupEffectsChannel sendToApp2 = + let + dispatchChannel : Channel.Channel (AppMsgPayload appMsg) + dispatchChannel = + Channel.rawUnbounded () + + receiveMsg : AppMsgPayload appMsg -> RawTask.Task () + receiveMsg cmds = + let + cmdTask = + cmds + |> List.map (\(Task t) -> t) + |> List.map + (RawTask.map + (\r -> + case r of + Ok (Just msg) -> + Impure.unwrapFunction (sendToApp2 msg) AsyncUpdate + + Ok Nothing -> + () + + Err err -> + never err + ) + ) + |> List.map RawScheduler.spawn + |> List.foldr + (\curr accTask -> + RawTask.andThen + (\acc -> + RawTask.map + (\id -> id :: acc) + curr + ) + accTask + ) + (RawTask.Value []) + |> RawTask.andThen RawScheduler.batch + in + cmdTask + |> RawTask.map (\_ -> ()) + + dispatchTask : () -> RawTask.Task () + dispatchTask () = + Tuple.second dispatchChannel + |> Channel.recv receiveMsg + |> RawTask.andThen dispatchTask + + _ = + RawScheduler.rawSpawn (RawTask.andThen dispatchTask (RawTask.sleep 0)) + in + Tuple.first dispatchChannel + + +dispatchEffects : + Cmd appMsg + -> Sub appMsg + -> Channel.Sender (AppMsgPayload appMsg) + -> ( Impure.Function (ImpureSendToApp appMsg) (), RawTask.Task () ) +dispatchEffects cmdBag subBag = + let + cmds = + unwrapCmd cmdBag + + subs = + unwrapSub subBag + in + \channel -> + let + -- Impure functin that resets and re-registers all subscriptions. + updateSubs = + Impure.propagate + (\sendToAppFunc -> + let + thunks = + List.map + (\( id, tagger ) -> + ( id + , Impure.propagate + (\v -> sendToAppFunc (tagger v)) + AsyncUpdate + ) + ) + subs + in + Impure.toThunk resetSubscriptions thunks + ) + () + in + ( updateSubs + , Channel.send + channel + cmds + ) + + +type alias ImpureSendToApp msg = + msg -> Impure.Function UpdateMetadata () + + +type alias DebugMetadata = + Encode.Value + + +{-| AsyncUpdate is default I think + +TODO(harry) understand this by reading source of VirtualDom + +-} +type UpdateMetadata + = SyncUpdate + | AsyncUpdate + + +type alias AppMsgPayload appMsg = + List (Task Never (Maybe appMsg)) + + +type RawJsObject + = RawJsObject RawJsObject + + +type alias Impl flags model msg = + { init : flags -> ( model, Cmd msg ) + , update : msg -> model -> ( model, Cmd msg ) + , subscriptions : model -> Sub msg + } + + + +-- kernel -- + + +initialize : + Decoder flags + -> RawJsObject + -> Impl flags model msg + -> RawJsObject +initialize = + Elm.Kernel.Platform.initialize + + +makeProgram : ActualProgram flags -> Program flags model msg +makeProgram = + Elm.Kernel.Basics.fudgeType + + +unwrapCmd : Cmd a -> List (Task Never (Maybe msg)) +unwrapCmd = + Elm.Kernel.Basics.unwrapTypeWrapper + + +unwrapSub : Sub a -> List ( RawSub.Id, RawSub.HiddenConvertedSubType -> msg ) +unwrapSub = + Elm.Kernel.Basics.unwrapTypeWrapper + + +resetSubscriptions : Impure.Function (List ( RawSub.Id, Impure.Function RawSub.HiddenConvertedSubType () )) () +resetSubscriptions = + Elm.Kernel.Platform.resetSubscriptions diff --git a/src/Platform/Cmd.elm b/src/Platform/Cmd.elm index 8ee7683b..c07fcb86 100644 --- a/src/Platform/Cmd.elm +++ b/src/Platform/Cmd.elm @@ -1,14 +1,12 @@ module Platform.Cmd exposing - ( Cmd - , none - , batch - , map - ) + ( Cmd, none, batch + , map + ) {-| > **Note:** Elm has **managed effects**, meaning that things like HTTP -> requests or writing to disk are all treated as *data* in Elm. When this +> requests or writing to disk are all treated as _data_ in Elm. When this > data is given to the Elm runtime system, it can do some “query optimization” > before actually performing the effect. Perhaps unexpectedly, this managed > effects idea is the heart of why Elm is so nice for testing, reuse, @@ -16,15 +14,25 @@ module Platform.Cmd exposing > > Elm has two kinds of managed effects: commands and subscriptions. + # Commands + @docs Cmd, none, batch + # Fancy Stuff + @docs map -} +import Basics exposing (..) +import Elm.Kernel.Basics import Elm.Kernel.Platform +import List +import Maybe exposing (Maybe) +import Platform.Raw.Task as RawTask +import Result exposing (Result) @@ -43,16 +51,17 @@ messages that will come back into your application. ever, commands will make more sense as you work through [the Elm Architecture Tutorial](https://guide.elm-lang.org/architecture/) and see how they fit into a real application! + -} -type Cmd msg = Cmd +type Cmd msg + = Cmd (List (Task Never (Maybe msg))) {-| Tell the runtime that there are no commands. - -} none : Cmd msg none = - batch [] + batch [] {-| When you need the runtime system to perform a couple commands, you @@ -62,10 +71,13 @@ no ordering guarantees about the results. **Note:** `Cmd.none` and `Cmd.batch [ Cmd.none, Cmd.none ]` and `Cmd.batch []` all do the same thing. + -} batch : List (Cmd msg) -> Cmd msg batch = - Elm.Kernel.Platform.batch + List.map (\(Cmd cmd) -> cmd) + >> List.concat + >> Cmd @@ -76,12 +88,34 @@ batch = Very similar to [`Html.map`](/packages/elm/html/latest/Html#map). This is very rarely useful in well-structured Elm code, so definitely read the -section on [structure][] in the guide before reaching for this! +section on [structure] in the guide before reaching for this! [structure]: https://guide.elm-lang.org/webapps/structure.html + -} map : (a -> msg) -> Cmd a -> Cmd msg -map = - Elm.Kernel.Platform.map +map fn (Cmd data) = + data + |> List.map (getCmdMapper fn) + |> Cmd +getCmdMapper : (a -> msg) -> Task Never (Maybe a) -> Task Never (Maybe msg) +getCmdMapper tagger task = + wrapTask (RawTask.map (Result.map (Maybe.map tagger)) (unwrapTask task)) + + +wrapTask : RawTask.Task (Result e o) -> Task e o +wrapTask = + Elm.Kernel.Platform.wrapTask + + +unwrapTask : Task e o -> RawTask.Task (Result e o) +unwrapTask = + Elm.Kernel.Basics.unwrapTypeWrapper + + +{-| MUST mirror the definition in Platform +-} +type Task e o + = Task (RawTask.Task (Result e o)) diff --git a/src/Platform/Raw/Channel.elm b/src/Platform/Raw/Channel.elm new file mode 100644 index 00000000..33d845e0 --- /dev/null +++ b/src/Platform/Raw/Channel.elm @@ -0,0 +1,78 @@ +module Platform.Raw.Channel exposing (Channel, Receiver, Sender, rawSend, rawUnbounded, recv, send, tryRecv, unbounded) + +import Basics exposing (..) +import Debug +import Elm.Kernel.Channel +import Maybe exposing (Maybe(..)) +import Platform.Raw.Impure as Impure +import Platform.Raw.Scheduler as RawScheduler +import Platform.Raw.Task as RawTask +import Tuple + + +type Sender msg + = Sender + + +type Receiver msg + = Receiver + + +type alias Channel msg = + ( Sender msg, Receiver msg ) + + +{-| -} +recv : (msg -> RawTask.Task a) -> Receiver msg -> RawTask.Task a +recv tagger chl = + RawTask.AsyncAction + { then_ = + \doneCallback -> + rawRecv chl (\msg -> doneCallback (tagger msg)) + } + + +tryRecv : (Maybe msg -> RawTask.Task a) -> Receiver msg -> RawTask.Task a +tryRecv tagger chl = + RawTask.andThen + tagger + (RawTask.execImpure (Impure.function (\() -> rawTryRecv chl))) + + +{-| NON PURE! + +Send a message to a channel. If there are tasks waiting for a message then one +will complete during this function call. If there are no tasks waiting the +message will be added to the channel's queue. + +-} +rawSend : Sender msg -> msg -> () +rawSend = + Elm.Kernel.Channel.rawSend + + +{-| Create a task, if run, will send a message to a channel. +-} +send : Sender msg -> msg -> RawTask.Task () +send channelId msg = + RawTask.execImpure (Impure.function (\() -> rawSend channelId msg)) + + +rawUnbounded : () -> ( Sender msg, Receiver msg ) +rawUnbounded = + Elm.Kernel.Channel.rawUnbounded + + +unbounded : RawTask.Task ( Sender msg, Receiver msg ) +unbounded = + RawTask.execImpure (Impure.function rawUnbounded) + + +rawRecv : Receiver msg -> (msg -> ()) -> RawTask.TryAbortAction +rawRecv = + Elm.Kernel.Channel.rawRecv + + +rawTryRecv : Receiver msg -> Maybe msg +rawTryRecv = + Elm.Kernel.Channel.rawTryRecv diff --git a/src/Platform/Raw/Impure.elm b/src/Platform/Raw/Impure.elm new file mode 100644 index 00000000..34a98a83 --- /dev/null +++ b/src/Platform/Raw/Impure.elm @@ -0,0 +1,95 @@ +module Platform.Raw.Impure exposing (Function, andThen, function, map, propagate, run, toThunk, unwrapFunction) + +{-| This module contains an abstaction for functions that **do things** when +they are run. The functions in this module are constrained to take one argument. + +Why can we not use Task's for this, given that this is _exactly_ what they are +intended for. Well, two reasons + +1. Sometimes we need a guarantee that the function will be run exactly when we + need to run. Task are always enqueued; they are only run after stepping + through all the previous Tasks in the queue. Sometimes, this is not + acceptable, for instance when updating the listeners for a subscription + effect. + +2. We need to use impure functions to run Tasks. The + `Platform.Raw.Scheduler.enqueue` function takes a Task, adds it to the + scheduler queue and, if the scheduler is not currently stepping tasks (i.e. + this is not a reentrant call to `Platform.Raw.Scheduler.enqueue`), starts + stepping. This function is impure. However, if we represented it as a Task + we would have an infinite loop! + +Hopefully, use of this module can be reduced to a couple of key places and +maybe even inlined into the scheduler is that is the only place that uses it. +Hopefully, it will help us move all effectful functions out of elm. + +-} + +import Basics exposing ((|>)) +import Elm.Kernel.Basics + + +{-| Is actually just a function. We type fudge so that js can treat impure +functions identically to normal functions. +-} +type Function a b + = Function + + +function : (a -> b) -> Function a b +function = + Elm.Kernel.Basics.fudgeType + + +andThen : Function b c -> Function a b -> Function a c +andThen ip2 ip1 = + function + (\a -> + let + b = + unwrapFunction ip1 a + in + unwrapFunction ip2 b + ) + + +map : (b -> c) -> Function a b -> Function a c +map mapper ip = + function + (\a -> + let + b = + unwrapFunction ip a + in + mapper b + ) + + +unwrapFunction : Function a b -> (a -> b) +unwrapFunction = + Elm.Kernel.Basics.fudgeType + + +run : a -> Function a b -> b +run x f = + unwrapFunction f x + + +{-| Given an (pure) function that creates an impure function from some input +and the input that the created impure function needs create a new impure +function. +-} +propagate : (a -> Function b c) -> b -> Function a c +propagate f b = + function + (\a -> + unwrapFunction + (f a) + b + ) + + +toThunk : Function a b -> a -> Function () b +toThunk f x = + function (\() -> x) + |> andThen f diff --git a/src/Platform/Raw/Scheduler.elm b/src/Platform/Raw/Scheduler.elm new file mode 100644 index 00000000..ceec73cf --- /dev/null +++ b/src/Platform/Raw/Scheduler.elm @@ -0,0 +1,152 @@ +module Platform.Raw.Scheduler exposing (ProcessId, UniqueId, batch, getGuid, kill, rawSpawn, spawn) + +{-| This module contains the low level logic for processes. A process is a +unique id used to execute tasks. +-} + +import Basics exposing (..) +import Debug +import Elm.Kernel.Scheduler +import List +import Maybe exposing (Maybe(..)) +import Platform.Raw.Impure as Impure +import Platform.Raw.Task as RawTask + + +type ProcessState state + = Ready (RawTask.Task state) + | Running RawTask.TryAbortAction + + +type ProcessId + = ProcessId { id : UniqueId } + + +type UniqueId + = UniqueId UniqueId + + +{-| NON PURE! + +Will create, register and **enqueue** a new process. + +-} +rawSpawn : RawTask.Task a -> ProcessId +rawSpawn initTask = + enqueue + (ProcessId { id = getGuid () }) + initTask + + +{-| Create a task that spawns a processes. +-} +spawn : RawTask.Task a -> RawTask.Task ProcessId +spawn task = + RawTask.execImpure (Impure.function (\() -> rawSpawn task)) + + +{-| Create a task kills a process. + +To kill a process we should try to abort any ongoing async action. +We only allow processes that cannot receive messages to be killed, we will +on the offical core library to lead the way regarding processes that can +receive values. + +-} +kill : ProcessId -> RawTask.Task () +kill processId = + RawTask.execImpure (Impure.function (\() -> rawKill processId)) + + +batch : List ProcessId -> RawTask.Task ProcessId +batch ids = + spawn + (RawTask.AsyncAction + { then_ = + \doneCallback -> + let + () = + doneCallback (spawn (RawTask.Value ())) + in + \() -> + List.foldr + (\id () -> rawKill id) + () + ids + } + ) + + +{-| NON PURE! + +Add a `Process` to the run queue and, unless this is a reenterant +call, drain the run queue but stepping all processes. +Returns the enqueued `Process`. + +-} +enqueue : ProcessId -> RawTask.Task state -> ProcessId +enqueue = + enqueueWithStepper stepper + + + +-- Helper functions -- + + +{-| NON PURE! (calls enqueue) + +This function **must** return a process with the **same ID** as +the process it is passed as an argument + +-} +stepper : ProcessId -> RawTask.Task state -> ProcessState state +stepper processId root = + case root of + RawTask.Value val -> + Ready (RawTask.Value val) + + RawTask.AsyncAction doEffect -> + Running + (doEffect.then_ + (\newRoot -> + let + (ProcessId _) = + enqueue processId newRoot + in + () + ) + ) + + +{-| NON PURE! +-} +rawKill : ProcessId -> () +rawKill id = + case getProcessState id of + Just (Running killer) -> + killer () + + Just (Ready _) -> + () + + Nothing -> + () + + + +-- Kernel function redefinitons -- + + +getGuid : () -> UniqueId +getGuid = + Elm.Kernel.Scheduler.getGuid + + +getProcessState : ProcessId -> Maybe (ProcessState state) +getProcessState = + Elm.Kernel.Scheduler.getProcessState + + +enqueueWithStepper : (ProcessId -> RawTask.Task state -> ProcessState state) -> ProcessId -> RawTask.Task state -> ProcessId +enqueueWithStepper = + Elm.Kernel.Scheduler.enqueueWithStepper diff --git a/src/Platform/Raw/Sub.elm b/src/Platform/Raw/Sub.elm new file mode 100644 index 00000000..44cea965 --- /dev/null +++ b/src/Platform/Raw/Sub.elm @@ -0,0 +1,17 @@ +module Platform.Raw.Sub exposing + ( HiddenConvertedSubType + , Id + , RawSub + ) + + +type alias RawSub msg = + List ( Id, HiddenConvertedSubType -> msg ) + + +type Id + = Id Id + + +type HiddenConvertedSubType + = HiddenConvertedSubType HiddenConvertedSubType diff --git a/src/Platform/Raw/Task.elm b/src/Platform/Raw/Task.elm new file mode 100644 index 00000000..6e19253b --- /dev/null +++ b/src/Platform/Raw/Task.elm @@ -0,0 +1,71 @@ +module Platform.Raw.Task exposing (Future, Task(..), TryAbortAction, andThen, execImpure, map, sleep) + +{-| This module contains the low level logic for tasks. A +`Task` is a sequence of actions (either syncronous or asyncronous) that will be +run in order by the runtime. +-} + +import Basics exposing (..) +import Debug +import Elm.Kernel.Scheduler +import Maybe exposing (Maybe(..)) +import Platform.Raw.Impure as Impure + + +type Task val + = Value val + | AsyncAction (Future val) + + +type alias Future a = + { then_ : (Task a -> ()) -> TryAbortAction } + + +type alias TryAbortAction = + () -> () + + +andThen : (a -> Task b) -> Task a -> Task b +andThen func task = + case task of + Value val -> + func val + + AsyncAction fut -> + AsyncAction + { then_ = + \callback -> + fut.then_ (\newTask -> callback (andThen func newTask)) + } + + +{-| Create a task that executes a non pure function +-} +execImpure : Impure.Function () a -> Task a +execImpure func = + AsyncAction + { then_ = + \callback -> + let + () = + callback (Value (Impure.unwrapFunction func ())) + in + \() -> () + } + + +map : (a -> b) -> Task a -> Task b +map func = + andThen (\x -> Value (func x)) + + +{-| Create a task that sleeps for `time` milliseconds +-} +sleep : Float -> Task () +sleep time = + AsyncAction (delay time (Value ())) + + +delay : Float -> Task val -> Future val +delay = + Elm.Kernel.Scheduler.delay diff --git a/src/Platform/Scheduler.elm b/src/Platform/Scheduler.elm new file mode 100644 index 00000000..33282ae3 --- /dev/null +++ b/src/Platform/Scheduler.elm @@ -0,0 +1,211 @@ +module Platform.Scheduler exposing (ProcessId, TryAbortAction, andThen, binding, fail, kill, map, onError, rawSpawn, sleep, spawn, succeed, unwrapTask, wrapTask) + +{-| The definition of the `Task` and `ProcessId` really belong in the +`Platform.RawScheduler` module for two reasons. + +1. Tasks and processes are created, run and managed by the scheduler. It makes + semantic sense for the scheduler to also contain the type defintion. +2. The `Platform.RawScheduler` module is private to `elm/core`, therefore other + core functions could access the type constructurs if they were contained + within the module. `Platform` is a public module and therefore we cannot + expose the type constructures to core functions without also exposing them + to user functions. + +However, for two reasons they must instead be defined in the `Platform` module. + +1. The official elm compiler regards changing a type definition to a type alias + to be a MAJOR change. Moving the type definition out of `Platform` and + replacing it with a type alias would count as a MAJOR change. As one of my + aims for this alternative elm/core library was no MAJOR (or even MINOR + changes) according to elm diff. Moving `Task` and `ProcessId` out of + `Platform` would defeat this aim. +2. More seriously, there are hard coded checks in the elm compiler ensuring + effect modules are valid. The compiler checks that the module defines the + needed functions (for example `onEffects`, `onSelfMsg`, etc) but it also + checks that the type signatures of these functions are correct. If we + replace the type definitions in `Platform` by type aliases all these checks + start to fail. For example, the compile checks that `Task.onEffects` returns + a `Platform.Task` but actually it returns `Platform.RawScheduler.Task` (via + a type alias in `Platform` but type aliases are transparent to the compiler + at this point during compiliation). + +In an attempt to get the best of both worlds we define `Task` and `ProcessId` +types in `Platform.RawScheduler` and then in `Platform` we define + + type Task error value + = Task (Platform.RawScheduler.Task (Result error value)) + +This module provides functions that work with `Platform.Task`s and +`Platform.ProcessId`s. However, as the type constructors are not exposed (if +they were the user code could use the runtime internals), this module resorts +to some kernel code magic to wrap and unwrap `Task`s and `Process`s. + +-} + +import Basics exposing (..) +import Elm.Kernel.Basics +import Elm.Kernel.Platform +import Platform +import Platform.Raw.Scheduler as RawScheduler +import Platform.Raw.Task as RawTask +import Result exposing (Result(..)) + + +type alias ProcessId = + RawScheduler.ProcessId + + +type alias Future err ok = + { then_ : (Platform.Task err ok -> ()) -> TryAbortAction } + + +type alias TryAbortAction = + RawTask.TryAbortAction + + +succeed : ok -> Platform.Task never ok +succeed val = + wrapTask (RawTask.Value (Ok val)) + + +fail : err -> Platform.Task err never +fail e = + wrapTask (RawTask.Value (Err e)) + + +binding : Future err ok -> Platform.Task err ok +binding fut = + wrapTask + (RawTask.AsyncAction + { then_ = \doneCallback -> fut.then_ (taskFn (\task -> doneCallback task)) } + ) + + +{-| Create a task that executes a non pure function +-} +execImpure : (() -> a) -> Platform.Task Never a +execImpure func = + binding + { then_ = + \doneCallback -> + let + () = + doneCallback (succeed (func ())) + in + \() -> () + } + + +andThen : (ok1 -> Platform.Task err ok2) -> Platform.Task err ok1 -> Platform.Task err ok2 +andThen func = + wrapTaskFn + (\task -> + RawTask.andThen + (\r -> + case r of + Ok val -> + unwrapTask (func val) + + Err e -> + RawTask.Value (Err e) + ) + task + ) + + +map : (ok1 -> ok2) -> Platform.Task err ok1 -> Platform.Task err ok2 +map func = + andThen (func >> succeed) + + +onError : (err1 -> Platform.Task err2 ok) -> Platform.Task err1 ok -> Platform.Task err2 ok +onError func = + wrapTaskFn + (\task -> + RawTask.andThen + (\r -> + case r of + Ok val -> + RawTask.Value (Ok val) + + Err e -> + unwrapTask (func e) + ) + task + ) + + +{-| Create a task that, when run, will spawn a process. + +There is no way to send messages to a process spawned in this way. + +-} +spawn : Platform.Task err ok -> Platform.Task never Platform.ProcessId +spawn = + wrapTaskFn + (\task -> + RawTask.map + (\proc -> Ok (wrapProcessId proc)) + (RawScheduler.spawn task) + ) + + +{-| This is provided to make `__Scheduler_rawSpawn` work! + +TODO(harry) remove once code in other `elm/*` packages has been updated. + +-} +rawSpawn : Platform.Task err ok -> Platform.ProcessId +rawSpawn = + taskFn + (\task -> + wrapProcessId (RawScheduler.rawSpawn task) + ) + + +{-| Create a task kills a process. +-} +kill : Platform.ProcessId -> Platform.Task never () +kill processId = + wrapTask (RawTask.map Ok (RawScheduler.kill (unwrapProcessId processId))) + + +{-| Create a task that sleeps for `time` milliseconds +-} +sleep : Float -> Platform.Task x () +sleep time = + wrapTask (RawTask.map Ok (RawTask.sleep time)) + + + +-- wrapping helpers -- + + +wrapTaskFn : (RawTask.Task (Result e1 o1) -> RawTask.Task (Result e2 o2)) -> Platform.Task e1 o1 -> Platform.Task e2 o2 +wrapTaskFn fn task = + wrapTask (taskFn fn task) + + +taskFn : (RawTask.Task (Result e1 o1) -> a) -> Platform.Task e1 o1 -> a +taskFn fn task = + fn (unwrapTask task) + + +wrapTask : RawTask.Task (Result e o) -> Platform.Task e o +wrapTask = + Elm.Kernel.Platform.wrapTask + + +unwrapTask : Platform.Task e o -> RawTask.Task (Result e o) +unwrapTask = + Elm.Kernel.Basics.unwrapTypeWrapper + + +wrapProcessId : ProcessId -> Platform.ProcessId +wrapProcessId = + Elm.Kernel.Platform.wrapProcessId + + +unwrapProcessId : Platform.ProcessId -> ProcessId +unwrapProcessId = + Elm.Kernel.Basics.unwrapTypeWrapper diff --git a/src/Platform/Sub.elm b/src/Platform/Sub.elm index 66f98481..e877d990 100644 --- a/src/Platform/Sub.elm +++ b/src/Platform/Sub.elm @@ -1,14 +1,12 @@ module Platform.Sub exposing - ( Sub - , none - , batch - , map - ) + ( Sub, none, batch + , map + ) {-| > **Note:** Elm has **managed effects**, meaning that things like HTTP -> requests or writing to disk are all treated as *data* in Elm. When this +> requests or writing to disk are all treated as _data_ in Elm. When this > data is given to the Elm runtime system, it can do some “query optimization” > before actually performing the effect. Perhaps unexpectedly, this managed > effects idea is the heart of why Elm is so nice for testing, reuse, @@ -16,14 +14,21 @@ module Platform.Sub exposing > > Elm has two kinds of managed effects: commands and subscriptions. + # Subscriptions + @docs Sub, none, batch + # Fancy Stuff + @docs map + -} -import Elm.Kernel.Platform +import Basics exposing (..) +import List +import Platform.Raw.Sub as RawSub @@ -34,9 +39,9 @@ import Elm.Kernel.Platform interesting happens over there!” So if you want to listen for messages on a web socket, you would tell Elm to create a subscription. If you want to get clock ticks, you would tell Elm to subscribe to that. The cool thing here is that -this means *Elm* manages all the details of subscriptions instead of *you*. -So if a web socket goes down, *you* do not need to manually reconnect with an -exponential backoff strategy, *Elm* does this all for you behind the scenes! +this means _Elm_ manages all the details of subscriptions instead of _you_. +So if a web socket goes down, _you_ do not need to manually reconnect with an +exponential backoff strategy, _Elm_ does this all for you behind the scenes! Every `Sub` specifies (1) which effects you need access to and (2) the type of messages that will come back into your application. @@ -45,15 +50,17 @@ messages that will come back into your application. ever, subscriptions will make more sense as you work through [the Elm Architecture Tutorial](https://guide.elm-lang.org/architecture/) and see how they fit into a real application! + -} -type Sub msg = Sub +type Sub msg + = Sub (RawSub.RawSub msg) {-| Tell the runtime that there are no subscriptions. -} none : Sub msg none = - batch [] + batch [] {-| When you need to subscribe to multiple things, you can create a `batch` of @@ -61,10 +68,13 @@ subscriptions. **Note:** `Sub.none` and `Sub.batch [ Sub.none, Sub.none ]` and `Sub.batch []` all do the same thing. + -} batch : List (Sub msg) -> Sub msg batch = - Elm.Kernel.Platform.batch + List.map (\(Sub sub) -> sub) + >> List.concat + >> Sub @@ -75,10 +85,18 @@ batch = Very similar to [`Html.map`](/packages/elm/html/latest/Html#map). This is very rarely useful in well-structured Elm code, so definitely read the -section on [structure][] in the guide before reaching for this! +section on [structure] in the guide before reaching for this! [structure]: https://guide.elm-lang.org/webapps/structure.html + -} map : (a -> msg) -> Sub a -> Sub msg -map = - Elm.Kernel.Platform.map +map fn (Sub data) = + data + |> List.map (getSubMapper fn) + |> Sub + + +getSubMapper : (a -> msg) -> ( RawSub.Id, RawSub.HiddenConvertedSubType -> a ) -> ( RawSub.Id, RawSub.HiddenConvertedSubType -> msg ) +getSubMapper fn ( id, tagger ) = + ( id, \hcst -> fn (tagger hcst) ) diff --git a/src/Process.elm b/src/Process.elm index 27ca23b5..1b9bfeb0 100644 --- a/src/Process.elm +++ b/src/Process.elm @@ -1,15 +1,13 @@ -module Process exposing - ( Id - , spawn - , sleep - , kill - ) +module Process exposing (Id, spawn, sleep, kill) {-| + # Processes + @docs Id, spawn, sleep, kill + ## Future Plans Right now, this library is pretty sparse. For example, there is no public API @@ -42,12 +40,12 @@ I ask that people bullish on compiling to node.js keep this in mind. I think we can do better than the hopelessly bad concurrency model of node.js, and I hope the Elm community will be supportive of being more ambitious, even if it takes longer. That’s kind of what Elm is all about. + -} -import Basics exposing (Float, Never) -import Elm.Kernel.Scheduler -import Elm.Kernel.Process +import Basics exposing (Float) import Platform +import Platform.Scheduler as Scheduler import Task exposing (Task) @@ -56,15 +54,16 @@ get a bunch of different tasks running in different processes. The Elm runtime will interleave their progress. So if a task is taking too long, we will pause it at an `andThen` and switch over to other stuff. -**Note:** We make a distinction between *concurrency* which means interleaving -different sequences and *parallelism* which means running different +**Note:** We make a distinction between _concurrency_ which means interleaving +different sequences and _parallelism_ which means running different sequences at the exact same time. For example, a [time-sharing system](https://en.wikipedia.org/wiki/Time-sharing) is definitely concurrent, but not necessarily parallel. So even though JS runs within a single OS-level thread, Elm can still run things concurrently. + -} type alias Id = - Platform.ProcessId + Platform.ProcessId {-| Run a task in its own light-weight process. In the following example, @@ -73,15 +72,16 @@ or is just taking a long time, we can hop over to `task2` and do some work there. spawn task1 - |> Task.andThen (\_ -> spawn task2) + |> Task.andThen (\_ -> spawn task2) **Note:** This creates a relatively restricted kind of `Process` because it cannot receive any messages. More flexibility for user-defined processes will come in a later release! + -} spawn : Task x a -> Task y Id spawn = - Elm.Kernel.Scheduler.spawn + Scheduler.spawn {-| Block progress on the current process for the given number of milliseconds. @@ -89,10 +89,11 @@ The JavaScript equivalent of this is [`setTimeout`][setTimeout] which lets you delay work until later. [setTimeout]: https://developer.mozilla.org/en-US/docs/Web/API/WindowTimers/setTimeout + -} sleep : Float -> Task x () sleep = - Elm.Kernel.Process.sleep + Scheduler.sleep {-| Sometimes you `spawn` a process, but later decide it would be a waste to @@ -102,5 +103,4 @@ flight, it will also abort the request. -} kill : Id -> Task x () kill = - Elm.Kernel.Scheduler.kill - + Scheduler.kill diff --git a/src/Random.elm b/src/Random.elm new file mode 100644 index 00000000..db521e21 --- /dev/null +++ b/src/Random.elm @@ -0,0 +1,1018 @@ +module Random exposing + ( Generator, generate + , int, float, uniform, weighted, constant + , pair, list + , map, map2, map3, map4, map5 + , andThen, lazy + , maxInt, minInt + , Seed, step, initialSeed, independentSeed + ) + +{-| This library helps you generate pseudo-random values. + +It is an implementation of [Permuted Congruential Generators][pcg] +by M. E. O'Neil. It is not cryptographically secure. + +[extra]: /packages/elm-community/random-extra/latest +[pcg]: http://www.pcg-random.org/ + + +# Generators + +@docs Generator, generate + + +# Primitives + +@docs int, float, uniform, weighted, constant + + +# Data Structures + +@docs pair, list + + +# Mapping + +@docs map, map2, map3, map4, map5 + + +# Fancy Stuff + +@docs andThen, lazy + + +# Constants + +@docs maxInt, minInt + + +# Generate Values Manually + +@docs Seed, step, initialSeed, independentSeed + +-} + +import Basics exposing (..) +import Bitwise +import List exposing ((::)) +import Maybe exposing (Maybe(..)) +import Platform +import Platform.Cmd exposing (Cmd) +import Platform.Raw.Channel as Channel +import Platform.Raw.Scheduler as RawScheduler +import Platform.Raw.Task as RawTask +import Platform.Scheduler as Scheduler +import Result exposing (Result(..)) +import Task exposing (Task) +import Time +import Tuple + + + +-- PRIMITIVE GENERATORS + + +{-| Generate 32-bit integers in a given range. + + import Random + + singleDigit : Random.Generator Int + singleDigit = + Random.int 0 9 + + closeToZero : Random.Generator Int + closeToZero = + Random.int -5 5 + + anyInt : Random.Generator Int + anyInt = + Random.int Random.minInt Random.maxInt + +This generator _can_ produce values outside of the range [[`minInt`](#minInt), +[`maxInt`](#maxInt)] but sufficient randomness is not guaranteed. + +-} +int : Int -> Int -> Generator Int +int a b = + Generator + (\seed0 -> + let + ( lo, hi ) = + if a < b then + ( a, b ) + + else + ( b, a ) + + range = + hi - lo + 1 + in + -- fast path for power of 2 + if Bitwise.and (range - 1) range == 0 then + ( Bitwise.shiftRightZfBy 0 (Bitwise.and (range - 1) (peel seed0)) + lo, next seed0 ) + + else + let + threshhold = + -- essentially: period % max + Bitwise.shiftRightZfBy 0 (remainderBy range (Bitwise.shiftRightZfBy 0 -range)) + + accountForBias : Seed -> ( Int, Seed ) + accountForBias seed = + let + x = + peel seed + + seedN = + next seed + in + if x < threshhold then + -- in practice this recurses almost never + accountForBias seedN + + else + ( remainderBy range x + lo, seedN ) + in + accountForBias seed0 + ) + + +{-| The underlying algorithm works well in a specific range of integers. +It can generate values outside of that range, but they are “not as random”. + +The `maxInt` that works well is `2147483647`. + +-} +maxInt : Int +maxInt = + 2147483647 + + +{-| The underlying algorithm works well in a specific range of integers. +It can generate values outside of that range, but they are “not as random”. + +The `minInt` that works well is `-2147483648`. + +-} +minInt : Int +minInt = + -2147483648 + + +{-| Generate floats in a given range. + + import Random + + probability : Random.Generator Float + probability = + Random.float 0 1 + +The `probability` generator will produce values between zero and one with +a uniform distribution. Say it produces a value `p`. We can then check if +`p < 0.4` if we want something to happen 40% of the time. + +This becomes very powerful when paired with functions like [`map`](#map) and +[`andThen`](#andThen). Rather than dealing with twenty random float messages +in your `update`, you can build up sophisticated logic in the `Generator` +itself! + +-} +float : Float -> Float -> Generator Float +float a b = + Generator + (\seed0 -> + let + -- Get 64 bits of randomness + seed1 = + next seed0 + + n0 = + peel seed0 + + n1 = + peel seed1 + + -- Get a uniformly distributed IEEE-754 double between 0.0 and 1.0 + hi = + toFloat (Bitwise.and 0x03FFFFFF n0) * 1.0 + + lo = + toFloat (Bitwise.and 0x07FFFFFF n1) * 1.0 + + val = + -- These magic constants are 2^27 and 2^53 + ((hi * 134217728.0) + lo) / 9007199254740992.0 + + -- Scale it into our range + range = + abs (b - a) + + scaled = + val * range + a + in + ( scaled, next seed1 ) + ) + + +{-| Generate the same value every time. + + import Random + + alwaysFour : Random.Generator Int + alwaysFour = + Random.constant 4 + +Think of it as picking from a hat with only one thing in it. It is weird, +but it can be useful with [`elm-community/random-extra`][extra] which has +tons of nice helpers. + +[extra]: /packages/elm-community/random-extra/latest + +-} +constant : a -> Generator a +constant value = + Generator (\seed -> ( value, seed )) + + + +-- DATA STRUCTURES + + +{-| Generate a pair of random values. A common use of this might be to generate +a point in a certain 2D space: + + import Random + + randomPoint : Random.Generator ( Float, Float ) + randomPoint = + Random.pair (Random.float -200 200) (Random.float -100 100) + +Maybe you are doing an animation with SVG and want to randomly generate some +entities? + +-} +pair : Generator a -> Generator b -> Generator ( a, b ) +pair genA genB = + map2 (\a b -> ( a, b )) genA genB + + +{-| Generate a list of random values. + + import Random + + tenFractions : Random.Generator (List Float) + tenFractions = + Random.list 10 (Random.float 0 1) + + fiveGrades : Random.Generator (List Int) + fiveGrades = + Random.list 5 (int 0 100) + +If you want to generate a list with a random length, you need to use +[`andThen`](#andThen) like this: + + fiveToTenDigits : Random.Generator (List Int) + fiveToTenDigits = + Random.int 5 10 + |> Random.andThen (\len -> Random.list len (Random.int 0 9)) + +This generator gets a random integer between five and ten **and then** +uses that to generate a random list of digits. + +-} +list : Int -> Generator a -> Generator (List a) +list n (Generator gen) = + Generator + (\seed -> + listHelp [] n gen seed + ) + + +listHelp : List a -> Int -> (Seed -> ( a, Seed )) -> Seed -> ( List a, Seed ) +listHelp revList n gen seed = + if n < 1 then + ( revList, seed ) + + else + let + ( value, newSeed ) = + gen seed + in + listHelp (value :: revList) (n - 1) gen newSeed + + + +-- ENUMERATIONS + + +{-| Generate values with equal probability. Say we want a random suit for some +cards: + + import Random + + type Suit + = Diamond + | Club + | Heart + | Spade + + suit : Random.Generator Suit + suit = + Random.uniform Diamond [ Club, Heart, Spade ] + +That generator produces all `Suit` values with equal probability, 25% each. + +**Note:** Why not have `uniform : List a -> Generator a` as the API? It looks +a little prettier in code, but it leads to an awkward question. What do you do +with `uniform []`? How can it produce an `Int` or `Float`? The current API +guarantees that we always have _at least_ one value, so we never run into that +question! + +-} +uniform : a -> List a -> Generator a +uniform value valueList = + weighted (addOne value) (List.map addOne valueList) + + +addOne : a -> ( Float, a ) +addOne value = + ( 1, value ) + + +{-| Generate values with a _weighted_ probability. Say we want to simulate a +[loaded die](https://en.wikipedia.org/wiki/Dice#Loaded_dice) that lands +on ⚄ and ⚅ more often than the other faces: + + import Random + + type Face + = One + | Two + | Three + | Four + | Five + | Six + + roll : Random.Generator Face + roll = + Random.weighted + ( 10, One ) + [ ( 10, Two ) + , ( 10, Three ) + , ( 10, Four ) + , ( 20, Five ) + , ( 40, Six ) + ] + +So there is a 40% chance of getting `Six`, a 20% chance of getting `Five`, and +then a 10% chance for each of the remaining faces. + +**Note:** I made the weights add up to 100, but that is not necessary. I always +add up your weights into a `total`, and from there, the probablity of each case +is `weight / total`. Negative weights do not really make sense, so I just flip +them to be positive. + +-} +weighted : ( Float, a ) -> List ( Float, a ) -> Generator a +weighted first others = + let + normalize ( weight, _ ) = + abs weight + + total = + normalize first + List.sum (List.map normalize others) + in + map (getByWeight first others) (float 0 total) + + +getByWeight : ( Float, a ) -> List ( Float, a ) -> Float -> a +getByWeight ( weight, value ) others countdown = + case others of + [] -> + value + + second :: otherOthers -> + if countdown <= abs weight then + value + + else + getByWeight second otherOthers (countdown - abs weight) + + + +-- CUSTOM GENERATORS + + +{-| Transform the values produced by a generator. For example, we can +generate random boolean values: + + import Random + + bool : Random.Generator Bool + bool = + Random.map (\n -> n < 20) (Random.int 1 100) + +The `bool` generator first picks a number between 1 and 100. From there +it checks if the number is less than twenty. So the resulting `Bool` will +be `True` about 20% of the time. + +You could also do this for lower case ASCII letters: + + letter : Random.Generator Char + letter = + Random.map (\n -> Char.fromCode (n + 97)) (Random.int 0 25) + +The `letter` generator first picks a number between 0 and 25 inclusive. +It then uses `Char.fromCode` to turn [ASCII codes][ascii] into `Char` values. + +**Note:** Instead of making these yourself, always check if the +[`random-extra`][extra] package has what you need! + +[ascii]: https://en.wikipedia.org/wiki/ASCII#Printable_characters +[extra]: /packages/elm-community/random-extra/latest + +-} +map : (a -> b) -> Generator a -> Generator b +map func (Generator genA) = + Generator + (\seed0 -> + let + ( a, seed1 ) = + genA seed0 + in + ( func a, seed1 ) + ) + + +{-| Combine two generators. Maybe we have a space invaders game and want to +generate enemy ships with a random location: + + import Random + + type alias Enemy + { health : Float + , rotation : Float + , x : Float + , y : Float + } + + enemy : Random.Generator Enemy + enemy = + Random.map2 + (\x y -> Enemy 100 0 x y) + (Random.float 0 100) + (Random.float 0 100) + +Now whenever we run the `enemy` generator we get an enemy with full health, +no rotation, and a random position! Now say we want to start with between +five and ten enemies on screen: + + initialEnemies : Random.Generator (List Enemy) + initialEnemies = + Random.int 5 10 + |> Random.andThen (\num -> Random.list num enemy) + +We will generate a number between five and ten, **and then** generate +that number of enemies! + +**Note:** Snapping generators together like this is very important! Always +start by with generators for each `type` you need, and then snap them +together. + +-} +map2 : (a -> b -> c) -> Generator a -> Generator b -> Generator c +map2 func (Generator genA) (Generator genB) = + Generator + (\seed0 -> + let + ( a, seed1 ) = + genA seed0 + + ( b, seed2 ) = + genB seed1 + in + ( func a b, seed2 ) + ) + + +{-| Combine three generators. Maybe you want to make a simple slot machine? + + import Random + + type alias Spin = + { one : Symbol + , two : Symbol + , three : Symbol + } + + type Symbol + = Cherry + | Seven + | Bar + | Grapes + + spin : Random.Generator Spin + spin = + Random.map3 Spin symbol symbol symbol + + symbol : Random.Generator Symbol + symbol = + Random.uniform Cherry [ Seven, Bar, Grapes ] + +**Note:** Always start with the types. Make a generator for each thing you need +and then put them all together with one of these `map` functions. + +-} +map3 : (a -> b -> c -> d) -> Generator a -> Generator b -> Generator c -> Generator d +map3 func (Generator genA) (Generator genB) (Generator genC) = + Generator + (\seed0 -> + let + ( a, seed1 ) = + genA seed0 + + ( b, seed2 ) = + genB seed1 + + ( c, seed3 ) = + genC seed2 + in + ( func a b c, seed3 ) + ) + + +{-| Combine four generators. + +Say you are making game and want to place enemies or terrain randomly. You +_could_ generate a [quadtree](https://en.wikipedia.org/wiki/Quadtree)! + + import Random + + type QuadTree a + = Empty + | Leaf a + | Node (QuadTree a) (QuadTree a) (QuadTree a) (QuadTree a) + + quadTree : Random.Generator a -> Random.Generator (QuadTree a) + quadTree leafGen = + let + subQuads = + Random.lazy (\_ -> quadTree leafGen) + in + Random.andThen identity <| + Random.uniform + (Random.constant Empty) + [ Random.map Leaf leafGen + , Random.map4 Node subQuad subQuad subQuad subQuad + ] + +We start by creating a `QuadTree` type where each quadrant is either `Empty`, a +`Leaf` containing something interesting, or a `Node` with four sub-quadrants. + +Next the `quadTree` definition describes how to generate these values. A third +of a time you get an `Empty` tree. A third of the time you get a `Leaf` with +some interesting value. And a third of the time you get a `Node` full of more +`QuadTree` values. How are those subtrees generated though? Well, we use our +`quadTree` generator! + +**Exercises:** Can `quadTree` generate infinite `QuadTree` values? Is there +some way to limit the depth of the `QuadTree`? Can you render the `QuadTree` +to HTML using absolute positions and fractional dimensions? Can you render +the `QuadTree` to SVG? + +**Note:** Check out the docs for [`lazy`](#lazy) to learn why that is needed +to define a recursive `Generator` like this one. + +-} +map4 : (a -> b -> c -> d -> e) -> Generator a -> Generator b -> Generator c -> Generator d -> Generator e +map4 func (Generator genA) (Generator genB) (Generator genC) (Generator genD) = + Generator + (\seed0 -> + let + ( a, seed1 ) = + genA seed0 + + ( b, seed2 ) = + genB seed1 + + ( c, seed3 ) = + genC seed2 + + ( d, seed4 ) = + genD seed3 + in + ( func a b c d, seed4 ) + ) + + +{-| Combine five generators. + +If you need to combine more things, you can always do it by chaining +[`andThen`](#andThen). There are also some additional helpers for this +in [`elm-community/random-extra`][extra]. + +[extra]: /packages/elm-community/random-extra/latest + +-} +map5 : (a -> b -> c -> d -> e -> f) -> Generator a -> Generator b -> Generator c -> Generator d -> Generator e -> Generator f +map5 func (Generator genA) (Generator genB) (Generator genC) (Generator genD) (Generator genE) = + Generator + (\seed0 -> + let + ( a, seed1 ) = + genA seed0 + + ( b, seed2 ) = + genB seed1 + + ( c, seed3 ) = + genC seed2 + + ( d, seed4 ) = + genD seed3 + + ( e, seed5 ) = + genE seed4 + in + ( func a b c d e, seed5 ) + ) + + +{-| Generate fancy random values. + +We have seen examples of how `andThen` can be used to generate variable length +lists in the [`list`](#list) and [`map2`](#map2) docs. We saw how it could help +generate a quadtree in the [`map4`](#map4) docs. + +Anything you could ever want can be defined using this operator! As one last +example, here is how you can define `map` using `andThen`: + + import Random + + map : (a -> b) -> Random.Generator a -> Random.Generator b + map func generator = + generator + |> Random.andThen (\value -> Random.constant (func value)) + +The `andThen` function gets used a lot in [`elm-community/random-extra`][extra], +so it may be helpful to look through the implementation there for more examples. + +[extra]: /packages/elm-community/random-extra/latest + +-} +andThen : (a -> Generator b) -> Generator a -> Generator b +andThen callback (Generator genA) = + Generator + (\seed -> + let + ( result, newSeed ) = + genA seed + + (Generator genB) = + callback result + in + genB newSeed + ) + + +{-| Helper for defining self-recursive generators. Say we want to generate a +random number of probabilities: + + import Random + + probabilities : Random.Generator (List Float) + probabilities = + Random.andThen identity <| + Random.uniform + (Random.constant []) + [ Random.map2 (::) + (Random.float 0 1) + (Random.lazy (\_ -> probabilities)) + ] + +In 50% of cases we end the list. In 50% of cases we generate a probability and +add it onto a random number of probabilities. The `lazy` call is crucial +because it means we do not unroll the generator unless we need to. + +This is a pretty subtle issue, so I recommend reading more about it +[here](https://elm-lang.org/0.19.0/bad-recursion)! + +**Note:** You can delay evaluation with `andThen` too. The thing that matters +is that you have a function call that delays the creation of the generator! + +-} +lazy : (() -> Generator a) -> Generator a +lazy callback = + Generator + (\seed -> + let + (Generator gen) = + callback () + in + gen seed + ) + + + +-- IMPLEMENTATION +{- Explanation of the PCG algorithm + + This is a special variation (dubbed RXS-M-SH) that produces 32 + bits of output by keeping 32 bits of state. There is one function + (next) to derive the following state and another (peel) to obtain 32 + psuedo-random bits from the current state. + + Getting the next state is easy: multiply by a magic factor, modulus by 2^32, + and then add an increment. If two seeds have different increments, + their random numbers from the two seeds will never match up; they are + completely independent. This is very helpful for isolated components or + multithreading, and elm-test relies on this feature. + + Transforming a seed into 32 random bits is more complicated, but + essentially you use the "most random" bits to pick some way of scrambling + the remaining bits. Beyond that, see section 6.3.4 of the [paper]. + + [paper](http://www.pcg-random.org/paper.html) + + Once we have 32 random bits, we have to turn it into a number. For integers, + we first check if the range is a power of two. If it is, we can mask part of + the value and be done. If not, we need to account for bias. + + Let's say you want a random number between 1 and 7 but I can only generate + random numbers between 1 and 32. If I modulus by result by 7, I'm biased, + because there are more random numbers that lead to 1 than 7. So instead, I + check to see if my random number exceeds 28 (the largest multiple of 7 less + than 32). If it does, I reroll, otherwise I mod by seven. This sounds + wasteful, except that instead of 32 it's 2^32, so in practice it's hard to + notice. So that's how we get random ints. There's another process from + floats, but I don't understand it very well. +-} + + +{-| Maybe you do not want to use [`generate`](#generate) for some reason? Maybe +you need to be able to exactly reproduce a sequence of random values? + +In that case, you can work with a `Seed` of randomness and [`step`](#step) it +forward by hand. + +-} +type Seed + = Seed Int Int + + + +-- the first Int is the state of the RNG and stepped with each random generation +-- the second state is the increment which corresponds to an independent RNG +-- step the RNG to produce the next seed +-- this is incredibly simple: multiply the state by a constant factor, modulus it +-- by 2^32, and add a magic addend. The addend can be varied to produce independent +-- RNGs, so it is stored as part of the seed. It is given to the new seed unchanged. + + +next : Seed -> Seed +next (Seed state0 incr) = + -- The magic constant is from Numerical Recipes and is inlined for perf. + Seed (Bitwise.shiftRightZfBy 0 ((state0 * 1664525) + incr)) incr + + + +-- obtain a psuedorandom 32-bit integer from a seed + + +peel : Seed -> Int +peel (Seed state _) = + -- This is the RXS-M-SH version of PCG, see section 6.3.4 of the paper + -- and line 184 of pcg_variants.h in the 0.94 (non-minimal) C implementation, + -- the latter of which is the source of the magic constant. + let + word = + Bitwise.xor state (Bitwise.shiftRightZfBy (Bitwise.shiftRightZfBy 28 state + 4) state) * 277803737 + in + Bitwise.shiftRightZfBy 0 (Bitwise.xor (Bitwise.shiftRightZfBy 22 word) word) + + +{-| A `Generator` is a **recipe** for generating random values. For example, +here is a generator for numbers between 1 and 10 inclusive: + + import Random + + oneToTen : Random.Generator Int + oneToTen = + Random.int 1 10 + +Notice that we are not actually generating any numbers yet! We are describing +what kind of values we want. To actually get random values, you create a +command with the [`generate`](#generate) function: + + type Msg + = NewNumber Int + + newNumber : Cmd Msg + newNumber = + Random.generate NewNumber oneToTen + +Each time you run this command, it runs the `oneToTen` generator and produces +random integers between one and ten. + +**Note 1:** If you are not familiar with commands yet, start working through +[guide.elm-lang.org][guide]. It builds up to an example that generates +random numbers. Commands are one of the core concepts in Elm, and it will +be faster overall to invest in understanding them _now_ rather than copy/pasting +your way to frustration! And if you feel stuck on something, definitely ask +about it in [the Elm slack][slack]. Folks are happy to help! + +**Note 2:** The random `Generator` API is quite similar to the JSON `Decoder` API. +Both are building blocks that snap together with `map`, `map2`, etc. You can read +more about JSON decoders [here][json] to see the similarity. + +[guide]: https://guide.elm-lang.org/ +[slack]: https://elmlang.herokuapp.com/ +[json]: https://guide.elm-lang.org/interop/json.html + +-} +type Generator a + = Generator (Seed -> ( a, Seed )) + + +{-| So you need _reproducable_ randomness for some reason. + +This `step` function lets you use a `Generator` without commands. It is a +normal Elm function. Same input, same output! So to get a 3D point you could +say: + + import Random + + type alias Point3D = + { x : Float, y : Float, z : Float } + + point3D : Random.Seed -> ( Point3D, Random.Seed ) + point3D seed0 = + let + ( x, seed1 ) = + Random.step (Random.int 0 100) seed0 + + ( y, seed2 ) = + Random.step (Random.int 0 100) seed1 + + ( z, seed3 ) = + Random.step (Random.int 0 100) seed2 + in + ( Point3D x y z, seed3 ) + +Notice that we use different seeds on each line! If we instead used `seed0` +for everything, the `x`, `y`, and `z` values would always be exactly the same! +Same input, same output! + +Threading seeds around is not super fun, so if you really need this, it is +best to build your `Generator` like normal and then just `step` it all at +once at the top of your program. + +-} +step : Generator a -> Seed -> ( a, Seed ) +step (Generator generator) seed = + generator seed + + +{-| Create a `Seed` for _reproducable_ randomness. + + import Random + + seed0 : Random.Seed + seed0 = + Random.initialSeed 42 + +If you hard-code your `Seed` like this, every run will be the same. This can +be useful if you are testing a game with randomness and want it to be easy to +reproduce past games. + +In practice, you may want to get the initial seed by (1) sending it to Elm +through flags or (2) using `Time.now` to get a number that the user has not +seen before. (Flags are described on [this page][flags].) + +[flags]: https://guide.elm-lang.org/interop/flags.html + +-} +initialSeed : Int -> Seed +initialSeed x = + let + -- the default increment magic constant is taken from Numerical Recipes + (Seed state1 incr) = + next (Seed 0 1013904223) + + state2 = + Bitwise.shiftRightZfBy 0 (state1 + x) + in + next (Seed state2 incr) + + +{-| A generator that produces a seed that is independent of any other seed in +the program. These seeds will generate their own unique sequences of random +values. They are useful when you need an unknown amount of randomness _later_ +but can request only a fixed amount of randomness _now_. + +The independent seeds are extremely likely to be distinct for all practical +purposes. However, it is not proven that there are no pathological cases. + +-} +independentSeed : Generator Seed +independentSeed = + Generator <| + \seed0 -> + let + gen = + int 0 0xFFFFFFFF + + {-- + Although it probably doesn't hold water theoretically, xor two + random numbers to make an increment less likely to be + pathological. Then make sure that it's odd, which is required. + Next make sure it is positive. Finally step it once before use. + --} + makeIndependentSeed state b c = + next <| + Seed state <| + Bitwise.shiftRightZfBy 0 (Bitwise.or 1 (Bitwise.xor b c)) + in + step (map3 makeIndependentSeed gen gen gen) seed0 + + + +-- MANAGER + + +{-| Create a command that produces random values. Say you want to generate +random points: + + import Random + + point : Random.Generator ( Int, Int ) + point = + Random.pair (Random.int -100 100) (Random.int -100 100) + + type Msg + = NewPoint ( Int, Int ) + + newPoint : Cmd Msg + newPoint = + Random.generate NewPoint point + +Each time you run the `newPoint` command, it will produce a new 2D point like +`(57, 18)` or `(-82, 6)`. + +**Note:** Read through [guide.elm-lang.org][guide] to learn how commands work. +If you are coming from JS it can be hopelessly frustrating if you just try to +wing it. And definitely ask around on Slack if you feel stuck! Investing in +understanding generators is really worth it, and once it clicks, folks often +dread going back to `Math.random()` in JavaScript. + +[guide]: https://guide.elm-lang.org/ + +-} +generate : (a -> msg) -> Generator a -> Cmd msg +generate tagger generator = + let + msgGen = + map tagger generator + in + command + (Channel.recv RawTask.Value (Tuple.second updateSeed) + |> RawTask.andThen + (\oldSeed -> + let + ( randomVal, newSeed ) = + step msgGen oldSeed + in + Channel.send (Tuple.first updateSeed) newSeed + |> RawTask.map (\() -> Ok (Just randomVal)) + ) + |> Scheduler.wrapTask + ) + + +updateSeed : Channel.Channel Seed +updateSeed = + let + ( sender, receiver ) = + Channel.rawUnbounded () + + _ = + Time.now + |> Scheduler.unwrapTask + |> RawTask.andThen + (\time -> + case time of + Ok time_ -> + Channel.send sender (initialSeed (Time.posixToMillis time_)) + + Err err -> + never err + ) + |> RawScheduler.rawSpawn + in + ( sender, receiver ) + + +command : Platform.Task Never (Maybe msg) -> Cmd msg +command = + Elm.Kernel.Platform.command diff --git a/src/Result.elm b/src/Result.elm index df944b42..e2a6e925 100644 --- a/src/Result.elm +++ b/src/Result.elm @@ -1,29 +1,37 @@ module Result exposing - ( Result(..) - , withDefault - , map, map2, map3, map4, map5 - , andThen - , toMaybe, fromMaybe, mapError - ) + ( Result(..) + , map, map2, map3, map4, map5 + , andThen + , withDefault, toMaybe, fromMaybe, mapError + ) {-| A `Result` is the result of a computation that may fail. This is a great way to manage errors in Elm. + # Type and Constructors + @docs Result + # Mapping + @docs map, map2, map3, map4, map5 + # Chaining + @docs andThen + # Handling Errors + @docs withDefault, toMaybe, fromMaybe, mapError + -} -import Basics exposing ( Bool(..) ) -import Maybe exposing ( Maybe(..) ) +import Basics exposing (Bool(..)) +import Maybe exposing (Maybe(..)) {-| A `Result` is either `Ok` meaning the computation succeeded, or it is an @@ -37,137 +45,145 @@ type Result error value {-| If the result is `Ok` return the value, but if the result is an `Err` then return a given default value. The following examples try to parse integers. - Result.withDefault 0 (Ok 123) == 123 + Result.withDefault 0 (Ok 123) == 123 + Result.withDefault 0 (Err "no") == 0 + -} withDefault : a -> Result x a -> a withDefault def result = - case result of - Ok a -> - a + case result of + Ok a -> + a - Err _ -> - def + Err _ -> + def {-| Apply a function to a result. If the result is `Ok`, it will be converted. If the result is an `Err`, the same error value will propagate through. - map sqrt (Ok 4.0) == Ok 2.0 + map sqrt (Ok 4.0) == Ok 2.0 + map sqrt (Err "bad input") == Err "bad input" + -} map : (a -> value) -> Result x a -> Result x value map func ra = - case ra of - Ok a -> - Ok (func a) + case ra of + Ok a -> + Ok (func a) - Err e -> - Err e + Err e -> + Err e {-| Apply a function if both results are `Ok`. If not, the first `Err` will propagate through. - map2 max (Ok 42) (Ok 13) == Ok 42 - map2 max (Err "x") (Ok 13) == Err "x" - map2 max (Ok 42) (Err "y") == Err "y" + map2 max (Ok 42) (Ok 13) == Ok 42 + + map2 max (Err "x") (Ok 13) == Err "x" + + map2 max (Ok 42) (Err "y") == Err "y" + map2 max (Err "x") (Err "y") == Err "x" This can be useful if you have two computations that may fail, and you want to put them together quickly. + -} map2 : (a -> b -> value) -> Result x a -> Result x b -> Result x value map2 func ra rb = - case ra of - Err x -> - Err x - - Ok a -> - case rb of + case ra of Err x -> - Err x + Err x + + Ok a -> + case rb of + Err x -> + Err x - Ok b -> - Ok (func a b) + Ok b -> + Ok (func a b) -{-|-} +{-| -} map3 : (a -> b -> c -> value) -> Result x a -> Result x b -> Result x c -> Result x value map3 func ra rb rc = - case ra of - Err x -> - Err x - - Ok a -> - case rb of + case ra of Err x -> - Err x + Err x + + Ok a -> + case rb of + Err x -> + Err x - Ok b -> - case rc of - Err x -> - Err x + Ok b -> + case rc of + Err x -> + Err x - Ok c -> - Ok (func a b c) + Ok c -> + Ok (func a b c) -{-|-} +{-| -} map4 : (a -> b -> c -> d -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x value map4 func ra rb rc rd = - case ra of - Err x -> - Err x - - Ok a -> - case rb of + case ra of Err x -> - Err x - - Ok b -> - case rc of - Err x -> - Err x + Err x - Ok c -> - case rd of + Ok a -> + case rb of Err x -> - Err x + Err x + + Ok b -> + case rc of + Err x -> + Err x - Ok d -> - Ok (func a b c d) + Ok c -> + case rd of + Err x -> + Err x + Ok d -> + Ok (func a b c d) -{-|-} + +{-| -} map5 : (a -> b -> c -> d -> e -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x e -> Result x value map5 func ra rb rc rd re = - case ra of - Err x -> - Err x - - Ok a -> - case rb of + case ra of Err x -> - Err x - - Ok b -> - case rc of - Err x -> - Err x + Err x - Ok c -> - case rd of + Ok a -> + case rb of Err x -> - Err x + Err x + + Ok b -> + case rc of + Err x -> + Err x + + Ok c -> + case rd of + Err x -> + Err x - Ok d -> - case re of - Err x -> - Err x + Ok d -> + case re of + Err x -> + Err x - Ok e -> - Ok (func a b c d e) + Ok e -> + Ok (func a b c d e) {-| Chain together a sequence of computations that may fail. It is helpful @@ -176,23 +192,29 @@ to see its definition: andThen : (a -> Result e b) -> Result e a -> Result e b andThen callback result = case result of - Ok value -> callback value - Err msg -> Err msg + Ok value -> + callback value + + Err msg -> + Err msg This means we only continue with the callback if things are going well. For example, say you need to use (`toInt : String -> Result String Int`) to parse a month and make sure it is between 1 and 12: + toValidMonth : Int -> Result String Int toValidMonth month = - if month >= 1 && month <= 12 - then Ok month - else Err "months must be between 1 and 12" + if month >= 1 && month <= 12 then + Ok month + + else + Err "months must be between 1 and 12" toMonth : String -> Result String Int toMonth rawString = toInt rawString - |> andThen toValidMonth + |> andThen toValidMonth -- toMonth "4" == Ok 4 -- toMonth "9" == Ok 9 @@ -203,15 +225,16 @@ This allows us to come out of a chain of operations with quite a specific error message. It is often best to create a custom type that explicitly represents the exact ways your computation may fail. This way it is easy to handle in your code. + -} andThen : (a -> Result x b) -> Result x a -> Result x b andThen callback result = case result of - Ok value -> - callback value + Ok value -> + callback value - Err msg -> - Err msg + Err msg -> + Err msg {-| Transform an `Err` value. For example, say the errors we get have too much @@ -227,15 +250,16 @@ information: mapError .message (parseInt "123") == Ok 123 mapError .message (parseInt "abc") == Err "char 'a' is not a number" + -} mapError : (x -> y) -> Result x a -> Result y a mapError f result = case result of - Ok v -> - Ok v + Ok v -> + Ok v - Err e -> - Err (f e) + Err e -> + Err (f e) {-| Convert to a simpler `Maybe` if the actual error message is not needed or @@ -246,12 +270,16 @@ you need to interact with some code that primarily uses maybes. maybeParseInt : String -> Maybe Int maybeParseInt string = toMaybe (parseInt string) + -} toMaybe : Result x a -> Maybe a toMaybe result = case result of - Ok v -> Just v - Err _ -> Nothing + Ok v -> + Just v + + Err _ -> + Nothing {-| Convert from a simple `Maybe` to interact with some code that primarily @@ -262,12 +290,16 @@ uses `Results`. resultParseInt : String -> Result String Int resultParseInt string = fromMaybe ("error parsing string: " ++ toString string) (parseInt string) + -} fromMaybe : x -> Maybe a -> Result x a fromMaybe err maybe = case maybe of - Just v -> Ok v - Nothing -> Err err + Just v -> + Ok v + + Nothing -> + Err err @@ -278,9 +310,9 @@ fromMaybe err maybe = isOk : Result x a -> Bool isOk result = - case result of - Ok _ -> - True + case result of + Ok _ -> + True - Err _ -> - False + Err _ -> + False diff --git a/src/Set.elm b/src/Set.elm index 33256e64..f74e7476 100644 --- a/src/Set.elm +++ b/src/Set.elm @@ -1,34 +1,46 @@ module Set exposing - ( Set - , empty, singleton, insert, remove - , isEmpty, member, size - , union, intersect, diff - , toList, fromList - , map, foldl, foldr, filter, partition - ) + ( Set + , empty, singleton, insert, remove + , isEmpty, member, size + , union, intersect, diff + , toList, fromList + , map, foldl, foldr, filter, partition + ) {-| A set of unique values. The values can be any comparable type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or lists of comparable types. -Insert, remove, and query operations all take *O(log n)* time. +Insert, remove, and query operations all take _O(log n)_ time. + # Sets + @docs Set + # Build + @docs empty, singleton, insert, remove + # Query + @docs isEmpty, member, size + # Combine + @docs union, intersect, diff + # Lists + @docs toList, fromList + # Transform + @docs map, foldl, foldr, filter, partition -} @@ -42,71 +54,71 @@ import Maybe exposing (Maybe(..)) {-| Represents a set of unique values. So `(Set Int)` is a set of integers and `(Set String)` is a set of strings. -} -type Set t = - Set_elm_builtin (Dict.Dict t ()) +type Set t + = Set_elm_builtin (Dict.Dict t ()) {-| Create an empty set. -} empty : Set a empty = - Set_elm_builtin Dict.empty + Set_elm_builtin Dict.empty {-| Create a set with one value. -} singleton : comparable -> Set comparable singleton key = - Set_elm_builtin (Dict.singleton key ()) + Set_elm_builtin (Dict.singleton key ()) {-| Insert a value into a set. -} insert : comparable -> Set comparable -> Set comparable insert key (Set_elm_builtin dict) = - Set_elm_builtin (Dict.insert key () dict) + Set_elm_builtin (Dict.insert key () dict) {-| Remove a value from a set. If the value is not found, no changes are made. -} remove : comparable -> Set comparable -> Set comparable remove key (Set_elm_builtin dict) = - Set_elm_builtin (Dict.remove key dict) + Set_elm_builtin (Dict.remove key dict) {-| Determine if a set is empty. -} isEmpty : Set a -> Bool isEmpty (Set_elm_builtin dict) = - Dict.isEmpty dict + Dict.isEmpty dict {-| Determine if a value is in a set. -} member : comparable -> Set comparable -> Bool member key (Set_elm_builtin dict) = - Dict.member key dict + Dict.member key dict {-| Determine the number of elements in a set. -} size : Set a -> Int size (Set_elm_builtin dict) = - Dict.size dict + Dict.size dict {-| Get the union of two sets. Keep all values. -} union : Set comparable -> Set comparable -> Set comparable union (Set_elm_builtin dict1) (Set_elm_builtin dict2) = - Set_elm_builtin (Dict.union dict1 dict2) + Set_elm_builtin (Dict.union dict1 dict2) {-| Get the intersection of two sets. Keeps values that appear in both sets. -} intersect : Set comparable -> Set comparable -> Set comparable intersect (Set_elm_builtin dict1) (Set_elm_builtin dict2) = - Set_elm_builtin (Dict.intersect dict1 dict2) + Set_elm_builtin (Dict.intersect dict1 dict2) {-| Get the difference between the first set and the second. Keeps values @@ -114,42 +126,42 @@ that do not appear in the second set. -} diff : Set comparable -> Set comparable -> Set comparable diff (Set_elm_builtin dict1) (Set_elm_builtin dict2) = - Set_elm_builtin (Dict.diff dict1 dict2) + Set_elm_builtin (Dict.diff dict1 dict2) {-| Convert a set into a list, sorted from lowest to highest. -} toList : Set a -> List a toList (Set_elm_builtin dict) = - Dict.keys dict + Dict.keys dict {-| Convert a list into a set, removing any duplicates. -} fromList : List comparable -> Set comparable fromList list = - List.foldl insert empty list + List.foldl insert empty list {-| Fold over the values in a set, in order from lowest to highest. -} foldl : (a -> b -> b) -> b -> Set a -> b foldl func initialState (Set_elm_builtin dict) = - Dict.foldl (\key _ state -> func key state) initialState dict + Dict.foldl (\key _ state -> func key state) initialState dict {-| Fold over the values in a set, in order from highest to lowest. -} foldr : (a -> b -> b) -> b -> Set a -> b foldr func initialState (Set_elm_builtin dict) = - Dict.foldr (\key _ state -> func key state) initialState dict + Dict.foldr (\key _ state -> func key state) initialState dict {-| Map a function onto a set, creating a new set with no duplicates. -} map : (comparable -> comparable2) -> Set comparable -> Set comparable2 map func set = - fromList (foldl (\x xs -> func x :: xs) [] set) + fromList (foldl (\x xs -> func x :: xs) [] set) {-| Only keep elements that pass the given test. @@ -158,26 +170,27 @@ map func set = numbers : Set Int numbers = - Set.fromList [-2,-1,0,1,2] + Set.fromList [ -2, -1, 0, 1, 2 ] positives : Set Int positives = - Set.filter (\x -> x > 0) numbers + Set.filter (\x -> x > 0) numbers -- positives == Set.fromList [1,2] + -} filter : (comparable -> Bool) -> Set comparable -> Set comparable filter isGood (Set_elm_builtin dict) = - Set_elm_builtin (Dict.filter (\key _ -> isGood key) dict) + Set_elm_builtin (Dict.filter (\key _ -> isGood key) dict) {-| Create two new sets. The first contains all the elements that passed the given test, and the second contains all the elements that did not. -} -partition : (comparable -> Bool) -> Set comparable -> (Set comparable, Set comparable) +partition : (comparable -> Bool) -> Set comparable -> ( Set comparable, Set comparable ) partition isGood (Set_elm_builtin dict) = - let - (dict1, dict2) = - Dict.partition (\key _ -> isGood key) dict - in - (Set_elm_builtin dict1, Set_elm_builtin dict2) + let + ( dict1, dict2 ) = + Dict.partition (\key _ -> isGood key) dict + in + ( Set_elm_builtin dict1, Set_elm_builtin dict2 ) diff --git a/src/String.elm b/src/String.elm index 0e60bdd6..f8ff7e0f 100644 --- a/src/String.elm +++ b/src/String.elm @@ -1,51 +1,71 @@ module String exposing - ( String - , isEmpty, length, reverse, repeat, replace - , append, concat, split, join, words, lines - , slice, left, right, dropLeft, dropRight - , contains, startsWith, endsWith, indexes, indices - , toInt, fromInt - , toFloat, fromFloat - , fromChar, cons, uncons - , toList, fromList - , toUpper, toLower, pad, padLeft, padRight, trim, trimLeft, trimRight - , map, filter, foldl, foldr, any, all - ) + ( String, isEmpty, length, reverse, repeat, replace + , append, concat, split, join, words, lines + , slice, left, right, dropLeft, dropRight + , contains, startsWith, endsWith, indexes, indices + , toInt, fromInt + , toFloat, fromFloat + , fromChar, cons, uncons + , toList, fromList + , toUpper, toLower, pad, padLeft, padRight, trim, trimLeft, trimRight + , map, filter, foldl, foldr, any, all + ) {-| A built-in representation for efficient string manipulation. String literals -are enclosed in `"double quotes"`. Strings are *not* lists of characters. +are enclosed in `"double quotes"`. Strings are _not_ lists of characters. + # Strings + @docs String, isEmpty, length, reverse, repeat, replace + # Building and Splitting + @docs append, concat, split, join, words, lines + # Get Substrings + @docs slice, left, right, dropLeft, dropRight + # Check for Substrings + @docs contains, startsWith, endsWith, indexes, indices + # Int Conversions + @docs toInt, fromInt + # Float Conversions + @docs toFloat, fromFloat + # Char Conversions + @docs fromChar, cons, uncons + # List Conversions + @docs toList, fromList + # Formatting + Cosmetic operations such as padding with extra characters or trimming whitespace. @docs toUpper, toLower, pad, padLeft, padRight, trim, trimLeft, trimRight + # Higher-Order Functions + @docs map, filter, foldl, foldr, any, all + -} import Basics exposing (..) @@ -65,12 +85,15 @@ import Result exposing (Result) {-| A `String` is a chunk of text: "Hello!" + "How are you?" + "🙈🙉🙊" -- strings with escape characters "this\n\t\"that\"" - "\u{1F648}\u{1F649}\u{1F64A}" -- "🙈🙉🙊" + + "🙈🙉🙊" -- "🙈🙉🙊" -- multiline strings """Triple double quotes let you @@ -89,72 +112,86 @@ characters with different widths. **Note:** JavaScript lets you use double quotes and single quotes interchangably. This is not true in Elm. You must use double quotes for a `String`, and you must use single quotes for a [`Char`](Char#Char). + -} -type String = String -- NOTE: The compiler provides the real implementation. +type String + = String -- NOTE: The compiler provides the real implementation. {-| Determine if a string is empty. isEmpty "" == True + isEmpty "the world" == False + -} isEmpty : String -> Bool isEmpty string = - string == "" + string == "" {-| Get the length of a string. length "innumerable" == 11 + length "" == 0 -} length : String -> Int length = - Elm.Kernel.String.length + Elm.Kernel.String.length {-| Reverse a string. reverse "stressed" == "desserts" + -} reverse : String -> String reverse = - Elm.Kernel.String.reverse + Elm.Kernel.String.reverse -{-| Repeat a string *n* times. +{-| Repeat a string _n_ times. repeat 3 "ha" == "hahaha" + -} repeat : Int -> String -> String repeat n chunk = - repeatHelp n chunk "" + repeatHelp n chunk "" repeatHelp : Int -> String -> String -> String repeatHelp n chunk result = - if n <= 0 then - result - else - repeatHelp (Bitwise.shiftRightBy 1 n) (chunk ++ chunk) <| - if Bitwise.and n 1 == 0 then result else result ++ chunk + if n <= 0 then + result + + else + repeatHelp (Bitwise.shiftRightBy 1 n) (chunk ++ chunk) <| + if Bitwise.and n 1 == 0 then + result + + else + result ++ chunk {-| Replace all occurrences of some substring. replace "." "-" "Json.Decode.succeed" == "Json-Decode-succeed" - replace "," "/" "a,b,c,d,e" == "a/b/c/d/e" + + replace "," "/" "a,b,c,d,e" == "a/b/c/d/e" **Note:** If you need more advanced replacements, check out the [`elm/parser`][parser] or [`elm/regex`][regex] package. [parser]: /packages/elm/parser/latest [regex]: /packages/elm/regex/latest + -} replace : String -> String -> String -> String replace before after string = - join after (split before string) + join after (split before string) @@ -165,59 +202,67 @@ replace before after string = to do this. append "butter" "fly" == "butterfly" + -} append : String -> String -> String append = - Elm.Kernel.String.append + Elm.Kernel.String.append {-| Concatenate many strings into one. - concat ["never","the","less"] == "nevertheless" + concat [ "never", "the", "less" ] == "nevertheless" + -} concat : List String -> String concat strings = - join "" strings + join "" strings {-| Split a string using a given separator. - split "," "cat,dog,cow" == ["cat","dog","cow"] - split "/" "home/evan/Desktop/" == ["home","evan","Desktop", ""] + split "," "cat,dog,cow" == [ "cat", "dog", "cow" ] + + split "/" "home/evan/Desktop/" == [ "home", "evan", "Desktop", "" ] -} split : String -> String -> List String split sep string = - Elm.Kernel.List.fromArray (Elm.Kernel.String.split sep string) + Elm.Kernel.List.fromArray (Elm.Kernel.String.split sep string) {-| Put many strings together with a given separator. - join "a" ["H","w","ii","n"] == "Hawaiian" - join " " ["cat","dog","cow"] == "cat dog cow" - join "/" ["home","evan","Desktop"] == "home/evan/Desktop" + join "a" [ "H", "w", "ii", "n" ] == "Hawaiian" + + join " " [ "cat", "dog", "cow" ] == "cat dog cow" + + join "/" [ "home", "evan", "Desktop" ] == "home/evan/Desktop" + -} join : String -> List String -> String join sep chunks = - Elm.Kernel.String.join sep (Elm.Kernel.List.toArray chunks) + Elm.Kernel.String.join sep (Elm.Kernel.List.toArray chunks) {-| Break a string into words, splitting on chunks of whitespace. - words "How are \t you? \n Good?" == ["How","are","you?","Good?"] + words "How are \t you? \n Good?" == [ "How", "are", "you?", "Good?" ] + -} words : String -> List String words = - Elm.Kernel.String.words + Elm.Kernel.String.words {-| Break a string into lines, splitting on newlines. - lines "How are you?\nGood?" == ["How are you?", "Good?"] + lines "How are you?\nGood?" == [ "How are you?", "Good?" ] + -} lines : String -> List String lines = - Elm.Kernel.String.lines + Elm.Kernel.String.lines @@ -225,64 +270,76 @@ lines = {-| Take a substring given a start and end index. Negative indexes -are taken starting from the *end* of the list. +are taken starting from the _end_ of the list. + + slice 7 9 "snakes on a plane!" == "on" + + slice 0 6 "snakes on a plane!" == "snakes" + + slice 0 -7 "snakes on a plane!" == "snakes on a" - slice 7 9 "snakes on a plane!" == "on" - slice 0 6 "snakes on a plane!" == "snakes" - slice 0 -7 "snakes on a plane!" == "snakes on a" slice -6 -1 "snakes on a plane!" == "plane" + -} slice : Int -> Int -> String -> String slice = - Elm.Kernel.String.slice + Elm.Kernel.String.slice -{-| Take *n* characters from the left side of a string. +{-| Take _n_ characters from the left side of a string. left 2 "Mulder" == "Mu" + -} left : Int -> String -> String left n string = - if n < 1 then - "" - else - slice 0 n string + if n < 1 then + "" + + else + slice 0 n string -{-| Take *n* characters from the right side of a string. +{-| Take _n_ characters from the right side of a string. right 2 "Scully" == "ly" + -} right : Int -> String -> String right n string = - if n < 1 then - "" - else - slice -n (length string) string + if n < 1 then + "" + else + slice -n (length string) string -{-| Drop *n* characters from the left side of a string. + +{-| Drop _n_ characters from the left side of a string. dropLeft 2 "The Lone Gunmen" == "e Lone Gunmen" + -} dropLeft : Int -> String -> String dropLeft n string = - if n < 1 then - string - else - slice n (length string) string + if n < 1 then + string + else + slice n (length string) string -{-| Drop *n* characters from the right side of a string. + +{-| Drop _n_ characters from the right side of a string. dropRight 2 "Cigarette Smoking Man" == "Cigarette Smoking M" + -} dropRight : Int -> String -> String dropRight n string = - if n < 1 then - string - else - slice 0 -n string + if n < 1 then + string + + else + slice 0 -n string @@ -292,50 +349,60 @@ dropRight n string = {-| See if the second string contains the first one. contains "the" "theory" == True + contains "hat" "theory" == False + contains "THE" "theory" == False -} contains : String -> String -> Bool contains = - Elm.Kernel.String.contains + Elm.Kernel.String.contains {-| See if the second string starts with the first one. startsWith "the" "theory" == True + startsWith "ory" "theory" == False + -} startsWith : String -> String -> Bool startsWith = - Elm.Kernel.String.startsWith + Elm.Kernel.String.startsWith {-| See if the second string ends with the first one. endsWith "the" "theory" == False + endsWith "ory" "theory" == True + -} endsWith : String -> String -> Bool endsWith = - Elm.Kernel.String.endsWith + Elm.Kernel.String.endsWith {-| Get all of the indexes for a substring in another string. - indexes "i" "Mississippi" == [1,4,7,10] - indexes "ss" "Mississippi" == [2,5] + indexes "i" "Mississippi" == [ 1, 4, 7, 10 ] + + indexes "ss" "Mississippi" == [ 2, 5 ] + indexes "needle" "haystack" == [] + -} indexes : String -> String -> List Int indexes = - Elm.Kernel.String.indexes + Elm.Kernel.String.indexes -{-| Alias for `indexes`. -} +{-| Alias for `indexes`. +-} indices : String -> String -> List Int indices = - Elm.Kernel.String.indexes + Elm.Kernel.String.indexes @@ -346,83 +413,97 @@ indices = and VIRTUAL YELLING. toUpper "skinner" == "SKINNER" + -} toUpper : String -> String toUpper = - Elm.Kernel.String.toUpper + Elm.Kernel.String.toUpper {-| Convert a string to all lower case. Useful for case-insensitive comparisons. toLower "X-FILES" == "x-files" + -} toLower : String -> String toLower = - Elm.Kernel.String.toLower + Elm.Kernel.String.toLower {-| Pad a string on both sides until it has a given length. - pad 5 ' ' "1" == " 1 " - pad 5 ' ' "11" == " 11 " + pad 5 ' ' "1" == " 1 " + + pad 5 ' ' "11" == " 11 " + pad 5 ' ' "121" == " 121 " + -} pad : Int -> Char -> String -> String pad n char string = - let - half = - Basics.toFloat (n - length string) / 2 - in + let + half = + Basics.toFloat (n - length string) / 2 + in repeat (ceiling half) (fromChar char) ++ string ++ repeat (floor half) (fromChar char) {-| Pad a string on the left until it has a given length. - padLeft 5 '.' "1" == "....1" - padLeft 5 '.' "11" == "...11" + padLeft 5 '.' "1" == "....1" + + padLeft 5 '.' "11" == "...11" + padLeft 5 '.' "121" == "..121" + -} padLeft : Int -> Char -> String -> String padLeft n char string = - repeat (n - length string) (fromChar char) ++ string + repeat (n - length string) (fromChar char) ++ string {-| Pad a string on the right until it has a given length. - padRight 5 '.' "1" == "1...." - padRight 5 '.' "11" == "11..." + padRight 5 '.' "1" == "1...." + + padRight 5 '.' "11" == "11..." + padRight 5 '.' "121" == "121.." + -} padRight : Int -> Char -> String -> String padRight n char string = - string ++ repeat (n - length string) (fromChar char) + string ++ repeat (n - length string) (fromChar char) {-| Get rid of whitespace on both sides of a string. trim " hats \n" == "hats" + -} trim : String -> String trim = - Elm.Kernel.String.trim + Elm.Kernel.String.trim {-| Get rid of whitespace on the left of a string. trimLeft " hats \n" == "hats \n" + -} trimLeft : String -> String trimLeft = - Elm.Kernel.String.trimLeft + Elm.Kernel.String.trimLeft {-| Get rid of whitespace on the right of a string. trimRight " hats \n" == " hats" + -} trimRight : String -> String trimRight = - Elm.Kernel.String.trimRight + Elm.Kernel.String.trimRight @@ -432,32 +513,39 @@ trimRight = {-| Try to convert a string into an int, failing on improperly formatted strings. String.toInt "123" == Just 123 + String.toInt "-42" == Just -42 + String.toInt "3.1" == Nothing + String.toInt "31a" == Nothing If you are extracting a number from some raw user input, you will typically want to use [`Maybe.withDefault`](Maybe#withDefault) to handle bad data: Maybe.withDefault 0 (String.toInt "42") == 42 + Maybe.withDefault 0 (String.toInt "ab") == 0 + -} toInt : String -> Maybe Int toInt = - Elm.Kernel.String.toInt + Elm.Kernel.String.toInt {-| Convert an `Int` to a `String`. String.fromInt 123 == "123" + String.fromInt -42 == "-42" -Check out [`Debug.toString`](Debug#toString) to convert *any* value to a string +Check out [`Debug.toString`](Debug#toString) to convert _any_ value to a string for debugging purposes. + -} fromInt : Int -> String fromInt = - Elm.Kernel.String.fromNumber + Elm.Kernel.String.fromNumber @@ -467,33 +555,41 @@ fromInt = {-| Try to convert a string into a float, failing on improperly formatted strings. String.toFloat "123" == Just 123.0 + String.toFloat "-42" == Just -42.0 + String.toFloat "3.1" == Just 3.1 + String.toFloat "31a" == Nothing If you are extracting a number from some raw user input, you will typically want to use [`Maybe.withDefault`](Maybe#withDefault) to handle bad data: Maybe.withDefault 0 (String.toFloat "42.5") == 42.5 + Maybe.withDefault 0 (String.toFloat "cats") == 0 + -} toFloat : String -> Maybe Float toFloat = - Elm.Kernel.String.toFloat + Elm.Kernel.String.toFloat {-| Convert a `Float` to a `String`. String.fromFloat 123 == "123" + String.fromFloat -42 == "-42" + String.fromFloat 3.9 == "3.9" -Check out [`Debug.toString`](Debug#toString) to convert *any* value to a string +Check out [`Debug.toString`](Debug#toString) to convert _any_ value to a string for debugging purposes. + -} fromFloat : Float -> String fromFloat = - Elm.Kernel.String.fromNumber + Elm.Kernel.String.fromNumber @@ -502,24 +598,28 @@ fromFloat = {-| Convert a string to a list of characters. - toList "abc" == ['a','b','c'] - toList "🙈🙉🙊" == ['🙈','🙉','🙊'] + toList "abc" == [ 'a', 'b', 'c' ] + + toList "🙈🙉🙊" == [ '🙈', '🙉', '🙊' ] + -} toList : String -> List Char toList string = - foldr (::) [] string + foldr (::) [] string {-| Convert a list of characters into a String. Can be useful if you want to create a string primarily by consing, perhaps for decoding something. - fromList ['a','b','c'] == "abc" - fromList ['🙈','🙉','🙊'] == "🙈🙉🙊" + fromList [ 'a', 'b', 'c' ] == "abc" + + fromList [ '🙈', '🙉', '🙊' ] == "🙈🙉🙊" + -} fromList : List Char -> String fromList = - Elm.Kernel.String.fromList + Elm.Kernel.String.fromList @@ -529,30 +629,34 @@ fromList = {-| Create a string from a given character. fromChar 'a' == "a" + -} fromChar : Char -> String fromChar char = - cons char "" + cons char "" {-| Add a character to the beginning of a string. cons 'T' "he truth is out there" == "The truth is out there" + -} cons : Char -> String -> String cons = - Elm.Kernel.String.cons + Elm.Kernel.String.cons {-| Split a non-empty string into its head and tail. This lets you pattern match on strings exactly as you would with lists. - uncons "abc" == Just ('a',"bc") - uncons "" == Nothing + uncons "abc" == Just ( 'a', "bc" ) + + uncons "" == Nothing + -} -uncons : String -> Maybe (Char, String) +uncons : String -> Maybe ( Char, String ) uncons = - Elm.Kernel.String.uncons + Elm.Kernel.String.uncons @@ -561,57 +665,76 @@ uncons = {-| Transform every character in a string - map (\c -> if c == '/' then '.' else c) "a/b/c" == "a.b.c" + map + (\c -> + if c == '/' then + '.' + + else + c + ) + "a/b/c" + == "a.b.c" + -} map : (Char -> Char) -> String -> String map = - Elm.Kernel.String.map + Elm.Kernel.String.map {-| Keep only the characters that pass the test. filter isDigit "R2-D2" == "22" + -} filter : (Char -> Bool) -> String -> String filter = - Elm.Kernel.String.filter + Elm.Kernel.String.filter {-| Reduce a string from the left. foldl cons "" "time" == "emit" + -} foldl : (Char -> b -> b) -> b -> String -> b foldl = - Elm.Kernel.String.foldl + Elm.Kernel.String.foldl {-| Reduce a string from the right. foldr cons "" "time" == "time" + -} foldr : (Char -> b -> b) -> b -> String -> b foldr = - Elm.Kernel.String.foldr + Elm.Kernel.String.foldr -{-| Determine whether *any* characters pass the test. +{-| Determine whether _any_ characters pass the test. any isDigit "90210" == True + any isDigit "R2-D2" == True + any isDigit "heart" == False + -} any : (Char -> Bool) -> String -> Bool any = - Elm.Kernel.String.any + Elm.Kernel.String.any -{-| Determine whether *all* characters pass the test. +{-| Determine whether _all_ characters pass the test. all isDigit "90210" == True + all isDigit "R2-D2" == False + all isDigit "heart" == False + -} all : (Char -> Bool) -> String -> Bool all = - Elm.Kernel.String.all + Elm.Kernel.String.all diff --git a/src/Task.elm b/src/Task.elm index 1a9cbf7b..4c5fc3dc 100644 --- a/src/Task.elm +++ b/src/Task.elm @@ -1,45 +1,50 @@ -effect module Task where { command = MyCmd } exposing - ( Task - , succeed, fail - , map, map2, map3, map4, map5 - , sequence - , andThen - , onError, mapError - , perform, attempt - ) +module Task exposing + ( Task, perform, attempt + , andThen, succeed, fail, sequence + , map, map2, map3, map4, map5 + , onError, mapError + ) {-| Tasks make it easy to describe asynchronous operations that may fail, like HTTP requests or writing to a database. + # Tasks + @docs Task, perform, attempt + # Chains + @docs andThen, succeed, fail, sequence + # Maps + @docs map, map2, map3, map4, map5 + # Errors + @docs onError, mapError -} -import Basics exposing (Never, (|>), (<<)) -import Elm.Kernel.Scheduler +import Basics exposing ((<<), (|>), Never, never) +import Elm.Kernel.Platform import List exposing ((::)) import Maybe exposing (Maybe(..)) import Platform import Platform.Cmd exposing (Cmd) +import Platform.Scheduler as Scheduler import Result exposing (Result(..)) - {-| Here are some common tasks: -- [`now : Task x Posix`][now] -- [`focus : String -> Task Error ()`][focus] -- [`sleep : Float -> Task x ()`][sleep] + - [`now : Task x Posix`][now] + - [`focus : String -> Task Error ()`][focus] + - [`sleep : Float -> Task x ()`][sleep] [now]: /packages/elm/time/latest/Time#now [focus]: /packages/elm/browser/latest/Browser-Dom#focus @@ -55,9 +60,10 @@ More generally a task is a _description_ of what you need to do. Like a todo list. Or like a grocery list. Or like GitHub issues. So saying "the task is to tell me the current POSIX time" does not complete the task! You need [`perform`](#perform) tasks or [`attempt`](#attempt) tasks. + -} type alias Task x a = - Platform.Task x a + Platform.Task x a @@ -67,31 +73,35 @@ type alias Task x a = {-| A task that succeeds immediately when run. It is usually used with [`andThen`](#andThen). You can use it like `map` if you want: - import Time -- elm install elm/time + import Time + + -- elm install elm/time timeInMillis : Task x Int timeInMillis = - Time.now - |> andThen (\t -> succeed (Time.posixToMillis t)) + Time.now + |> andThen (\t -> succeed (Time.posixToMillis t)) -} succeed : a -> Task x a succeed = - Elm.Kernel.Scheduler.succeed + Scheduler.succeed {-| A task that fails immediately when run. Like with `succeed`, this can be used with `andThen` to check on the outcome of another task. - type Error = NotFound + type Error + = NotFound notFound : Task Error a notFound = - fail NotFound + fail NotFound + -} fail : x -> Task x a fail = - Elm.Kernel.Scheduler.fail + Scheduler.fail @@ -102,75 +112,111 @@ fail = out what time it will be in one hour: import Task exposing (Task) - import Time -- elm install elm/time + import Time + + -- elm install elm/time timeInOneHour : Task x Time.Posix timeInOneHour = - Task.map addAnHour Time.now + Task.map addAnHour Time.now addAnHour : Time.Posix -> Time.Posix addAnHour time = - Time.millisToPosix (Time.posixToMillis time + 60 * 60 * 1000) + Time.millisToPosix (Time.posixToMillis time + 60 * 60 * 1000) [time]: /packages/elm/time/latest/ + -} map : (a -> b) -> Task x a -> Task x b map func taskA = - taskA - |> andThen (\a -> succeed (func a)) + taskA + |> andThen (\a -> succeed (func a)) {-| Put the results of two tasks together. For example, if we wanted to know the current month, we could use [`elm/time`][time] to ask: import Task exposing (Task) - import Time -- elm install elm/time + import Time + + -- elm install elm/time getMonth : Task x Int getMonth = - Task.map2 Time.toMonth Time.here Time.now + Task.map2 Time.toMonth Time.here Time.now **Note:** Say we were doing HTTP requests instead. `map2` does each task in order, so it would try the first request and only continue after it succeeds. If it fails, the whole thing fails! [time]: /packages/elm/time/latest/ + -} map2 : (a -> b -> result) -> Task x a -> Task x b -> Task x result map2 func taskA taskB = - taskA - |> andThen (\a -> taskB - |> andThen (\b -> succeed (func a b))) + taskA + |> andThen + (\a -> + taskB + |> andThen (\b -> succeed (func a b)) + ) -{-|-} +{-| -} map3 : (a -> b -> c -> result) -> Task x a -> Task x b -> Task x c -> Task x result map3 func taskA taskB taskC = - taskA - |> andThen (\a -> taskB - |> andThen (\b -> taskC - |> andThen (\c -> succeed (func a b c)))) - - -{-|-} + taskA + |> andThen + (\a -> + taskB + |> andThen + (\b -> + taskC + |> andThen (\c -> succeed (func a b c)) + ) + ) + + +{-| -} map4 : (a -> b -> c -> d -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x result map4 func taskA taskB taskC taskD = - taskA - |> andThen (\a -> taskB - |> andThen (\b -> taskC - |> andThen (\c -> taskD - |> andThen (\d -> succeed (func a b c d))))) - - -{-|-} + taskA + |> andThen + (\a -> + taskB + |> andThen + (\b -> + taskC + |> andThen + (\c -> + taskD + |> andThen (\d -> succeed (func a b c d)) + ) + ) + ) + + +{-| -} map5 : (a -> b -> c -> d -> e -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x e -> Task x result map5 func taskA taskB taskC taskD taskE = - taskA - |> andThen (\a -> taskB - |> andThen (\b -> taskC - |> andThen (\c -> taskD - |> andThen (\d -> taskE - |> andThen (\e -> succeed (func a b c d e)))))) + taskA + |> andThen + (\a -> + taskB + |> andThen + (\b -> + taskC + |> andThen + (\c -> + taskD + |> andThen + (\d -> + taskE + |> andThen (\e -> succeed (func a b c d e)) + ) + ) + ) + ) {-| Start with a list of tasks, and turn them into a single task that returns a @@ -182,7 +228,7 @@ sequence fails. -} sequence : List (Task x a) -> Task x (List a) sequence tasks = - List.foldr (map2 (::)) (succeed []) tasks + List.foldr (map2 (::)) (succeed []) tasks @@ -194,19 +240,23 @@ successful, you give the result to the callback resulting in another task. This task then gets run. We could use this to make a task that resolves an hour from now: - import Time -- elm install elm/time + -- elm install elm/time + + import Process + import Time timeInOneHour : Task x Time.Posix timeInOneHour = - Process.sleep (60 * 60 * 1000) - |> andThen (\_ -> Time.now) + Process.sleep (60 * 60 * 1000) + |> andThen (\_ -> Time.now) First the process sleeps for an hour **and then** it tells us what time it is. + -} andThen : (a -> Task x b) -> Task x a -> Task x b andThen = - Elm.Kernel.Scheduler.andThen + Scheduler.andThen @@ -223,54 +273,59 @@ callback to recover. succeed 9 |> onError (\msg -> succeed 42) -- succeed 9 + -} onError : (x -> Task y a) -> Task x a -> Task y a onError = - Elm.Kernel.Scheduler.onError + Scheduler.onError {-| Transform the error value. This can be useful if you need a bunch of error types to match up. type Error - = Http Http.Error - | WebGL WebGL.Error + = Http Http.Error + | WebGL WebGL.Error getResources : Task Error Resource getResources = - sequence - [ mapError Http serverTask - , mapError WebGL textureTask - ] + sequence + [ mapError Http serverTask + , mapError WebGL textureTask + ] + -} mapError : (x -> y) -> Task x a -> Task y a mapError convert task = - task - |> onError (fail << convert) + task + |> onError (fail << convert) -- COMMANDS -type MyCmd msg = - Perform (Task Never msg) +type MyCmd msg + = Perform (Task Never msg) {-| Like I was saying in the [`Task`](#Task) documentation, just having a `Task` does not mean it is done. We must command Elm to `perform` the task: - import Time -- elm install elm/time + -- elm install elm/time + + import Task + import Time type Msg - = Click - | Search String - | NewTime Time.Posix + = Click + | Search String + | NewTime Time.Posix getNewTime : Cmd Msg getNewTime = - Task.perform NewTime Time.now + Task.perform NewTime Time.now If you have worked through [`guide.elm-lang.org`][guide] (highly recommended!) you will recognize `Cmd` from the section on The Elm Architecture. So we have @@ -278,26 +333,30 @@ changed a task like "make delicious lasagna" into a command like "Hey Elm, make delicious lasagna and give it to my `update` function as a `Msg` value." [guide]: https://guide.elm-lang.org/ + -} perform : (a -> msg) -> Task Never a -> Cmd msg perform toMessage task = - command (Perform (map toMessage task)) + performHelp (map toMessage task) {-| This is very similar to [`perform`](#perform) except it can handle failures! So we could _attempt_ to focus on a certain DOM node like this: - import Browser.Dom -- elm install elm/browser + -- elm install elm/browser + + + import Browser.Dom import Task type Msg - = Click - | Search String - | Focus (Result Browser.DomError ()) + = Click + | Search String + | Focus (Result Browser.DomError ()) focus : Cmd Msg focus = - Task.attempt Focus (Browser.Dom.focus "my-app-search-box") + Task.attempt Focus (Browser.Dom.focus "my-app-search-box") So the task is "focus on this DOM node" and we are turning it into the command "Hey Elm, attempt to focus on this DOM node and give me a `Msg` about whether @@ -307,45 +366,26 @@ you succeeded or failed." feeling for how commands fit into The Elm Architecture. [guide]: https://guide.elm-lang.org/ + -} attempt : (Result x a -> msg) -> Task x a -> Cmd msg attempt resultToMessage task = - command (Perform ( - task - |> andThen (succeed << resultToMessage << Ok) - |> onError (succeed << resultToMessage << Err) - )) - - -cmdMap : (a -> b) -> MyCmd a -> MyCmd b -cmdMap tagger (Perform task) = - Perform (map tagger task) + performHelp + (task + |> andThen (succeed << resultToMessage << Ok) + |> onError (succeed << resultToMessage << Err) + ) +performHelp : Task Never msg -> Cmd msg +performHelp task = + command (map Just task) --- MANAGER -init : Task Never () -init = - succeed () +-- kernel -- -onEffects : Platform.Router msg Never -> List (MyCmd msg) -> () -> Task Never () -onEffects router commands state = - map - (\_ -> ()) - (sequence (List.map (spawnCmd router) commands)) - - -onSelfMsg : Platform.Router msg Never -> Never -> () -> Task Never () -onSelfMsg _ _ _ = - succeed () - - -spawnCmd : Platform.Router msg Never -> MyCmd msg -> Task x () -spawnCmd router (Perform task) = - Elm.Kernel.Scheduler.spawn ( - task - |> andThen (Platform.sendToApp router) - ) +command : Platform.Task Never (Maybe msg) -> Cmd msg +command = + Elm.Kernel.Platform.command diff --git a/src/Time.elm b/src/Time.elm new file mode 100644 index 00000000..4a0f0635 --- /dev/null +++ b/src/Time.elm @@ -0,0 +1,644 @@ +module Time exposing + ( Posix, now, every, posixToMillis, millisToPosix + , Zone, utc, here + , toYear, toMonth, toDay, toWeekday, toHour, toMinute, toSecond, toMillis + , Weekday(..), Month(..) + , customZone, getZoneName, ZoneName(..) + ) + +{-| Library for working with time and time zones. + + +# Time + +@docs Posix, now, every, posixToMillis, millisToPosix + + +# Time Zones + +@docs Zone, utc, here + + +# Human Times + +@docs toYear, toMonth, toDay, toWeekday, toHour, toMinute, toSecond, toMillis + + +# Weeks and Months + +@docs Weekday, Month + + +# For Package Authors + +@docs customZone, getZoneName, ZoneName + +-} + +import Basics exposing (..) +import Dict +import Elm.Kernel.Platform +import Elm.Kernel.Time +import List exposing ((::)) +import Maybe exposing (Maybe(..)) +import Platform +import Platform.Raw.Sub as RawSub +import Platform.Sub exposing (Sub) +import Process +import String exposing (String) +import Task exposing (Task) +import Tuple + + + +-- POSIX + + +{-| A computer representation of time. It is the same all over Earth, so if we +have a phone call or meeting at a certain POSIX time, there is no ambiguity. + +It is very hard for humans to _read_ a POSIX time though, so we use functions +like [`toHour`](#toHour) and [`toMinute`](#toMinute) to `view` them. + +-} +type Posix + = Posix Int + + +{-| Get the POSIX time at the moment when this task is run. +-} +now : Task x Posix +now = + Elm.Kernel.Time.now millisToPosix + + +{-| Turn a `Posix` time into the number of milliseconds since 1970 January 1 +at 00:00:00 UTC. It was a Thursday. +-} +posixToMillis : Posix -> Int +posixToMillis (Posix millis) = + millis + + +{-| Turn milliseconds into a `Posix` time. +-} +millisToPosix : Int -> Posix +millisToPosix = + Posix + + + +-- TIME ZONES + + +{-| Information about a particular time zone. + +The [IANA Time Zone Database][iana] tracks things like UTC offsets and +daylight-saving rules so that you can turn a `Posix` time into local times +within a time zone. + +See [`utc`](#utc) and [`here`](#here) to learn how to obtain `Zone` values. + +[iana]: https://www.iana.org/time-zones + +-} +type Zone + = Zone Int (List Era) + + + +-- TODO: add this note back to `Zone` docs when it is true +-- +-- Did you know that in California the times change from 3pm PST to 3pm PDT to +-- capture whether it is daylight-saving time? The database tracks those +-- abbreviation changes too. (Tons of time zones do that actually.) +-- + + +{-| Currently the public API only needs: + + - `start` is the beginning of this `Era` in "minutes since the Unix Epoch" + - `offset` is the UTC offset of this `Era` in minutes + +But eventually, it will make sense to have `abbr : String` for `PST` vs `PDT` + +-} +type alias Era = + { start : Int + , offset : Int + } + + +{-| The time zone for Coordinated Universal Time ([UTC]) + +The `utc` zone has no time adjustments. It never observes daylight-saving +time and it never shifts around based on political restructuring. + +[UTC]: https://en.wikipedia.org/wiki/Coordinated_Universal_Time + +-} +utc : Zone +utc = + Zone 0 [] + + +{-| Produce a `Zone` based on the current UTC offset. You can use this to figure +out what day it is where you are: + + import Task exposing (Task) + import Time + + whatDayIsIt : Task x Int + whatDayIsIt = + Task.map2 Time.toDay Time.here Time.now + +**Accuracy Note:** This function can only give time zones like `Etc/GMT+9` or +`Etc/GMT-6`. It cannot give you `Europe/Stockholm`, `Asia/Tokyo`, or any other +normal time zone from the [full list][tz] due to limitations in JavaScript. +For example, if you run `here` in New York City, the resulting `Zone` will +never be `America/New_York`. Instead you get `Etc/GMT-5` or `Etc/GMT-4` +depending on Daylight Saving Time. So even though browsers must have internal +access to `America/New_York` to figure out that offset, there is no public API +to get the full information. This means the `Zone` you get from this function +will act weird if (1) an application stays open across a Daylight Saving Time +boundary or (2) you try to use it on historical data. + +**Future Note:** We can improve `here` when there is good browser support for +JavaScript functions that (1) expose the IANA time zone database and (2) let +you ask the time zone of the computer. The committee that reviews additions to +JavaScript is called TC39, and I encourage you to push for these capabilities! I +cannot do it myself unfortunately. + +**Alternatives:** See the `customZone` docs to learn how to implement stopgaps. + +[tz]: https://en.wikipedia.org/wiki/List_of_tz_database_time_zones + +-} +here : Task x Zone +here = + Elm.Kernel.Time.here () + + + +-- DATES + + +{-| What year is it?! + + import Time exposing (toYear, utc, millisToPosix) + + toYear utc (millisToPosix 0) == 1970 + toYear nyc (millisToPosix 0) == 1969 + + -- pretend `nyc` is the `Zone` for America/New_York. + +-} +toYear : Zone -> Posix -> Int +toYear zone time = + (toCivil (toAdjustedMinutes zone time)).year + + +{-| What month is it?! + + import Time exposing (toMonth, utc, millisToPosix) + + toMonth utc (millisToPosix 0) == Jan + toMonth nyc (millisToPosix 0) == Dec + + -- pretend `nyc` is the `Zone` for America/New_York. + +-} +toMonth : Zone -> Posix -> Month +toMonth zone time = + case (toCivil (toAdjustedMinutes zone time)).month of + 1 -> + Jan + + 2 -> + Feb + + 3 -> + Mar + + 4 -> + Apr + + 5 -> + May + + 6 -> + Jun + + 7 -> + Jul + + 8 -> + Aug + + 9 -> + Sep + + 10 -> + Oct + + 11 -> + Nov + + _ -> + Dec + + +{-| What day is it?! (Days go from 1 to 31) + + import Time exposing (toDay, utc, millisToPosix) + + toDay utc (millisToPosix 0) == 1 + toDay nyc (millisToPosix 0) == 31 + + -- pretend `nyc` is the `Zone` for America/New_York. + +-} +toDay : Zone -> Posix -> Int +toDay zone time = + (toCivil (toAdjustedMinutes zone time)).day + + +{-| What day of the week is it? + + import Time exposing (toWeekday, utc, millisToPosix) + + toWeekday utc (millisToPosix 0) == Thu + toWeekday nyc (millisToPosix 0) == Wed + + -- pretend `nyc` is the `Zone` for America/New_York. + +-} +toWeekday : Zone -> Posix -> Weekday +toWeekday zone time = + case modBy 7 (flooredDiv (toAdjustedMinutes zone time) (60 * 24)) of + 0 -> + Thu + + 1 -> + Fri + + 2 -> + Sat + + 3 -> + Sun + + 4 -> + Mon + + 5 -> + Tue + + _ -> + Wed + + +{-| What hour is it? (From 0 to 23) + + import Time exposing (toHour, utc, millisToPosix) + + toHour utc (millisToPosix 0) == 0 -- 12am + toHour nyc (millisToPosix 0) == 19 -- 7pm + + -- pretend `nyc` is the `Zone` for America/New_York. + +-} +toHour : Zone -> Posix -> Int +toHour zone time = + modBy 24 (flooredDiv (toAdjustedMinutes zone time) 60) + + +{-| What minute is it? (From 0 to 59) + + import Time exposing (toMinute, utc, millisToPosix) + + toMinute utc (millisToPosix 0) == 0 + +This can be different in different time zones. Some time zones are offset +by 30 or 45 minutes! + +-} +toMinute : Zone -> Posix -> Int +toMinute zone time = + modBy 60 (toAdjustedMinutes zone time) + + +{-| What second is it? + + import Time exposing (toSecond, utc, millisToPosix) + + toSecond utc (millisToPosix 0) == 0 + toSecond utc (millisToPosix 1234) == 1 + toSecond utc (millisToPosix 5678) == 5 + +-} +toSecond : Zone -> Posix -> Int +toSecond _ time = + modBy 60 (flooredDiv (posixToMillis time) 1000) + + +{-| + + import Time exposing (toMillis, utc, millisToPosix) + + toMillis utc (millisToPosix 0) == 0 + toMillis utc (millisToPosix 1234) == 234 + toMillis utc (millisToPosix 5678) == 678 + +-} +toMillis : Zone -> Posix -> Int +toMillis _ time = + modBy 1000 (posixToMillis time) + + + +-- DATE HELPERS + + +toAdjustedMinutes : Zone -> Posix -> Int +toAdjustedMinutes (Zone defaultOffset eras) time = + toAdjustedMinutesHelp defaultOffset (flooredDiv (posixToMillis time) 60000) eras + + +toAdjustedMinutesHelp : Int -> Int -> List Era -> Int +toAdjustedMinutesHelp defaultOffset posixMinutes eras = + case eras of + [] -> + posixMinutes + defaultOffset + + era :: olderEras -> + if era.start < posixMinutes then + posixMinutes + era.offset + + else + toAdjustedMinutesHelp defaultOffset posixMinutes olderEras + + +toCivil : Int -> { year : Int, month : Int, day : Int } +toCivil minutes = + let + rawDay = + flooredDiv minutes (60 * 24) + 719468 + + era = + (if rawDay >= 0 then + rawDay + + else + rawDay - 146096 + ) + // 146097 + + dayOfEra = + rawDay - era * 146097 + + -- [0, 146096] + yearOfEra = + (dayOfEra - dayOfEra // 1460 + dayOfEra // 36524 - dayOfEra // 146096) // 365 + + -- [0, 399] + year = + yearOfEra + era * 400 + + dayOfYear = + dayOfEra - (365 * yearOfEra + yearOfEra // 4 - yearOfEra // 100) + + -- [0, 365] + mp = + (5 * dayOfYear + 2) // 153 + + -- [0, 11] + month = + mp + + (if mp < 10 then + 3 + + else + -9 + ) + + -- [1, 12] + in + { year = + year + + (if month <= 2 then + 1 + + else + 0 + ) + , month = month + , day = dayOfYear - (153 * mp + 2) // 5 + 1 -- [1, 31] + } + + +flooredDiv : Int -> Float -> Int +flooredDiv numerator denominator = + floor (toFloat numerator / denominator) + + + +-- WEEKDAYS AND MONTHS + + +{-| Represents a `Weekday` so that you can convert it to a `String` or `Int` +however you please. For example, if you need the Japanese representation, you +can say: + + toJapaneseWeekday : Weekday -> String + toJapaneseWeekday weekday = + case weekday of + Mon -> + "月" + + Tue -> + "火" + + Wed -> + "水" + + Thu -> + "木" + + Fri -> + "金" + + Sat -> + "土" + + Sun -> + "日" + +-} +type Weekday + = Mon + | Tue + | Wed + | Thu + | Fri + | Sat + | Sun + + +{-| Represents a `Month` so that you can convert it to a `String` or `Int` +however you please. For example, if you need the Danish representation, you +can say: + + toDanishMonth : Month -> String + toDanishMonth month = + case month of + Jan -> + "januar" + + Feb -> + "februar" + + Mar -> + "marts" + + Apr -> + "april" + + May -> + "maj" + + Jun -> + "juni" + + Jul -> + "juli" + + Aug -> + "august" + + Sep -> + "september" + + Oct -> + "oktober" + + Nov -> + "november" + + Dec -> + "december" + +-} +type Month + = Jan + | Feb + | Mar + | Apr + | May + | Jun + | Jul + | Aug + | Sep + | Oct + | Nov + | Dec + + + +-- SUBSCRIPTIONS + + +{-| Get the current time periodically. How often though? Well, you provide an +interval in milliseconds (like `1000` for a second or `60 * 1000` for a minute +or `60 * 60 * 1000` for an hour) and that is how often you get a new time! + +Check out [this example](https://elm-lang.org/examples/time) to see how to use +it in an application. + +**This function is not for animation.** Use the [`onAnimationFrame`][af] +function for that sort of thing! It syncs up with repaints and will end up +being much smoother for any moving visuals. + +[af]: /packages/elm/browser/latest/Browser-Events#onAnimationFrame + +-} +every : Float -> (Posix -> msg) -> Sub msg +every interval tagger = + subscription (setInterval interval) (\f -> tagger (millisToPosix (round f))) + + +setInterval : Float -> RawSub.Id +setInterval = + Elm.Kernel.Time.setInterval + + +subscription : RawSub.Id -> (Float -> msg) -> Sub msg +subscription = + Elm.Kernel.Platform.subscription + + + +-- FOR PACKAGE AUTHORS + + +{-| **Intended for package authors.** + +The documentation of [`here`](#here) explains that it has certain accuracy +limitations that block on adding new APIs to JavaScript. The `customZone` +function is a stopgap that takes: + +1. A default offset in minutes. So `Etc/GMT-5` is `customZone (-5 * 60) []` + and `Etc/GMT+9` is `customZone (9 * 60) []`. +2. A list of exceptions containing their `start` time in "minutes since the Unix + epoch" and their `offset` in "minutes from UTC" + +Human times will be based on the nearest `start`, falling back on the default +offset if the time is older than all of the exceptions. + +When paired with `getZoneName`, this allows you to load the real IANA time zone +database however you want: HTTP, cache, hardcode, etc. + +**Note:** If you use this, please share your work in an Elm community forum! +I am sure others would like to hear about it, and more experience reports will +help me and the any potential TC39 proposal. + +-} +customZone : Int -> List { start : Int, offset : Int } -> Zone +customZone = + Zone + + +{-| **Intended for package authors.** + +Use `Intl.DateTimeFormat().resolvedOptions().timeZone` to try to get names +like `Europe/Moscow` or `America/Havana`. From there you can look it up in any +IANA data you loaded yourself. + +-} +getZoneName : Task x ZoneName +getZoneName = + Elm.Kernel.Time.getZoneName () + + +{-| **Intended for package authors.** + +The `getZoneName` function relies on a JavaScript API that is not supported +in all browsers yet, so it can return the following: + + -- in more recent browsers + Name "Europe/Moscow" + + Name "America/Havana" + + -- in older browsers + Offset 180 + + Offset -300 + +So if the real info is not available, it will tell you the current UTC offset +in minutes, just like what `here` uses to make zones like `customZone -60 []`. + +-} +type ZoneName + = Name String + | Offset Int diff --git a/src/Tuple.elm b/src/Tuple.elm index a92436a7..d6980d4c 100644 --- a/src/Tuple.elm +++ b/src/Tuple.elm @@ -1,18 +1,18 @@ module Tuple exposing - ( pair - , first, second - , mapFirst, mapSecond, mapBoth - ) + ( pair + , first, second + , mapFirst, mapSecond, mapBoth + ) {-| Elm has built-in syntax for tuples, so you can define 2D points like this: - origin : (Float, Float) + origin : ( Float, Float ) origin = - (0, 0) + ( 0, 0 ) - position : (Float, Float) + position : ( Float, Float ) position = - (3, 4) + ( 3, 4 ) This module is a bunch of helpers for working with 2-tuples. @@ -27,33 +27,37 @@ info on this. (Picking appropriate data structures is super important in Elm!) [ut]: https://robots.thoughtbot.com/modeling-with-union-types + # Create + @docs pair + # Access + @docs first, second + # Map + @docs mapFirst, mapSecond, mapBoth -} - - -- CREATE {-| Create a 2-tuple. -- pair 3 4 == (3, 4) - - zip : List a -> List b -> List (a, b) + zip : List a -> List b -> List ( a, b ) zip xs ys = - List.map2 Tuple.pair xs ys + List.map2 Tuple.pair xs ys + -} -pair : a -> b -> (a, b) +pair : a -> b -> ( a, b ) pair a b = - (a, b) + ( a, b ) @@ -62,22 +66,26 @@ pair a b = {-| Extract the first value from a tuple. - first (3, 4) == 3 - first ("john", "doe") == "john" + first ( 3, 4 ) == 3 + + first ( "john", "doe" ) == "john" + -} -first : (a, b) -> a -first (x,_) = - x +first : ( a, b ) -> a +first ( x, _ ) = + x {-| Extract the second value from a tuple. - second (3, 4) == 4 - second ("john", "doe") == "doe" + second ( 3, 4 ) == 4 + + second ( "john", "doe" ) == "doe" + -} -second : (a, b) -> b -second (_,y) = - y +second : ( a, b ) -> b +second ( _, y ) = + y @@ -90,20 +98,23 @@ second (_,y) = mapFirst String.reverse ("stressed", 16) == ("desserts", 16) mapFirst String.length ("stressed", 16) == (8, 16) + -} -mapFirst : (a -> x) -> (a, b) -> (x, b) -mapFirst func (x,y) = - (func x, y) +mapFirst : (a -> x) -> ( a, b ) -> ( x, b ) +mapFirst func ( x, y ) = + ( func x, y ) {-| Transform the second value in a tuple. - mapSecond sqrt ("stressed", 16) == ("stressed", 4) - mapSecond negate ("stressed", 16) == ("stressed", -16) + mapSecond sqrt ( "stressed", 16 ) == ( "stressed", 4 ) + + mapSecond negate ( "stressed", 16 ) == ( "stressed", -16 ) + -} -mapSecond : (b -> y) -> (a, b) -> (a, y) -mapSecond func (x,y) = - (x, func y) +mapSecond : (b -> y) -> ( a, b ) -> ( a, y ) +mapSecond func ( x, y ) = + ( x, func y ) {-| Transform both parts of a tuple. @@ -112,7 +123,8 @@ mapSecond func (x,y) = mapBoth String.reverse sqrt ("stressed", 16) == ("desserts", 4) mapBoth String.length negate ("stressed", 16) == (8, -16) + -} -mapBoth : (a -> x) -> (b -> y) -> (a, b) -> (x, y) -mapBoth funcA funcB (x,y) = - ( funcA x, funcB y ) +mapBoth : (a -> x) -> (b -> y) -> ( a, b ) -> ( x, y ) +mapBoth funcA funcB ( x, y ) = + ( funcA x, funcB y ) diff --git a/stub.py b/stub.py new file mode 100755 index 00000000..48607cd4 --- /dev/null +++ b/stub.py @@ -0,0 +1,54 @@ +#! /usr/bin/env python3 + +import os +import sys +import shutil +import json +import random +import string + +versions_dir = sys.argv[1] + +for v in os.listdir(versions_dir): + version = os.path.join(versions_dir, v) + src_dir = os.path.join(version, "src") + stub_file = os.path.join(version, "stub") + elm_json_path = os.path.join(version, "elm.json") + + package_name = None + with open(elm_json_path, 'r') as f: + package_name = json.load(f)["name"] + + dummy_module = "P{}".format(''.join( + [random.choice(string.ascii_letters) for n in range(32)] + )) + dummy_path = os.path.join(src_dir, "{}.elm".format(dummy_module)) + + shutil.rmtree(version) + os.makedirs(src_dir) + + with open(stub_file, 'w'): + pass + + with open(dummy_path, 'w') as f: + f.write("""module {} exposing (..) + +a = 2 +""".format(dummy_module)) + + with open(elm_json_path, 'w') as f: + f.write(""" {{ + "type": "package", + "name": "{}", + "summary": "Encode and decode JSON values", + "license": "BSD-3-Clause", + "version": "{}", + "exposed-modules": [ + "{}" + ], + "elm-version": "0.19.0 <= v < 0.20.0", + "dependencies": {{ + "elm/core": "1.0.0 <= v < 2.0.0" + }}, + "test-dependencies": {{}} +}}""".format(package_name, v, dummy_module)) diff --git a/tests/check-kernel-imports.js b/tests/check-kernel-imports.js new file mode 100755 index 00000000..1646f6be --- /dev/null +++ b/tests/check-kernel-imports.js @@ -0,0 +1,297 @@ +#! /usr/bin/env node + +const path = require("path"); +const fs = require("fs"); +const readline = require("readline"); + +async function* getFiles(dir) { + const dirents = await fs.promises.readdir(dir, { withFileTypes: true }); + for (const dirent of dirents) { + const res = path.resolve(dir, dirent.name); + if (dirent.isDirectory()) { + yield* getFiles(res); + } else { + yield res; + } + } +} + +class CallLocation { + constructor(path, line) { + this.path = path; + this.line = line; + Object.freeze(this); + } +} + +function addCall(map, call, location) { + let callArray = (() => { + if (!map.has(call)) { + const a = []; + map.set(call, a); + return a; + } + return map.get(call); + })(); + + callArray.push(location); +} + +async function* withLineNumbers(rl) { + let i = 1; + for await (const line of rl) { + yield { line, number: i }; + i += 1; + } +} + +async function processElmFile(file, elmDefinitions, kernelCalls) { + const lines = withLineNumbers( + readline.createInterface({ + input: fs.createReadStream(file), + }) + ); + + let moduleName = null; + const kernelImports = new Map(); + + const errors = []; + const warnings = []; + + function addDef(defName) { + if (moduleName === null) { + errors.push( + `Elm definition before module line (or missing module line) at ${file}:${number}.` + ); + } + elmDefinitions.add(`${moduleName}.${defName}`); + } + + for await (const { number, line } of lines) { + const moduleNameMatch = line.match(/module\s*(\S+)\s.*exposing/u); + if (moduleNameMatch !== null) { + if (moduleName !== null) { + errors.push(`Duplicate module line at ${file}:${number}.`); + } + moduleName = moduleNameMatch[1]; + } + + const importMatch = line.match(/^import\s+(Elm\.Kernel\.\w+)/u); + if (importMatch !== null) { + kernelImports.set(importMatch[1], false); + } else { + const elmVarMatch = line.match(/^(\S*).*?=/u); + if (elmVarMatch !== null) { + addDef(elmVarMatch[1]); + } + + const elmTypeMatch = line.match(/type\s+(?:alias\s+)?(\S+)/u); + if (elmTypeMatch !== null) { + addDef(elmTypeMatch[1]); + } + + const elmCustomTypeMatch = line.match(/ [=|] (\w*)/u); + if (elmCustomTypeMatch !== null) { + addDef(elmCustomTypeMatch[1]); + } + + const kernelCallMatch = line.match(/(Elm\.Kernel\.\w+).\w+/u); + if (kernelCallMatch !== null) { + const kernelCall = kernelCallMatch[0]; + const kernelModule = kernelCallMatch[1]; + if (kernelImports.has(kernelModule)) { + kernelImports.set(kernelModule, true); + } else { + errors.push(`Kernel call ${kernelCall} at ${file}:${number} missing import`); + } + addCall(kernelCalls, kernelCall, new CallLocation(file, number)); + } + } + } + + for (const [kernelModule, used] of kernelImports.entries()) { + if (!used) { + warnings.push(`Kernel import of ${kernelModule} is unused in ${file}`); + } + } + + return { errors, warnings }; +} + +async function processJsFile(file, importedDefs, kernelDefinitions) { + const lines = withLineNumbers( + readline.createInterface({ + input: fs.createReadStream(file), + }) + ); + + const moduleName = path.basename(file, ".js"); + + const imports = new Map(); + + const errors = []; + const warnings = []; + + for await (const { number, line } of lines) { + const importMatch = line.match( + /import\s+((?:(?:\w|\.)+\.)?(\w+))\s+(?:as (\w+)\s+)?exposing\s+\((\w+(?:,\s+\w+)*)\)/ + ); + if (importMatch !== null) { + // use alias if it is there, otherwise use last part of import. + const moduleAlias = importMatch[3] !== undefined ? importMatch[3] : importMatch[2]; + const importedModulePath = importMatch[1]; + for (const defName of importMatch[4].split(",").map((s) => s.trim())) { + imports.set(`__${moduleAlias}_${defName}`, false); + + const callFullPath = `${importedModulePath}.${defName}`; + addCall(importedDefs, callFullPath, new CallLocation(file, number)); + } + continue; + } + + let defMatch = line.match(/^(?:var|const|let)\s*(_(\w+?)_(\w+))\s*=/u); + if (defMatch === null) { + defMatch = line.match(/^function\s*(_(\w+?)_(\w+))\s*\(/u); + } + if (defMatch !== null) { + if (defMatch[2] !== moduleName) { + errors.push( + `Kernel definition ${defMatch[1]} at ${file}:${number} should match _${moduleName}_*` + ); + } + let defName = defMatch[3]; + if (defName.endsWith("__DEBUG")) { + defName = defName.substr(0, defName.length - "__DEBUG".length); + } else if (defName.endsWith("__PROD")) { + defName = defName.substr(0, defName.length - "__PROD".length); + } + // todo(Harry): check __DEBUG and __PROD match. + + kernelDefinitions.add(`Elm.Kernel.${moduleName}.${defName}`); + } + + let index = 0; + while (true) { + const kernelCallMatch = line.substr(index).match(/_?_(\w+?)_\w+/u); + if (kernelCallMatch === null) { + break; + } else { + const calledModuleName = kernelCallMatch[1]; + const kernelCall = kernelCallMatch[0]; + if (calledModuleName[0] === calledModuleName[0].toUpperCase()) { + if (kernelCall.startsWith("__")) { + // External kernel call + if (imports.has(kernelCall)) { + imports.set(kernelCall, true); + } else { + errors.push(`Kernel call ${kernelCall} at ${file}:${number} missing import`); + } + } else { + if (calledModuleName !== moduleName) { + errors.push( + `${calledModuleName} === ${moduleName} Non-local kernel call ${kernelCall} at ${file}:${number} must start with a double underscore` + ); + } + } + } + index += kernelCallMatch.index + kernelCallMatch[0].length; + } + } + } + + for (const [kernelModule, used] of imports.entries()) { + if (!used) { + warnings.push(`Import of ${kernelModule} is unused in ${file}`); + } + } + + return { errors, warnings }; +} + +async function main() { + if (process.argv.length !== 3) { + console.error("check-kernel-imports: error! path to source directories required"); + process.exit(1); + } + + if (process.argv.includes("-h") || process.argv.includes("--help")) { + console.log( + ` + +Usage: check-kernel-imports SOURCE_DIRECTORY + +check-kernel-imports checks that + 1. Use of kernel definitions match imports in elm files. + 2. Use of kernel definition in elm files match a definition in a javascipt + file. + 3. Use of elm definition in javascript files matches definition in an elm + file. + 4. Use of an external definition matches an import in a javascript file. +Note that 3. is a best effort attempt. There are some missed cases and some +false postives. Warnings will be issued for unused imports in javascript files. + +Options: + -h, --help display this help and exit + + `.trim() + ); + process.exit(0); + } + + const sourceDir = process.argv[2]; + + // keys: kernel definition full elm path + const kernelDefinitions = new Set(); + // keys: elm definition full elm path + const elmDefinitions = new Set(); + // keys: kernel call, values: array of CallLocations + const kernelCalls = new Map(); + // keys: full elm path of call, values: array of CallLocations + const elmCallsFromKernel = new Map(); + + // Add some definitions from elm/json + elmDefinitions.add("Elm.Kernel.Json.run"); + elmDefinitions.add("Elm.Kernel.Json.wrap"); + elmDefinitions.add("Elm.Kernel.Json.unwrap"); + elmDefinitions.add("Elm.Kernel.Json.errorToString"); + + const allErrors = []; + const allWarnings = []; + + for await (const f of getFiles(sourceDir)) { + const extname = path.extname(f); + if (extname === ".elm") { + const { errors, warnings } = await processElmFile(f, elmDefinitions, kernelCalls); + allErrors.push(...errors); + allWarnings.push(...warnings); + } else if (extname === ".js") { + const { errors, warnings } = await processJsFile(f, elmCallsFromKernel, kernelDefinitions); + allErrors.push(...errors); + allWarnings.push(...warnings); + } + } + for (const [call, locations] of kernelCalls.entries()) { + if (!kernelDefinitions.has(call)) { + for (const location of locations) { + allErrors.push( + `Kernel call ${call} at ${location.path}:${location.line} missing definition` + ); + } + } + } + for (const [call, locations] of elmCallsFromKernel.entries()) { + if (!elmDefinitions.has(call) && !kernelDefinitions.has(call)) { + for (const location of locations) { + allErrors.push(`Import of ${call} at ${location.path}:${location.line} missing definition`); + } + } + } + console.error(`${allWarnings.length} warnings`); + console.error(allWarnings.join("\n")); + console.error(""); + console.error(`${allErrors.length} errors`); + console.error(allErrors.join("\n")); + process.exitCode = allErrors.length === 0 ? 0 : 1; +} + +main(); diff --git a/tests/elm.json b/tests/elm.json index 3c64414c..cbd6a1f6 100644 --- a/tests/elm.json +++ b/tests/elm.json @@ -4,12 +4,10 @@ "elm-version": "0.19.1", "dependencies": { "direct": { - "elm/browser": "1.0.1", - "elm/core": "1.0.2", - "elm/html": "1.0.0" + "elm/core": "1.0.5" }, "indirect": { - "elm/json": "1.1.2", + "elm/json": "1.1.3", "elm/time": "1.0.0", "elm/url": "1.0.0", "elm/virtual-dom": "1.0.2" diff --git a/tests/run-tests.sh b/tests/run-tests.sh index b00aaa6e..4bbd17b6 100755 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -8,63 +8,12 @@ if [ -z "${ELM_TEST:-}" ]; then ELM_TEST=elm-test; fi -# since elm/core is treated specially by the compiler (it's always -# inserted as a dependency even when not declared explicitly), we use -# a bit of a hack to make the tests run against the local source code -# rather than the elm/core source fetched from package.elm-lang.org. - -# create a local directory where the compiler will look for the -# elm/core source code: - DIR="$(dirname $0)"; cd "$DIR"; export ELM_HOME="$(pwd)/.elm"; -rm -rf "$ELM_HOME" && mkdir -p "$ELM_HOME"; - -# elm-test also puts some things in elm-stuff, start with a clean -# slate there as well - -rm -rf elm-stuff; - -# now make an initial run of the tests to populate .elm and elm-stuff; -# this will test against elm/core from package.elm-lang.org, so we -# don't really care what the results are; we just need to force all -# the *other* dependencies to be fetched and set up. - -echo "seeding framework for test dependencies ..."; - -# '|| true' lets us ignore failures here and keep the script running. -# useful when developing a fix for a bug that exists in the version of -# elm/core hosted on package.elm-lang.org -"${ELM_TEST}" tests/Main.elm --fuzz=1 > /dev/null || true; - -# clear out the copy of elm-core fetched by the above and replace it -# with the local source code we want to actually test - -VERSION_DIR="$(ls ${ELM_HOME}/0.19.1/packages/elm/core/)" -CORE_PACKAGE_DIR="${ELM_HOME}/0.19.1/packages/elm/core/$VERSION_DIR" -CORE_GIT_DIR="$(dirname $PWD)" - -echo; -echo "Linking $CORE_PACKAGE_DIR to $CORE_GIT_DIR" -echo; - -rm -rf "$CORE_PACKAGE_DIR" -ln -sv "$CORE_GIT_DIR" "$CORE_PACKAGE_DIR" -rm -vf "${CORE_GIT_DIR}"/*.dat "${CORE_GIT_DIR}"/doc*.json - -# we also need to clear out elm-test's elm-stuff dir, since otherwise -# the compiler complains that its .dat files are out of sync - -rm -rf elm-stuff; - -# now we can run the tests against the symlinked source code for real - -echo; -echo "running tests ..."; -echo; +../custom-core.sh .. -"${ELM_TEST}" tests/Main.elm "$@"; +"${ELM_TEST}" "$@"; diff --git a/tests/tests/Main.elm b/tests/tests/Main.elm deleted file mode 100644 index 51bef482..00000000 --- a/tests/tests/Main.elm +++ /dev/null @@ -1,40 +0,0 @@ -module Main exposing (..) - -import Basics exposing (..) -import Task exposing (..) -import Test exposing (..) -import Platform.Cmd exposing (Cmd) -import Json.Decode exposing (Value) -import Test.Runner.Node exposing (run, TestProgram) -import Test.Array as Array -import Test.Basics as Basics -import Test.Bitwise as Bitwise -import Test.Char as Char -import Test.CodeGen as CodeGen -import Test.Dict as Dict -import Test.Maybe as Maybe -import Test.Equality as Equality -import Test.List as List -import Test.Result as Result -import Test.Set as Set -import Test.String as String -import Test.Tuple as Tuple - - -tests : Test -tests = - describe "Elm Standard Library Tests" - [ Array.tests - , Basics.tests - , Bitwise.tests - , Char.tests - , CodeGen.tests - , Dict.tests - , Equality.tests - , List.tests - , Result.tests - , Set.tests - , String.tests - , Maybe.tests - , Tuple.tests - ] diff --git a/tests/tests/Test/Array.elm b/tests/tests/Test/Array.elm index 3ce7e19e..af8c6735 100644 --- a/tests/tests/Test/Array.elm +++ b/tests/tests/Test/Array.elm @@ -20,6 +20,7 @@ tests = , transformTests , sliceTests , runtimeCrashTests + , equalityTests ] @@ -305,3 +306,20 @@ runtimeCrashTests = in Expect.equal res res ] + +equalityTests : Test +equalityTests = + describe "Equality of arrays" + [ fuzz (Fuzz.list Fuzz.int) "int" <| + \l -> + Array.fromList l + |> Expect.equal (Array.fromList l) + , fuzz (Fuzz.list Fuzz.string) "string" <| + \l -> + Array.fromList l + |> Expect.equal (Array.fromList l) + , fuzz (Fuzz.list Fuzz.float) "float" <| + \l -> + Array.fromList l + |> Expect.equal (Array.fromList l) + ] diff --git a/tests/tests/Test/Basics.elm b/tests/tests/Test/Basics.elm index 323ae15d..bcc72621 100644 --- a/tests/tests/Test/Basics.elm +++ b/tests/tests/Test/Basics.elm @@ -10,6 +10,7 @@ import Expect exposing (FloatingPointTolerance(..)) import List import String import Debug exposing (toString) +import Fuzz tests : Test @@ -35,6 +36,8 @@ tests = , test "compare 'f' 'f'" <| \() -> Expect.equal EQ (compare 'f' 'f') , test "compare (1, 2, 3) (0, 1, 2)" <| \() -> Expect.equal GT (compare ( 1, 2, 3 ) ( 0, 1, 2 )) , test "compare ['a'] ['b']" <| \() -> Expect.equal LT (compare [ 'a' ] [ 'b' ]) + , test "compare [ 2 ] [ 2, 1]" <| \() -> Expect.equal LT (compare [ 2 ] [ 2, 1 ]) + , test "compare [ 1, 2 ] [ 1.5 ]" <| \() -> Expect.equal LT (compare [ 1, 2 ] [ 1.5 ]) , test "array equality" <| \() -> Expect.equal (Array.fromList [ 1, 1, 1, 1 ]) (Array.repeat 4 1) , test "set equality" <| \() -> Expect.equal (Set.fromList [ 1, 2 ]) (Set.fromList [ 2, 1 ]) , test "dict equality" <| \() -> Expect.equal (Dict.fromList [ ( 1, 1 ), ( 2, 2 ) ]) (Dict.fromList [ ( 2, 2 ), ( 1, 1 ) ]) @@ -202,6 +205,24 @@ tests = |> Expect.equal [ "SaN" ] ] ] + + operatorTests = + describe "Operators" + [ describe "Comutivity" + [ fuzz2 Fuzz.int Fuzz.int "Int + Int" <| \a b -> Expect.equal (a + b) (b + a) + , fuzz2 Fuzz.float Fuzz.float "Float + Float" <| \a b -> Expect.within (AbsoluteOrRelative 1e-10 1e-10) (a + b) (b + a) + , fuzz2 Fuzz.int Fuzz.int "Int - Int" <| \a b -> Expect.equal (a - b) (-(b - a)) + , fuzz2 Fuzz.float Fuzz.float "Float - Float" <| \a b -> Expect.within (AbsoluteOrRelative 1e-10 1e-10) (a - b) (-(b - a)) + , fuzz2 Fuzz.int Fuzz.int "Int * Int" <| \a b -> Expect.equal (a * b) (b * a) + , fuzz2 Fuzz.float Fuzz.float "Float * Float" <| \a b -> Expect.within (AbsoluteOrRelative 1e-10 1e-10) (a * b) (b * a) + , fuzz2 Fuzz.float Fuzz.float "Float / Float" <| + \a b -> + if b == 0 then + Expect.pass + else + Expect.within (AbsoluteOrRelative 1e-10 1e-10) (a / b) (1 / (b / a)) + ] + ] in describe "Basics" [ comparison @@ -211,4 +232,5 @@ tests = , booleanTests , miscTests , higherOrderTests + , operatorTests ] diff --git a/tests/tests/Test/List.elm b/tests/tests/Test/List.elm index 52b361f4..b78c43db 100644 --- a/tests/tests/Test/List.elm +++ b/tests/tests/Test/List.elm @@ -41,6 +41,9 @@ testListOfN n = mid = n // 2 + + possiblySingletonHi = + List.repeat (min 1 n) "hi" in describe (String.fromInt n ++ " elements") [ describe "foldl" @@ -104,6 +107,18 @@ testListOfN n = , test "long first" <| \() -> Expect.equal (map (\x -> x * 2 - 1) xs) (map2 (+) zs xs) , test "short first" <| \() -> Expect.equal (map (\x -> x * 2 - 1) xs) (map2 (+) xs zs) ] + , describe "map3" + [ test "same length" <| \() -> Expect.equal (map ((*) 3) xs) (map3 (\a b c -> a + b + c) xs xs xs) + , test "length is the shortest" <| \() -> Expect.equal possiblySingletonHi (map3 (\_ x _ -> x) xs [ "hi" ] xs) + ] + , describe "map4" + [ test "same length" <| \() -> Expect.equal (map ((*) 4) xs) (map4 (\a b c d -> a + b + c + d) xs xs xs xs) + , test "length is the shortest" <| \() -> Expect.equal possiblySingletonHi (map4 (\_ _ x _ -> x) xs xs [ "hi" ] xs) + ] + , describe "map5" + [ test "same length" <| \() -> Expect.equal (map ((*) 5) xs) (map5 (\a b c d e -> a + b + c + d + e) xs xs xs xs xs) + , test "length is the shortest" <| \() -> Expect.equal possiblySingletonHi (map5 (\_ x _ _ _ -> x) xs [ "hi" ] xs xs xs) + ] , test "unzip" <| \() -> Expect.equal ( xsNeg, xs ) (map (\x -> ( -x, x )) xs |> unzip) , describe "filterMap" [ test "none" <| \() -> Expect.equal ([]) (filterMap (\x -> Nothing) xs)