diff --git a/LICENSE b/LICENSE deleted file mode 100644 index e5e8711..0000000 --- a/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2017-present, Evan Czaplicki - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Evan Czaplicki nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md deleted file mode 100644 index fe6946e..0000000 --- a/README.md +++ /dev/null @@ -1,21 +0,0 @@ -# Elm in the Browser! - -This package allows you to create Elm programs that run in browsers. - - -## Learning Path - -**I highly recommend working through [guide.elm-lang.org][guide] to learn how to use Elm.** It is built around a learning path that introduces concepts gradually. - -[guide]: https://guide.elm-lang.org/ - -You can see the outline of that learning path in the `Browser` module. It lets you create Elm programs with the following functions: - - 1. [`sandbox`](Browser#sandbox) — react to user input, like buttons and checkboxes - 2. [`element`](Browser#element) — talk to the outside world, like HTTP and JS interop - 3. [`document`](Browser#document) — control the `` and `<body>` - 4. [`application`](Browser#application) — create single-page apps - -This order works well because important concepts and techniques are introduced at each stage. If you jump ahead, it is like building a house by starting with the roof! So again, **work through [guide.elm-lang.org][guide] to see examples and really *understand* how Elm works!** - -This order also works well because it mirrors how most people introduce Elm at work. Start small. Try using Elm in a single element in an existing JavaScript project. If that goes well, try doing a bit more. Etc. diff --git a/elm.json b/elm.json deleted file mode 100644 index 4ee1d3e..0000000 --- a/elm.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "type": "package", - "name": "elm/browser", - "summary": "Run Elm in browsers, with access to browser history for single-page apps (SPAs)", - "license": "BSD-3-Clause", - "version": "1.0.0", - "exposed-modules": [ - "Browser", - "Browser.Dom", - "Browser.Events", - "Browser.Navigation" - ], - "elm-version": "0.19.0 <= v < 0.20.0", - "dependencies": { - "elm/core": "1.0.0 <= v < 2.0.0", - "elm/html": "1.0.0 <= v < 2.0.0", - "elm/json": "1.0.0 <= v < 2.0.0", - "elm/time": "1.0.0 <= v < 2.0.0", - "elm/url": "1.0.0 <= v < 2.0.0" - }, - "test-dependencies": {} -} \ No newline at end of file diff --git a/examples/drag.elm b/examples/drag.elm deleted file mode 100644 index 237217d..0000000 --- a/examples/drag.elm +++ /dev/null @@ -1,134 +0,0 @@ -import Browser.Mouse as Mouse -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - - - --- MAIN - - -main = - Browser.element - { init = init - , update = update - , subscriptions = subscriptions - , view = view - } - - --- MODEL - - -type Model = - { x : Int - , y : Int - , dragState : DragState - } - - -type DragState - = Static - | Moving Int Int Int Int - - -init : () -> (Model, Cmd Msg) -init _ = - ( Model 100 100 Static - , Cmd.none - ) - - - --- UPDATE - - -type Msg - = Start Int Int - | Move Int Int - | Stop Int Int - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Start x y -> - ( { model | dragState = Moving x y x y } - , Cmd.none - ) - - Move x y -> - case model.dragState of - Static -> - ( model, Cmd.none ) - - Moving startX startY _ _ -> - ( { model | dragState = Moving startX startY x y } - ) - - Stop x y -> - case model.dragState of - Static -> - ( model, Cmd.none ) - - Moving startX startY _ _ -> - ( Model (model.x + startX - x) (model.y + startY - y) Static - , Cmd.none - ) - - - --- VIEW - - -view : Model -> Html Msg -view model = - let - (x, y) = getPosition model - in - div - [ style "background-color" "rgb(104,216,239)" - , style "position" "absolute" - , style "top" (String.fromInt x ++ "px") - , style "left" (String.fromInt y ++ "px") - , style "width" "100px" - , style "height" "100px" - , on "mousedown" (D.map2 Start pageX pageY) - , on "mouseup" (D.map2 Stop pageX pageY) - ] - [ text "Drag me!" - ] - - -getPosition : Model -> (Int, Int) -getPosition model = - case model.dragState of - Static -> - (model.x, model.y) - - Moving startX startY endX endY -> - (x + startX - endX, y + startY - endY) - - - --- SUBSCRIPTIONS - - -subscriptions : Model -> Sub Msg -subscriptions model = - case model.dragState of - Static -> - Sub.none - - Moving _ _ _ _ -> - Mouse.moves (D.map2 Move pageX pageY) - - -pageX : D.Decoder Int -pageX = - D.field "pageX" D.int - - -pageY : D.Decoder Int -pageY = - D.field "pageY" D.int diff --git a/examples/wasd.elm b/examples/wasd.elm deleted file mode 100644 index ec3c39f..0000000 --- a/examples/wasd.elm +++ /dev/null @@ -1,139 +0,0 @@ - -import Browser.Keyboard as Keyboard -import Browser.Window as Window -import Json.Decode as D - - - --- MODEL - - -type alias Model = - { x : Float - , y : Float - , north : KeyStatus - , south : KeyStatus - , east : KeyStatus - , west : KeyStatus - } - - -type KeyStatus = Up | Down - - -init : () -> ( Model, Cmd Msg ) -init _ = - ( Model 0 0 Up Up Up Up - , Cmd.none - ) - - - --- UPDATE - - -type Msg - = Change KeyStatus String - | Blur - | TimeDelta Float - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Change status string -> - ( updateKey status string - , Cmd.none - ) - - Blur -> - ( Model model.x model.y Up Up Up Up - , Cmd.none - ) - - TimeDelta delta -> - ( updatePosition delta model - , Cmd.none - ) - - -updateKey : KeyStatus -> String -> Model -> Model -updateKey status string model = - case string of - "w" -> { model | north = status } - "a" -> { model | east = status } - "s" -> { model | south = status } - "d" -> { model | west = status } - _ -> model - - -updatePosition : Float -> Model -> Model -updatePosition delta model = - let - vx = toOne model.east - toOne model.west - vy = toOne model.north - toOne model.south - in - { model - | x = model.x + vx * delta - , y = model.y + vy * delta - } - - -toOne : KeyStatus -> Float -toOne status = - if isDown status then 1 else 0 - - -isDown : KeyStatus -> Bool -isDown status = - case status of - Down -> True - Up -> False - - - --- SUBSCRIPTIONS - - -subscriptions : Model -> Sub Msg -subscriptions model = - Sub.batch - [ Keyboard.downs (D.map (Change Down) keyDecoder) - , Keyboard.ups (D.map (Change Up) keyDecoder) - , Window.blurs (D.succeed Blur) - , if anyIsDown then - Animation.deltas TimeDelta - else - Sub.none - ] - - -keyDecoder : D.Decoder String -keyDecoder = - D.field "key" D.string - - -anyIsDown : Model -> Bool -anyIsDown model = - isDown model.north - || isDown model.south - || isDown model.east - || isDown model.west - - - --- VIEW - - -view : Model -> Html Msg -view model = - div - [ style "background-color" "rgb(104,216,239)" - , style "position" "absolute" - , style "top" (String.fromInt (round model.x) ++ "px") - , style "left" (String.fromInt (round model.y) ++ "px") - , style "width" "100px" - , style "height" "100px" - ] - [ text "Press WASD keys!" - ] diff --git a/notes/keyboard.md b/notes/keyboard.md deleted file mode 100644 index e94d40a..0000000 --- a/notes/keyboard.md +++ /dev/null @@ -1,90 +0,0 @@ -# Which key was pressed? - -When you listening for global keyboard events, you very likely want to know *which* key was pressed. Unfortunately different browsers implement the [`KeyboardEvent`][ke] values in different ways, so there is no one-size-fit-all solution. - -[ke]: https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent - -## `charCode` vs `keyCode` vs `which` vs `key` vs `code` - -As of this writing, it seems that the `KeyboardEvent` API recommends using [`key`][key]. It can tell you which symbol was pressed, taking keyboard layout into account. So it will tell you if it was a `x`, `か`, `ø`, `β`, etc. - -[key]: https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/key - -According to [the docs][ke], everything else is deprecated. So `charCode`, `keyCode`, and `which` are only useful if you need to support browsers besides [these](http://caniuse.com/#feat=keyboardevent-key). - - -## Writing a `key` decoder - -The simplest approach is to just decode the string value: - -```elm -import Json.Decode as Decode - -keyDecoder : Decode.Decoder String -keyDecoder = - Decode.field "key" Decode.string -``` - -Depending on your scenario, you may want something more elaborate though! - - -### Decoding for User Input - -If you are handling user input, maybe you want to distinguish actual characters from all the different [key values](https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/key/Key_Values) that may be produced for non-character keys. This way pressing `h` then `i` then `Backspace` does not turn into `"hiBackspace"`. You could do this: - -```elm -import Json.Decode as Decode - -type Key - = Character Char - | Control String - -keyDecoder : Decode.Decoder Key -keyDecoder = - Decode.map toKey (Decode.field "key" Decode.string) - -toKey : String -> Key -toKey string = - case String.uncons string of - Just (char, "") -> - Character char - - _ -> - Control string -``` - -> **Note:** The `String.uncons` function chomps surrogate pairs properly, so it works with characters outside of the BMP. If that does not mean anything to you, you are lucky! In summary, a tricky character encoding problem of JavaScript is taken care of with this code and you do not need to worry about it. Congratulations! - - -### Decoding for Games - -Or maybe you want to handle left and right arrows specially for a game or a presentation viewer. You could do something like this: - -```elm -import Json.Decode as Decode - -type Direction - = Left - | Right - | Other - -keyDecoder : Decode.Decoder Direction -keyDecoder = - Decode.map toDirection (Decode.field "key" Decode.string) - -toDirection : String -> Direction -toDirection string = - case string of - "ArrowLeft" -> - Left - - "ArrowRight" -> - Right - - _ -> - Other -``` - -By converting to a specialized `Direction` type, the compiler can guarantee that you never forget to handle one of the valid inputs. If it was a `String`, new code could have typos or missing branches that would be hard to find. - -Hope that helps you write a decoder that works for your scenario! diff --git a/notes/navigation-in-elements.md b/notes/navigation-in-elements.md deleted file mode 100644 index f45c5e7..0000000 --- a/notes/navigation-in-elements.md +++ /dev/null @@ -1,188 +0,0 @@ -# How do I manage URL from a `Browser.element`? - -Many companies introduce Elm gradually. They use `Browser.element` to embed Elm in a larger codebase as a low-risk way to see if Elm is helpful. If so, great, do more! If not, just revert, no big deal. - -But at some companies the element has grown to manage _almost_ the whole page. Everything except the header and footer, which are produced by the server. And at that time, you may want Elm to start managing URL changes, showing different things in different cases. Well, `Browser.application` lets you do that in Elm, but maybe you have a bunch of legacy code that still needs the header and footer to be created on the server, so `Browser.element` is the only option. - -What do you do? - - -## Managing the URL from `Browser.element` - -You would initialize your element like this: - -```javascript -// Initialize your Elm program -var app = Elm.Main.init({ - flags: location.href, - node: document.getElementById('elm-main') -}); - -// Inform app of browser navigation (the BACK and FORWARD buttons) -document.addEventListener('popstate', function () { - app.ports.onUrlChange.send(location.href); -}); - -// Change the URL upon request, inform app of the change. -app.ports.pushUrl.subscribe(function(url) { - history.pushState({}, '', url); - app.ports.onUrlChange.send(location.href); -}); -``` - -Now the important thing is that you can handle other things in these two event listeners. Maybe your header is sensitive to the URL as well? This is where you manage -anything like that. - -From there, your Elm code would look something like this: - -```elm -import Browser -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Json.Decode as D -import Url -import Url.Parser as Url - - -main : Program String Model Msg -main = - Browser.element - { init = init - , view = view - , update = update - , subscriptions = subscriptions - } - - -type Msg = UrlChanged (Maybe Route) | ... - - --- INIT - -init : String -> ( Model, Cmd Msg ) -init locationHref = - ... - - --- SUBSCRIPTION - -subscriptions : Model -> Sub Msg -subscriptions model = - onUrlChange UrlChanged - - --- NAVIGATION - -port onUrlChange : (String -> msg) -> Sub msg - -port pushUrl : String -> Cmd msg - -link msg -> List (Attribute msg) -> List (Html msg) -> Html msg -link href attrs children = - a (preventDefaultOn "click" (D.succeed (href, True)) :: attrs) children - -locationHrefToRoute : String -> Maybe Route -locationHrefToRoute locationHref = - case Url.fromString locationHref of - Nothing -> Nothing - Just url -> Url.parse myParser url - --- myParser : Url.Parser (Route -> Route) Route -``` - -So in contrast with `Browser.application`, you have to manage the URL yourself in JavaScript. What is up with that?! - - -## Justification - -The justification is that (1) this will lead to more reliable programs overall and (2) other designs do not save significant amounts of code. We will explore both in order. - - -### Reliability - -There are some Elm users that have many different technologies embedded in the same document. So imagine we have a header in React, charts in Elm, and a data entry interface in Angular. - -For URL management to work here, all three of these things need to agree on what page they are on. So the most reliable design is to have one `popstate` listener on the very outside. It would tell React, Elm, and Angular what to do. This gives you a guarantee that they are all in agreement about the current page. Similarly, they would all send messages out requesting a `pushState` such that everyone is informed of any changes. - -If each project was reacting to the URL internally, synchronization bugs would inevitably arise. Maybe it was a static page, but it upgraded to have the URL change. You added that to your Elm, but what about the Angular and React elements. What happens to them? Probably people forget and it is just a confusing bug. So having one `popstate` makes it obvious that there is a decision to make here. And what happens when React starts producing URLs that Angular and Elm have never heard of? Do those elements show some sort of 404 page? - -> **Note:** If you wanted you could send the `location.href` into a `Platform.worker` to do the URL parsing in Elm. Once you have nice data, you could send it out a port for all the different elements on your page. - - -### Lines of Code - -So the decision is primarily motivated by the fact that **URL management should happen at the highest possible level for reliability**, but what if Elm is the only thing on screen? How many lines extra are those people paying? - -Well, the JavaScript code would be something like this: - -```javascript -var app = Elm.Main.init({ - flags: ... -}); -``` - -And in Elm: - -```elm -import Browser -import Browser.Navigation as Nav -import Url -import Url.Parser as Url - - -main : Program Flags Model Msg -main = - Browser.application - { init = init - , view = view - , update = update - , subscriptions = subscriptions - , onUrlChange = UrlChanged - , onUrlRequest = LinkClicked - } - - -type Msg = UrlChanged (Maybe Route) | ... - - --- INIT - -init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) -init flags url key = - ... - - --- SUBSCRIPTION - -subscriptions : Model -> Sub Msg -subscriptions model = - Sub.none - - --- NAVIGATION - -urlToRoute : Url.Url -> Maybe Route -urlToRoute url = - Url.parse myParser url - --- myParser : Url.Parser (Route -> Route) Route -``` - -So the main differences are: - -1. You can delete the ports in JavaScript (seven lines) -2. `port onUrlChanged` becomes `onUrlChanged` in `main` (zero lines) -3. `locationHrefToRoute` becomes `urlToRoute` (three lines) -4. `link` becomes `onUrlRequest` and handling code in `update` (depends) - -So we are talking about maybe twenty lines of code that go away in the `application` version? And each line has a very clear purpose, allowing you to customize and synchronize based on your exact application. Maybe you only want the hash because you support certain IE browsers? Change the `popstate` listener to `hashchange`. Maybe you only want the last two segments of the URL because the rest is managed in React? Change `locationHrefToRoute` to be `whateverToRoute` based on what you need. Etc. - - -### Summary - -It seems appealing to “just do the same thing” in `Browser.element` as in `Browser.application`, but you quickly run into corner cases when you consider the broad range of people and companies using Elm. When Elm and React are on the same page, who owns the URL? When `history.pushState` is called in React, how does Elm hear about it? When `pushUrl` is called in Elm, how does React hear about it? It does not appear that there actually _is_ a simpler or shorter way for `Browser.element` to handle these questions. Special hooks on the JS side? And what about the folks using `Browser.element` who are not messing with the URL? - -By keeping it super simple (1) your attention is drawn to the fact that there are actually tricky situations to consider, (2) you have the flexibility to handle any situation that comes up, and (3) folks who are _not_ managing the URL from embedded Elm (the vast majority!) get a `Browser.element` with no extra details. - -The current design seems to balance all these competing concerns in a nice way, even if it may seem like one _particular_ scenario could be a bit better. diff --git a/src/Browser.elm b/src/Browser.elm deleted file mode 100644 index 8d39661..0000000 --- a/src/Browser.elm +++ /dev/null @@ -1,278 +0,0 @@ -module Browser exposing - ( sandbox - , element - , document - , Document - , application - , UrlRequest(..) - ) - -{-| This module helps you set up an Elm `Program` with functions like -[`sandbox`](#sandbox) and [`document`](#document). - - -# Sandboxes -@docs sandbox - -# Elements -@docs element - -# Documents -@docs document, Document - -# Applications -@docs application, UrlRequest - --} - - -import Browser.Navigation as Navigation -import Debugger.Main -import Dict -import Elm.Kernel.Browser -import Html exposing (Html) -import Url - - - --- SANDBOX - - -{-| Create a “sandboxed” program that cannot communicate with the outside -world. - -This is great for learning the basics of [The Elm Architecture][tea]. You can -see sandboxes in action in tho following examples: - - - [Buttons](https://elm-lang.org/examples/buttons) - - [Text Field](https://elm-lang.org/examples/field) - - [Checkboxes](https://elm-lang.org/examples/checkboxes) - -Those are nice, but **I very highly recommend reading [this guide][guide] -straight through** to really learn how Elm works. Understanding the -fundamentals actually pays off in this language! - -[tea]: https://guide.elm-lang.org/architecture/ -[guide]: https://guide.elm-lang.org/ --} -sandbox : - { init : model - , view : model -> Html msg - , update : msg -> model -> model - } - -> Program () model msg -sandbox impl = - Elm.Kernel.Browser.element - { init = \() -> (impl.init, Cmd.none) - , view = impl.view - , update = \msg model -> (impl.update msg model, Cmd.none) - , subscriptions = \_ -> Sub.none - } - - - --- ELEMENT - - -{-| Create an HTML element managed by Elm. The resulting elements are easy to -embed in a larger JavaScript projects, and lots of companies that use Elm -started with this approach! Try it out on something small. If it works, great, -do more! If not, revert, no big deal. - -Unlike a [`sandbox`](#sandbox), an `element` can talk to the outside world in -a couple ways: - - - `Cmd` — you can “command” the Elm runtime to do stuff, like HTTP. - - `Sub` — you can “subscribe” to event sources, like clock ticks. - - `flags` — JavaScript can pass in data when starting the Elm program - - `ports` — set up a client-server relationship with JavaScript - -As you read [the guide][guide] you will run into a bunch of examples of `element` -in [this section][fx]. You can learn more about flags and ports in [the interop -section][interop]. - -[guide]: https://guide.elm-lang.org/ -[fx]: https://guide.elm-lang.org/effects/ -[interop]: https://guide.elm-lang.org/interop/ --} -element : - { init : flags -> (model, Cmd msg) - , view : model -> Html msg - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - } - -> Program flags model msg -element = - Elm.Kernel.Browser.element - - - --- DOCUMENT - - -{-| Create an HTML document managed by Elm. This expands upon what `element` -can do in that `view` now gives you control over the `<title>` and `<body>`. - --} -document : - { init : flags -> (model, Cmd msg) - , view : model -> Document msg - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - } - -> Program flags model msg -document = - Elm.Kernel.Browser.document - - -{-| This data specifies the `<title>` and all of the nodes that should go in -the `<body>`. This means you can update the title as your application changes. -Maybe your "single-page app" navigates to a "different page", maybe a calendar -app shows an accurate date in the title, etc. - -> **Note about CSS:** This looks similar to an `<html>` document, but this is -> not the place to manage CSS assets. If you want to work with CSS, there are -> a couple ways: -> -> 1. Packages like [`rtfeldman/elm-css`][elm-css] give all of the features -> of CSS without any CSS files. You can add all the styles you need in your -> `view` function, and there is no need to worry about class names matching. -> -> 2. Compile your Elm code to JavaScript with `elm make --output=elm.js` and -> then make your own HTML file that loads `elm.js` and the CSS file you want. -> With this approach, it does not matter where the CSS comes from. Write it -> by hand. Generate it. Whatever you want to do. -> -> 3. If you need to change `<link>` tags dynamically, you can send messages -> out a port to do it in JavaScript. -> -> The bigger point here is that loading assets involves touching the `<head>` -> as an implementation detail of browsers, but that does not mean it should be -> the responsibility of the `view` function in Elm. So we do it differently! - -[elm-css]: /rtfeldman/elm-css/latest/ --} -type alias Document msg = - { title : String - , body : List (Html msg) - } - - - --- APPLICATION - - -{-| Create an application that manages [`Url`][url] changes. - -**When the application starts**, `init` gets the initial `Url`. You can show -different things depending on the `Url`! - -**When someone clicks a link**, like `<a href="/home">Home</a>`, it always goes -through `onUrlRequest`. The resulting message goes to your `update` function, -giving you a chance to save scroll position or persist data before changing -the URL yourself with [`pushUrl`][bnp] or [`load`][bnl]. More info on this in -the [`UrlRequest`](#UrlRequest) docs! - -**When the URL changes**, the new `Url` goes through `onUrlChange`. The -resulting message goes to `update` where you can decide what to show next. - -Applications always use the [`Browser.Navigation`][bn] module for precise -control over `Url` changes. - -**More Info:** Here are some example usages of `application` programs: - -- [RealWorld example app](https://github.com/rtfeldman/elm-spa-example) -- [Elm’s package website](https://github.com/elm/package.elm-lang.org) - -These are quite advanced Elm programs, so be sure to go through [the guide][g] -first to get a solid conceptual foundation before diving in! If you start -reading a calculus book from page 314, it might seem confusing. Same here! - -**Note:** Can an [`element`](#element) manage the URL too? Read [this][]! - -[g]: https://guide.elm-lang.org/ -[bn]: Browser-Navigation -[bnp]: Browser-Navigation#pushUrl -[bnl]: Browser-Navigation#load -[url]: /packages/elm/url/latest/Url#Url -[this]: https://github.com/elm/browser/blob/1.0.0/notes/navigation-in-elements.md --} -application : - { init : flags -> Url.Url -> Navigation.Key -> (model, Cmd msg) - , view : model -> Document msg - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - , onUrlRequest : UrlRequest -> msg - , onUrlChange : Url.Url -> msg - } - -> Program flags model msg -application = - Elm.Kernel.Browser.application - - -{-| All links in an [`application`](#application) create a `UrlRequest`. So -when you click `<a href="/home">Home</a>`, it does not just navigate! It -notifies `onUrlRequest` that the user wants to change the `Url`. - -### `Internal` vs `External` - -Imagine we are browsing `https://example.com`. An `Internal` link would be -like: - -- `settings#privacy` -- `/home` -- `https://example.com/home` -- `//example.com/home` - -All of these links exist under the `https://example.com` domain. An `External` -link would be like: - -- `http://example.com/home` -- `https://elm-lang.org/examples` -- `data:text/html,%3Ch1%3EHello%2C%20World!%3C%2Fh1%3E` - -Notice that changing the protocol from `https` to `http` is considered an -external link! (And vice versa!) - -### Purpose - -Having a `UrlRequest` requires a case in your `update` like this: - - import Browser exposing (..) - import Browser.Navigation as Nav - import Url - - type Msg = ClickedLink UrlRequest - - update : Msg -> Model -> (Model, Cmd msg) - update msg model = - case msg of - ClickedLink urlRequest -> - case urlRequest of - Internal url -> - ( model - , Nav.pushUrl model.key (Url.toString url) - ) - - External url -> - ( model - , Nav.load url - ) - -This is useful because it gives you a chance to customize the behavior in each -case. Maybe on some `Internal` links you save the scroll position with -[`Browser.Dom.getViewport`](Browser-Dom#getViewport) so you can restore it -later. Maybe on `External` links you persist parts of the `Model` on your -servers before leaving. Whatever you need to do! - -**Note:** Knowing the scroll position is not enough restore it! What if the -browser dimensions change? The scroll position will not correlate with -“what was on screen” anymore. So it may be better to remember -“what was on screen” and recreate the position based on that. For -example, in a Wikipedia article, remember the header that they were looking at -most recently. [`Browser.Dom.getElement`](Browser-Dom#getElement) is designed -for figuring that out! --} -type UrlRequest - = Internal Url.Url - | External String diff --git a/src/Browser/AnimationManager.elm b/src/Browser/AnimationManager.elm deleted file mode 100644 index 2544b7e..0000000 --- a/src/Browser/AnimationManager.elm +++ /dev/null @@ -1,106 +0,0 @@ -effect module Browser.AnimationManager where { subscription = MySub } exposing - ( onAnimationFrame - , onAnimationFrameDelta - ) - - -import Elm.Kernel.Browser -import Process -import Task exposing (Task) -import Time - - - --- PUBLIC STUFF - - -onAnimationFrame : (Time.Posix -> msg) -> Sub msg -onAnimationFrame tagger = - subscription (Time tagger) - - -onAnimationFrameDelta : (Float -> msg) -> Sub msg -onAnimationFrameDelta tagger = - subscription (Delta tagger) - - - --- SUBSCRIPTIONS - - -type MySub msg - = Time (Time.Posix -> msg) - | Delta (Float -> msg) - - -subMap : (a -> b) -> MySub a -> MySub b -subMap func sub = - case sub of - Time tagger -> - Time (func << tagger) - - Delta tagger -> - Delta (func << tagger) - - - --- EFFECT MANAGER - - -type alias State msg = - { subs : List (MySub msg) - , request : Maybe Process.Id - , oldTime : Int - } - - --- NOTE: used in onEffects --- -init : Task Never (State msg) -init = - Task.succeed (State [] Nothing 0) - - -onEffects : Platform.Router msg Int -> List (MySub msg) -> State msg -> Task Never (State msg) -onEffects router subs {request, oldTime} = - case (request, subs) of - (Nothing, []) -> - init - - (Just pid, []) -> - Process.kill pid - |> Task.andThen (\_ -> init) - - (Nothing, _) -> - Process.spawn (Task.andThen (Platform.sendToSelf router) rAF) - |> Task.andThen (\pid -> now - |> Task.andThen (\time -> Task.succeed (State subs (Just pid) time))) - - (Just _, _) -> - Task.succeed (State subs request oldTime) - - -onSelfMsg : Platform.Router msg Int -> Int -> State msg -> Task Never (State msg) -onSelfMsg router newTime {subs, oldTime} = - let - send sub = - case sub of - Time tagger -> - Platform.sendToApp router (tagger (Time.millisToPosix newTime)) - - Delta tagger -> - Platform.sendToApp router (tagger (toFloat (newTime - oldTime))) - in - Process.spawn (Task.andThen (Platform.sendToSelf router) rAF) - |> Task.andThen (\pid -> Task.sequence (List.map send subs) - |> Task.andThen (\_ -> Task.succeed (State subs (Just pid) newTime))) - - -rAF : Task x Int -rAF = - Elm.Kernel.AnimationFrame.rAF () - - -now : Task x Int -now = - Elm.Kernel.AnimationFrame.now () \ No newline at end of file diff --git a/src/Browser/Dom.elm b/src/Browser/Dom.elm deleted file mode 100644 index aeef60e..0000000 --- a/src/Browser/Dom.elm +++ /dev/null @@ -1,371 +0,0 @@ -module Browser.Dom exposing - ( focus, blur, Error(..) - , getViewport, Viewport, getViewportOf - , setViewport, setViewportOf - , getElement, Element - ) - - -{-| This module allows you to manipulate the DOM in various ways. It covers: - -- Focus and blur input elements. -- Get the `width` and `height` of elements. -- Get the `x` and `y` coordinates of elements. -- Figure out the scroll position. -- Change the scroll position! - -We use different terminology than JavaScript though... - - -# Terminology - -Have you ever thought about how “scrolling” is a metaphor about -scrolls? Like hanging scrolls of caligraphy made during the Han Dynasty -in China? - -This metaphor falls apart almost immediately though. For example, many scrolls -read horizontally! Like a [Sefer Torah][torah] or [Chinese Handscrolls][hand]. -The two sides move independently, sometimes kept in place with stones. What is -a scroll bar in this world? And [hanging scrolls][hang] (which _are_ displayed -vertically) do not “scroll” at all! They hang! - -So in JavaScript, we start with a badly stretched metaphor and add a bunch of -DOM details like padding, borders, and margins. How do those relate to scrolls? -For example, JavaScript has `clientWidth`. Client like a feudal state that pays -tribute to the emperor? And `offsetHeight`. Can an offset even have height? And -what has that got to do with scrolls? - -So instead of inheriting this metaphorical hodge-podge, we use terminology from -3D graphics. You have a **scene** containing all your elements and a **viewport** -into the scene. I think it ends up being a lot clearer, but you can evaluate -for yourself when you see the diagrams later! - -**Note:** For more scroll facts, I recommend [A Day on the Grand Canal with -the Emperor of China or: Surface Is Illusion But So Is Depth][doc] where David -Hockney explores the history of _perspective_ in art. Really interesting! - -[torah]: https://en.wikipedia.org/wiki/Sefer_Torah -[hand]: https://www.metmuseum.org/toah/hd/chhs/hd_chhs.htm -[hang]: https://en.wikipedia.org/wiki/Hanging_scroll -[doc]: https://www.imdb.com/title/tt0164525/ - -# Focus -@docs focus, blur, Error - -# Get Viewport -@docs getViewport, Viewport, getViewportOf - -# Set Viewport -@docs setViewport, setViewportOf - -# Position -@docs getElement, Element - --} - - - -import Elm.Kernel.Browser -import Task exposing (Task) - - - --- FOCUS - - -{-| Find a DOM node by `id` and focus on it. So if you wanted to focus a node -like `<input type="text" id="search-box">` you could say: - - import Browser.Dom as Dom - import Task - - type Msg = NoOp - - focusSearchBox : Cmd Msg - focusSearchBox = - Task.attempt (\_ -> NoOp) (Dom.focus "search-box") - -Notice that this code ignores the possibility that `search-box` is not used -as an `id` by any node, failing silently in that case. It would be better to -log the failure with whatever error reporting system you use. --} -focus : String -> Task Error () -focus = - Elm.Kernel.Browser.call "focus" - - -{-| Find a DOM node by `id` and make it lose focus. So if you wanted a node -like `<input type="text" id="search-box">` to lose focus you could say: - - import Browser.Dom as Dom - import Task - - type Msg = NoOp - - unfocusSearchBox : Cmd Msg - unfocusSearchBox = - Task.attempt (\_ -> NoOp) (Dom.blur "search-box") - -Notice that this code ignores the possibility that `search-box` is not used -as an `id` by any node, failing silently in that case. It would be better to -log the failure with whatever error reporting system you use. --} -blur : String -> Task Error () -blur = - Elm.Kernel.Browser.call "blur" - - - --- ERROR - - -{-| Many functions in this module look up DOM nodes up by their `id`. If you -ask for an `id` that is not in the DOM, you will get this error. --} -type Error = NotFound String - - - --- VIEWPORT - - -{-| Get information on the current viewport of the browser. - -![getViewport](TODO) - -If you want to move the viewport around (i.e. change the scroll position) you -can use [`setViewport`](#setViewport) or [`moveViewport`](#moveViewport) which -change the `x` and `y` of the viewport. --} -getViewport : Task x Viewport -getViewport = - Elm.Kernel.Browser.withWindow Elm.Kernel.Browser.getViewport - - - -{-| All the information about the current viewport. - -![getViewport](TODO) - --} -type alias Viewport = - { scene : - { width : Float - , height : Float - } - , viewport : - { x : Float - , y : Float - , width : Float - , height : Float - } - } - - -{-| Just like `getViewport`, but for any scrollable DOM node. Say we have an -application with a chat box in the bottow right corner like this: - -![chat](TODO) - -There are probably a whole bunch of messages that are not being shown. You -could scroll up to see them all. Well, we can think of that chat box is a -viewport into a scene! - -![getViewportOf](TODO) - -This can be useful with [`setViewportOf`](#setViewportOf) to make sure new -messages always appear on the bottom. - -The viewport size *does not* include the border or margins. - -**Note:** This data is collected from specific fields in JavaScript, so it -may be helpful to know that: - -- `scene.width` = [`scrollWidth`][sw] -- `scene.height` = [`scrollHeight`][sh] -- `viewport.x` = [`scrollTop`][st] -- `viewport.y` = [`scrollLeft`][sl] -- `viewport.width` = [`clientWidth`][cw] -- `viewport.height` = [`clientHeight`][ch] - -Neither [`offsetWidth`][ow] nor [`offsetHeight`][oh] are available. The theory -is that (1) the information can always be obtained by using `getElement` on a -node without margins, (2) no cases came to mind where you actually care in the -first place, and (3) it is available through ports if it is really needed. -If you have a case that really needs it though, please share your specific -scenario in an issue! Nicely presented case studies are the raw ingredients for -API improvements! - -[sw]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollWidth -[sh]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollHeight -[st]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollTop -[sl]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollLeft -[cw]: https://developer.mozilla.org/en-US/docs/Web/API/Element/clientWidth -[ch]: https://developer.mozilla.org/en-US/docs/Web/API/Element/clientHeight -[ow]: https://developer.mozilla.org/en-US/docs/Web/API/Element/offsetWidth -[oh]: https://developer.mozilla.org/en-US/docs/Web/API/Element/offsetHeight --} -getViewportOf : String -> Task Error Viewport -getViewportOf = - Elm.Kernel.Browser.getViewportOf - - - --- SET VIEWPORT - - -{-| Change the `x` and `y` offset of the browser viewport immediately. For -example, you could make a command to jump to the top of the page: - - import Browser.Dom as Dom - import Task - - type Msg = NoOp - - resetViewport : Cmd Msg - resetViewport = - Task.perform (\_ -> NoOp) (Dom.setViewport 0 0) - -This sets the viewport offset to zero. - -This could be useful with `Browser.application` where you may want to reset -the viewport when the URL changes. Maybe you go to a “new page” -and want people to start at the top! --} -setViewport : Float -> Float -> Task x () -setViewport = - Elm.Kernel.Browser.setViewport - - -{-| Change the `x` and `y` offset of a DOM node’s viewport by ID. This -is common in text messaging and chat rooms, where once the messages fill the -screen, you want to always be at the very bottom of the message chain. This -way the latest message is always on screen! You could do this: - - import Browser.Dom as Dom - import Task - - type Msg = NoOp - - jumpToBottom : String -> Cmd Msg - jumpToBottom id = - Dom.getViewportOf id - |> Task.andThen (\info -> Dom.setViewportOf id 0 info.scene.height) - |> Task.perform (\_ -> NoOp) - -So you could call `jumpToBottom "chat-box"` whenever you add a new message. - -**Note 1:** What happens if the viewport is placed out of bounds? Where there -is no `scene` to show? To avoid this question, the `x` and `y` offsets are -clamped such that the viewport is always fully within the `scene`. So when -`jumpToBottom` sets the `y` offset of the viewport to the `height` of the -`scene` (i.e. too far!) it relies on this clamping behavior to put the viewport -back in bounds. - -**Note 2:** The example ignores when the element ID is not found, but it would -be great to log that information. It means there may be a bug or a dead link -somewhere! --} -setViewportOf : String -> Float -> Float -> Task Error () -setViewportOf = - Elm.Kernel.Browser.setViewportOf - - - -{-- SLIDE VIEWPORT - - -{-| Change the `x` and `y` offset of the viewport with an animation. In JS, -this corresponds to setting [`scroll-behavior`][sb] to `smooth`. - -This can definitely be overused, so try to use it specifically when you want -the user to be spatially situated in a scene. For example, a “back to -top” button might use it: - - import Browser.Dom as Dom - import Task - - type Msg = NoOp - - backToTop : Cmd Msg - backToTop = - Task.perform (\_ -> NoOp) (Dom.slideViewport 0 0) - -Be careful when paring this with `Browser.application`. When the URL changes -and a whole new scene is going to be rendered, using `setViewport` is probably -best. If you are moving within a scene, you may benefit from a mix of -`setViewport` and `slideViewport`. Sliding to the top is nice, but sliding -around everywhere is probably annoying. - -[sb]: https://developer.mozilla.org/en-US/docs/Web/CSS/scroll-behavior --} -slideViewport : Float -> Float -> Task x () -slideViewport = - Debug.todo "slideViewport" - - -slideViewportOf : String -> Float -> Float -> Task Error () -slideViewportOf = - Debug.todo "slideViewportOf" - ---} - - - --- ELEMENT - - -{-| Get position information about specific elements. Say we put -`id "jesting-aside"` on the seventh paragraph of the text. When we call -`getElement "jesting-aside"` we would get the following information: - -![getElement](TODO) - -This can be useful for: - -- **Scrolling** — Pair this information with `setViewport` to scroll -specific elements into view. This gives you a lot of control over where exactly -the element would be after the viewport moved. - -- **Drag and Drop** — As of this writing, `touchmove` events do not tell -you which element you are currently above. To figure out if you have dragged -something over the target, you could see if the `pageX` and `pageY` of the -touch are inside the `x`, `y`, `width`, and `height` of the target element. - -**Note:** This corresponds to JavaScript’s [`getBoundingClientRect`][gbcr], -so **the element’s margins are included in its `width` and `height`**. -With scrolling, maybe you want to include the margins. With drag-and-drop, you -probably do not, so some folks set the margins to zero and put the target -element in a `<div>` that adds the spacing. Just something to be aware of! - -[gbcr]: https://developer.mozilla.org/en-US/docs/Web/API/Element/getBoundingClientRect --} -getElement : String -> Task Error Element -getElement = - Elm.Kernel.Browser.getElement - - -{-| A bunch of information about the position and size of an element relative -to the overall scene. - -![getViewport](TODO) - --} -type alias Element = - { scene : - { width : Float - , height : Float - } - , viewport : - { x : Float - , y : Float - , width : Float - , height : Float - } - , element : - { x : Float - , y : Float - , width : Float - , height : Float - } - } diff --git a/src/Browser/Events.elm b/src/Browser/Events.elm deleted file mode 100644 index e3b982c..0000000 --- a/src/Browser/Events.elm +++ /dev/null @@ -1,340 +0,0 @@ -effect module Browser.Events where { subscription = MySub } exposing - ( onAnimationFrame, onAnimationFrameDelta - , onKeyPress, onKeyDown, onKeyUp - , onClick, onMouseMove, onMouseDown, onMouseUp - , onResize, onVisibilityChange, Visibility(..) - ) - - -{-| In JavaScript, information about the root of an HTML document is held in -the `document` and `window` objects. This module lets you create event -listeners on those objects for the following topics: [animation](#animation), -[keyboard](#keyboard), [mouse](#mouse), and [window](#window). - -If there is something else you need, use [ports][] to do it in JavaScript! - -[ports]: https://guide.elm-lang.org/interop/ports.html - -# Animation -@docs onAnimationFrame, onAnimationFrameDelta - -# Keyboard -@docs onKeyPress, onKeyDown, onKeyUp - -# Mouse -@docs onClick, onMouseMove, onMouseDown, onMouseUp - -# Window -@docs onResize, onVisibilityChange, Visibility - --} - - -import Browser.AnimationManager as AM -import Dict -import Elm.Kernel.Browser -import Json.Decode as Decode -import Process -import Task exposing (Task) -import Time - - - --- ANIMATION - - -{-| An animation frame triggers about 60 times per second. Get the POSIX time -on each frame. (See [`elm/time`](/packages/elm/time/latest) for more info on -POSIX times.) - -**Note:** Browsers have their own render loop, repainting things as fast as -possible. If you want smooth animations in your application, it is helpful to -sync up with the browsers natural refresh rate. This hooks into JavaScript's -`requestAnimationFrame` function. --} -onAnimationFrame : (Time.Posix -> msg) -> Sub msg -onAnimationFrame = - AM.onAnimationFrame - - -{-| Just like `onAnimationFrame`, except message is the time in milliseconds -since the previous frame. So you should get a sequence of values all around -`1000 / 60` which is nice for stepping animations by a time delta. --} -onAnimationFrameDelta : (Float -> msg) -> Sub msg -onAnimationFrameDelta = - AM.onAnimationFrameDelta - - - --- KEYBOARD - - -{-| Subscribe to all key presses. - -**Note:** Check out [this advice][note] to learn more about decoding key codes. -It is more complicated than it should be. - -[note]: https://github.com/elm/browser/blob/1.0.0/notes/keyboard.md --} -onKeyPress : Decode.Decoder msg -> Sub msg -onKeyPress = - on Document "keypress" - - -{-| Subscribe to get codes whenever a key goes down. This can be useful for -creating games. Maybe you want to know if people are pressing `w`, `a`, `s`, -or `d` at any given time. Check out how that works in [this example][example]. - -**Note:** Check out [this advice][note] to learn more about decoding key codes. -It is more complicated than it should be. - -[note]: https://github.com/elm/browser/blob/1.0.0/notes/keyboard.md -[example]: https://github.com/elm/browser/blob/1.0.0/examples/wasd.md --} -onKeyDown : Decode.Decoder msg -> Sub msg -onKeyDown = - on Document "keydown" - - -{-| Subscribe to get codes whenever a key goes up. Often used in combination -with [`onVisibilityChange`](#onVisibilityChange) to be sure keys do not appear -to down and never come back up. --} -onKeyUp : Decode.Decoder msg -> Sub msg -onKeyUp = - on Document "keyup" - - - --- MOUSE - - -{-| Subscribe to mouse clicks anywhere on screen. Maybe you need to create a -custom drop down. You could listen for clicks when it is open, letting you know -if someone clicked out of it: - - import Browser.Events as Events - import Json.Decode as D - - type Msg = ClickOut - - subscriptions : Model -> Sub Msg - subscriptions model = - case model.dropDown of - Closed _ -> - Sub.none - - Open _ -> - Events.onClick (D.succeed ClickOut) --} -onClick : Decode.Decoder msg -> Sub msg -onClick = - on Document "click" - - -{-| Subscribe to mouse moves anywhere on screen. You could use this to implement -drag and drop. - -**Note:** Unsubscribe if you do not need these events! Running code on every -single mouse movement can be very costly, and it is recommended to only -subscribe when absolutely necessary. --} -onMouseMove : Decode.Decoder msg -> Sub msg -onMouseMove = - on Document "mousemove" - - -{-| Subscribe to get mouse information whenever the mouse button goes down. --} -onMouseDown : Decode.Decoder msg -> Sub msg -onMouseDown = - on Document "mousedown" - - -{-| Subscribe to get mouse information whenever the mouse button goes up. -Often used in combination with [`onVisibilityChange`](#onVisibilityChange) -to be sure keys do not appear to down and never come back up. --} -onMouseUp : Decode.Decoder msg -> Sub msg -onMouseUp = - on Document "mouseup" - - - --- WINDOW - - -{-| Subscribe to any changes in window size. - -If you wanted to always track the current width, you could do something [like -this](TODO). - -**Note:** This is equivalent to getting events from [`window.onresize`][resize]. - -[resize]: https://developer.mozilla.org/en-US/docs/Web/API/GlobalEventHandlers/onresize --} -onResize : (Int -> Int -> msg) -> Sub msg -onResize func = - on Window "resize" <| - Decode.field "target" <| - Decode.map2 func - (Decode.field "innerWidth" Decode.int) - (Decode.field "innerHeight" Decode.int) - - -{-| Subscribe to any visibility changes, like if the user switches to a -different tab or window. When the user looks away, you may want to: - -- Stop polling a server for new information. -- Pause video or audio. -- Pause an image carousel. - -This may also be useful with [`onKeyDown`](#onKeyDown). If you only listen for -[`onKeyUp`](#onKeyUp) to end the key press, you can miss situations like using -a keyboard shortcut to switch tabs. Visibility changes will cover those tricky -cases, like in [this example][example]! - -[example]: https://github.com/elm/browser/blob/1.0.0/examples/wasd.md --} -onVisibilityChange : (Visibility -> msg) -> Sub msg -onVisibilityChange func = - let - info = Elm.Kernel.Browser.visibilityInfo () - in - on Document info.changes <| - Decode.map (withHidden func) <| - Decode.field "target" <| - Decode.field info.hidden Decode.bool - - -withHidden : (Visibility -> msg) -> Bool -> msg -withHidden func isHidden = - func (if isHidden then Hidden else Visible) - - -{-| Value describing whether the page is hidden or visible. --} -type Visibility = Visible | Hidden - - - --- SUBSCRIPTIONS - - -type Node - = Document - | Window - - -on : Node -> String -> Decode.Decoder msg -> Sub msg -on node name decoder = - subscription (MySub node name decoder) - - -type MySub msg = - MySub Node String (Decode.Decoder msg) - - -subMap : (a -> b) -> MySub a -> MySub b -subMap func (MySub node name decoder) = - MySub node name (Decode.map func decoder) - - - --- EFFECT MANAGER - - -type alias State msg = - { subs : List (String, MySub msg) - , pids : Dict.Dict String Process.Id - } - - -init : Task Never (State msg) -init = - Task.succeed (State [] Dict.empty) - - -type alias Event = - { key : String - , event : Decode.Value - } - - -onSelfMsg : Platform.Router msg Event -> Event -> State msg -> Task Never (State msg) -onSelfMsg router { key, event } state = - let - toMessage (subKey, MySub node name decoder) = - if subKey == key then - Elm.Kernel.Browser.decodeEvent decoder event - else - Nothing - - messages = - List.filterMap toMessage state.subs - in - Task.sequence (List.map (Platform.sendToApp router) messages) - |> Task.andThen (\_ -> Task.succeed state) - - -onEffects : Platform.Router msg Event -> List (MySub msg) -> State msg -> Task Never (State msg) -onEffects router subs state = - let - newSubs = - List.map addKey subs - - stepLeft _ pid (deads, lives, news) = - ( pid :: deads, lives, news ) - - stepBoth key pid _ (deads, lives, news) = - ( deads, Dict.insert key pid lives, news ) - - stepRight key sub (deads, lives, news) = - ( deads, lives, spawn router key sub :: news ) - - (deadPids, livePids, makeNewPids) = - Dict.merge stepLeft stepBoth stepRight state.pids (Dict.fromList newSubs) ([], Dict.empty, []) - in - Task.sequence (List.map Process.kill deadPids) - |> Task.andThen (\_ -> Task.sequence makeNewPids) - |> Task.andThen (\pids -> Task.succeed (State newSubs (Dict.union livePids (Dict.fromList pids)))) - - - --- TO KEY - - -addKey : MySub msg -> ( String, MySub msg ) -addKey (MySub node name _ as sub) = - ( nodeToKey node ++ name, sub ) - - -nodeToKey : Node -> String -nodeToKey node = - case node of - Document -> - "d_" - - Window -> - "w_" - - - --- SPAWN - - -spawn : Platform.Router msg Event -> String -> MySub msg -> Task Never (String, Process.Id) -spawn router key (MySub node name _) = - let - actualNode = - case node of - Document -> - Elm.Kernel.Browser.doc - - Window -> - Elm.Kernel.Browser.window - in - Task.map (\value -> (key,value)) <| - Elm.Kernel.Browser.on actualNode name <| - \event -> Platform.sendToSelf router (Event key event) diff --git a/src/Browser/Navigation.elm b/src/Browser/Navigation.elm deleted file mode 100644 index ef92c96..0000000 --- a/src/Browser/Navigation.elm +++ /dev/null @@ -1,176 +0,0 @@ -module Browser.Navigation exposing - ( Key - , pushUrl - , replaceUrl - , back - , forward - , load - , reload - , reloadAndSkipCache - ) - - -{-| This module helps you manage the browser’s URL yourself. This is the -crucial trick when using [`Browser.application`](Browser#application). - -The most important function is [`pushUrl`](#pushUrl) which changes the -address bar *without* starting a page load. - - -## What is a page load? - - 1. Request a new HTML document. The page goes blank. - 2. As the HTML loads, request any `<script>` or `<link>` resources. - 3. A `<script>` may mutate the document, so these tags block rendering. - 4. When *all* of the assets are loaded, actually render the page. - -That means the page will go blank for at least two round-trips to the servers! -You may have 90% of the data you need and be blocked on a font that is taking -a long time. Still blank! - - -## How does `pushUrl` help? - -The `pushUrl` function changes the URL, but lets you keep the current HTML. -This means the page *never* goes blank. Instead of making two round-trips to -the server, you load whatever assets you want from within Elm. Maybe you do -not need any round-trips! Meanwhile, you retain full control over the UI, so -you can show a loading bar, show information as it loads, etc. Whatever you -want! - - -# Navigate within Page -@docs Key, pushUrl, replaceUrl, back, forward - -# Navigate to other Pages -@docs load, reload, reloadAndSkipCache - --} - - -import Elm.Kernel.Browser -import Task exposing (Task) - - - --- WITHIN PAGE - - -{-| To create a reliable application, the URL needs to be managed in one place. -Otherwise, you are bound to end up with some tricky bugs as described [here][]. - -So a navigation `Key` is needed to use `pushUrl`, `replaceUrl`, `back`, and -`forward`. And a navigation `Key` is only available when you create your -program with [`Browser.application`][app]. This ensures that no one ever misses -URL changes. - -[here]: https://github.com/elm/browser/blob/1.0.0/notes/navigation-in-elements.md -[app]: Browser#application --} -type Key = Key - - -{-| Change the URL, but do not trigger a page load. - -This will add a new entry to the browser history. - -Check out the [`elm/url`][url] package for help building URLs. The -[`Url.absolute`][abs] and [`Url.relative`][rel] functions can be particularly -handy! - -[url]: /packages/elm/url/latest -[abs]: /packages/elm/url/latest/Url#absolute -[rel]: /packages/elm/url/latest/Url#relative - -**Note:** If the user has gone `back` a few pages, there will be “future -pages” that the user can go `forward` to. Adding a new URL in that -scenario will clear out any future pages. It is like going back in time and -making a different choice. --} -pushUrl : Key -> String -> Cmd msg -pushUrl = - Elm.Kernel.Browser.pushUrl - - -{-| Change the URL, but do not trigger a page load. - -This *will not* add a new entry to the browser history. - -This can be useful if you have search box and you want the `?search=hats` in -the URL to match without adding a history entry for every single key stroke. -Imagine how annoying it would be to click `back` thirty times and still be on -the same page! --} -replaceUrl : Key -> String -> Cmd msg -replaceUrl = - Elm.Kernel.Browser.replaceUrl - - -{-| Go back some number of pages. So `back 1` goes back one page, and `back 2` -goes back two pages. - -**Note:** You only manage the browser history that *you* created. Think of this -library as letting you have access to a small part of the overall history. So -if you go back farther than the history you own, you will just go back to some -other website! --} -back : Key -> Int -> Cmd msg -back key n = - Elm.Kernel.Browser.go key -n - - -{-| Go forward some number of pages. So `forward 1` goes forward one page, and -`forward 2` goes forward two pages. If there are no more pages in the future, -this will do nothing. - -**Note:** You only manage the browser history that *you* created. Think of this -library as letting you have access to a small part of the overall history. So -if you go forward farther than the history you own, the user will end up on -whatever website they visited next! --} -forward : Key -> Int -> Cmd msg -forward = - Elm.Kernel.Browser.go - - - --- EXTERNAL PAGES - - -{-| Leave the current page and load the given URL. **This always results in a -page load**, even if the provided URL is the same as the current one. - - gotoElmWebsite : Cmd msg - gotoElmWebsite = - load "https://elm-lang.org" - -Check out the [`elm/url`][url] package for help building URLs. The -[`Url.absolute`][abs] and [`Url.relative`][rel] functions can be particularly -handy! - -[url]: /packages/elm/url/latest -[abs]: /packages/elm/url/latest/Url#absolute -[rel]: /packages/elm/url/latest/Url#relative - --} -load : String -> Cmd msg -load = - Elm.Kernel.Browser.load - - -{-| Reload the current page. **This always results in a page load!** -This may grab resources from the browser cache, so use -[`reloadAndSkipCache`](#reloadAndSkipCache) -if you want to be sure that you are not loading any cached resources. --} -reload : Cmd msg -reload = - Elm.Kernel.Browser.reload False - - -{-| Reload the current page without using the browser cache. **This always -results in a page load!** It is more common to want [`reload`](#reload). --} -reloadAndSkipCache : Cmd msg -reloadAndSkipCache = - Elm.Kernel.Browser.reload True diff --git a/src/Debugger/Expando.elm b/src/Debugger/Expando.elm deleted file mode 100755 index 86bdee6..0000000 --- a/src/Debugger/Expando.elm +++ /dev/null @@ -1,659 +0,0 @@ -module Debugger.Expando exposing - ( Expando - , init - , merge - , Msg, update - , view - ) - - -import Dict exposing (Dict) -import Elm.Kernel.Debugger -import Json.Decode as Json -import Html exposing (Html, text, div, span) -import Html.Attributes exposing (style, class) -import Html.Events exposing (onClick) - - - --- MODEL - - -type Expando - = S String - | Primitive String - | Sequence SeqType Bool (List Expando) - | Dictionary Bool (List (Expando, Expando)) - | Record Bool (Dict String Expando) - | Constructor (Maybe String) Bool (List Expando) - - -type SeqType = ListSeq | SetSeq | ArraySeq - - -seqTypeToString : Int -> SeqType -> String -seqTypeToString n seqType = - case seqType of - ListSeq -> - "List(" ++ String.fromInt n ++ ")" - - SetSeq -> - "Set(" ++ String.fromInt n ++ ")" - - ArraySeq -> - "Array(" ++ String.fromInt n ++ ")" - - - --- INITIALIZE - - -init : a -> Expando -init value = - initHelp True (Elm.Kernel.Debugger.init value) - - -initHelp : Bool -> Expando -> Expando -initHelp isOuter expando = - case expando of - S _ -> - expando - - Primitive _ -> - expando - - Sequence seqType isClosed items -> - if isOuter then - Sequence seqType False (List.map (initHelp False) items) - else if List.length items <= 8 then - Sequence seqType False items - else - expando - - Dictionary isClosed keyValuePairs -> - if isOuter then - Dictionary False (List.map (\(k,v) -> (k, initHelp False v)) keyValuePairs) - else if List.length keyValuePairs <= 8 then - Dictionary False keyValuePairs - else - expando - - Record isClosed entries -> - if isOuter then - Record False (Dict.map (\_ v -> initHelp False v) entries) - else if Dict.size entries <= 4 then - Record False entries - else - expando - - Constructor maybeName isClosed args -> - if isOuter then - Constructor maybeName False (List.map (initHelp False) args) - else if List.length args <= 4 then - Constructor maybeName False args - else - expando - - - --- PRESERVE OLD EXPANDO STATE (open/closed) - - -merge : a -> Expando -> Expando -merge value expando = - mergeHelp expando (Elm.Kernel.Debugger.init value) - - -mergeHelp : Expando -> Expando -> Expando -mergeHelp old new = - case ( old, new ) of - ( _, S _ ) -> - new - - ( _, Primitive _ ) -> - new - - ( Sequence _ isClosed oldValues, Sequence seqType _ newValues ) -> - Sequence seqType isClosed (mergeListHelp oldValues newValues) - - ( Dictionary isClosed _, Dictionary _ keyValuePairs ) -> - Dictionary isClosed keyValuePairs - - ( Record isClosed oldDict, Record _ newDict ) -> - Record isClosed <| Dict.map (mergeDictHelp oldDict) newDict - - ( Constructor _ isClosed oldValues, Constructor maybeName _ newValues ) -> - Constructor maybeName isClosed (mergeListHelp oldValues newValues) - - _ -> - new - - -mergeListHelp : List Expando -> List Expando -> List Expando -mergeListHelp olds news = - case (olds, news) of - ( [], _ ) -> - news - - ( _, [] ) -> - news - - ( x :: xs, y :: ys ) -> - mergeHelp x y :: mergeListHelp xs ys - - -mergeDictHelp : Dict String Expando -> String -> Expando -> Expando -mergeDictHelp oldDict key value = - case Dict.get key oldDict of - Nothing -> - value - - Just oldValue -> - mergeHelp oldValue value - - - --- UPDATE - - -type Msg - = Toggle - | Index Redirect Int Msg - | Field String Msg - - -type Redirect = None | Key | Value - - -update : Msg -> Expando -> Expando -update msg value = - case value of - S _ -> - value -- Debug.crash "nothing changes a primitive" - - Primitive _ -> - value -- Debug.crash "nothing changes a primitive" - - Sequence seqType isClosed valueList -> - case msg of - Toggle -> - Sequence seqType (not isClosed) valueList - - Index None index subMsg -> - Sequence seqType isClosed <| - updateIndex index (update subMsg) valueList - - Index _ _ _ -> - value -- Debug.crash "no redirected indexes on sequences" - - Field _ _ -> - value -- Debug.crash "no field on sequences" - - Dictionary isClosed keyValuePairs -> - case msg of - Toggle -> - Dictionary (not isClosed) keyValuePairs - - Index redirect index subMsg -> - case redirect of - None -> - value -- Debug.crash "must have redirect for dictionaries" - - Key -> - Dictionary isClosed <| - updateIndex index (\(k,v) -> (update subMsg k, v)) keyValuePairs - - Value -> - Dictionary isClosed <| - updateIndex index (\(k,v) -> (k, update subMsg v)) keyValuePairs - - Field _ _ -> - value -- Debug.crash "no field for dictionaries" - - Record isClosed valueDict -> - case msg of - Toggle -> - Record (not isClosed) valueDict - - Index _ _ _ -> - value -- Debug.crash "no index for records" - - Field field subMsg -> - Record isClosed (Dict.update field (updateField subMsg) valueDict) - - Constructor maybeName isClosed valueList -> - case msg of - Toggle -> - Constructor maybeName (not isClosed) valueList - - Index None index subMsg -> - Constructor maybeName isClosed <| - updateIndex index (update subMsg) valueList - - Index _ _ _ -> - value -- Debug.crash "no redirected indexes on sequences" - - Field _ _ -> - value -- Debug.crash "no field for constructors" - - -updateIndex : Int -> (a -> a) -> List a -> List a -updateIndex n func list = - case list of - [] -> - [] - - x :: xs -> - if n <= 0 then - func x :: xs - else - x :: updateIndex (n-1) func xs - - -updateField : Msg -> Maybe Expando -> Maybe Expando -updateField msg maybeExpando = - case maybeExpando of - Nothing -> - maybeExpando -- Debug.crash "key does not exist" - - Just expando -> - Just (update msg expando) - - - --- VIEW - - -view : Maybe String -> Expando -> Html Msg -view maybeKey expando = - case expando of - S stringRep -> - div (leftPad maybeKey) (lineStarter maybeKey Nothing [span [red] [text stringRep]]) - - Primitive stringRep -> - div (leftPad maybeKey) (lineStarter maybeKey Nothing [span [blue] [text stringRep]]) - - Sequence seqType isClosed valueList -> - viewSequence maybeKey seqType isClosed valueList - - Dictionary isClosed keyValuePairs -> - viewDictionary maybeKey isClosed keyValuePairs - - Record isClosed valueDict -> - viewRecord maybeKey isClosed valueDict - - Constructor maybeName isClosed valueList -> - viewConstructor maybeKey maybeName isClosed valueList - - - --- VIEW SEQUENCE - - -viewSequence : Maybe String -> SeqType -> Bool -> List Expando -> Html Msg -viewSequence maybeKey seqType isClosed valueList = - let - starter = - seqTypeToString (List.length valueList) seqType - in - div (leftPad maybeKey) - [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [text starter]) - , if isClosed then text "" else viewSequenceOpen valueList - ] - - -viewSequenceOpen : List Expando -> Html Msg -viewSequenceOpen values = - div [] (List.indexedMap viewConstructorEntry values) - - - --- VIEW DICTIONARY - - -viewDictionary : Maybe String -> Bool -> List (Expando, Expando) -> Html Msg -viewDictionary maybeKey isClosed keyValuePairs = - let - starter = - "Dict(" ++ String.fromInt (List.length keyValuePairs) ++ ")" - in - div (leftPad maybeKey) - [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [text starter]) - , if isClosed then text "" else viewDictionaryOpen keyValuePairs - ] - - -viewDictionaryOpen : List (Expando, Expando) -> Html Msg -viewDictionaryOpen keyValuePairs = - div [] (List.indexedMap viewDictionaryEntry keyValuePairs) - - -viewDictionaryEntry : Int -> (Expando, Expando) -> Html Msg -viewDictionaryEntry index (key, value) = - case key of - S stringRep -> - Html.map (Index Value index) (view (Just stringRep) value) - - Primitive stringRep -> - Html.map (Index Value index) (view (Just stringRep) value) - - _ -> - div [] - [ Html.map (Index Key index) (view (Just "key") key) - , Html.map (Index Value index) (view (Just "value") value) - ] - - - --- VIEW RECORD - - -viewRecord : Maybe String -> Bool -> Dict String Expando -> Html Msg -viewRecord maybeKey isClosed record = - let - (start, middle, end) = - if isClosed then - ( Tuple.second (viewTinyRecord record), text "", text "" ) - else - ( [ text "{" ], viewRecordOpen record, div (leftPad (Just ())) [text "}"] ) - in - div (leftPad maybeKey) - [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) start) - , middle - , end - ] - - -viewRecordOpen : Dict String Expando -> Html Msg -viewRecordOpen record = - div [] (List.map viewRecordEntry (Dict.toList record)) - - -viewRecordEntry : (String, Expando) -> Html Msg -viewRecordEntry (field, value) = - Html.map (Field field) (view (Just field) value) - - - --- VIEW CONSTRUCTOR - - -viewConstructor : Maybe String -> Maybe String -> Bool -> List Expando -> Html Msg -viewConstructor maybeKey maybeName isClosed valueList = - let - tinyArgs = - List.map (Tuple.second << viewExtraTiny) valueList - - description = - case (maybeName, tinyArgs) of - (Nothing, []) -> - [ text "()" ] - - (Nothing, x :: xs) -> - text "( " - :: span [] x - :: List.foldr (\args rest -> text ", " :: span [] args :: rest) [text " )"] xs - - (Just name, []) -> - [ text name ] - - (Just name, x :: xs) -> - text (name ++ " ") - :: span [] x - :: List.foldr (\args rest -> text " " :: span [] args :: rest) [] xs - - (maybeIsClosed, openHtml) = - case valueList of - [] -> - ( Nothing, div [] [] ) - - [entry] -> - case entry of - S _ -> - ( Nothing, div [] [] ) - - Primitive _ -> - ( Nothing, div [] [] ) - - Sequence _ _ subValueList -> - ( Just isClosed - , if isClosed then div [] [] else Html.map (Index None 0) (viewSequenceOpen subValueList) - ) - - Dictionary _ keyValuePairs -> - ( Just isClosed - , if isClosed then div [] [] else Html.map (Index None 0) (viewDictionaryOpen keyValuePairs) - ) - - Record _ record -> - ( Just isClosed - , if isClosed then div [] [] else Html.map (Index None 0) (viewRecordOpen record) - ) - - Constructor _ _ subValueList -> - ( Just isClosed - , if isClosed then div [] [] else Html.map (Index None 0) (viewConstructorOpen subValueList) - ) - - _ -> - ( Just isClosed - , if isClosed then div [] [] else viewConstructorOpen valueList - ) - in - div (leftPad maybeKey) - [ div [ onClick Toggle ] (lineStarter maybeKey maybeIsClosed description) - , openHtml - ] - - -viewConstructorOpen : List Expando -> Html Msg -viewConstructorOpen valueList = - div [] (List.indexedMap viewConstructorEntry valueList) - - -viewConstructorEntry : Int -> Expando -> Html Msg -viewConstructorEntry index value = - Html.map (Index None index) (view (Just (String.fromInt index)) value) - - - --- VIEW TINY - - -viewTiny : Expando -> ( Int, List (Html msg) ) -viewTiny value = - case value of - S stringRep -> - let - str = - elideMiddle stringRep - in - ( String.length str - , [ span [red] [text str] ] - ) - - Primitive stringRep -> - ( String.length stringRep - , [ span [blue] [text stringRep] ] - ) - - Sequence seqType _ valueList -> - viewTinyHelp <| - seqTypeToString (List.length valueList) seqType - - Dictionary _ keyValuePairs -> - viewTinyHelp <| - "Dict(" ++ String.fromInt (List.length keyValuePairs) ++ ")" - - Record _ record -> - viewTinyRecord record - - Constructor maybeName _ [] -> - viewTinyHelp <| - Maybe.withDefault "Unit" maybeName - - Constructor maybeName _ valueList -> - viewTinyHelp <| - case maybeName of - Nothing -> - "Tuple(" ++ String.fromInt (List.length valueList) ++ ")" - - Just name -> - name ++ " …" - - -viewTinyHelp : String -> ( Int, List (Html msg) ) -viewTinyHelp str = - ( String.length str, [text str] ) - - -elideMiddle : String -> String -elideMiddle str = - if String.length str <= 18 then - str - - else - String.left 8 str ++ "..." ++ String.right 8 str - - - --- VIEW TINY RECORDS - - -viewTinyRecord : Dict String Expando -> ( Int, List (Html msg) ) -viewTinyRecord record = - if Dict.isEmpty record then - ( 2, [text "{}"] ) - - else - viewTinyRecordHelp 0 "{ " (Dict.toList record) - - -viewTinyRecordHelp : Int -> String -> List (String, Expando) -> ( Int, List (Html msg) ) -viewTinyRecordHelp length starter entries = - case entries of - [] -> - ( length + 2, [ text " }" ] ) - - (field, value) :: rest -> - let - fieldLen = - String.length field - - (valueLen, valueHtmls) = - viewExtraTiny value - - newLength = - length + fieldLen + valueLen + 5 - in - if newLength > 60 then - ( length + 4, [text ", … }"] ) - - else - let - ( finalLength, otherHtmls ) = - viewTinyRecordHelp newLength ", " rest - in - ( finalLength - , text starter - :: span [purple] [text field] - :: text " = " - :: span [] valueHtmls - :: otherHtmls - ) - - -viewExtraTiny : Expando -> ( Int, List (Html msg) ) -viewExtraTiny value = - case value of - Record _ record -> - viewExtraTinyRecord 0 "{" (Dict.keys record) - - _ -> - viewTiny value - - -viewExtraTinyRecord : Int -> String -> List String -> ( Int, List (Html msg) ) -viewExtraTinyRecord length starter entries = - case entries of - [] -> - ( length + 1, [text "}"] ) - - field :: rest -> - let - nextLength = - length + String.length field + 1 - in - if nextLength > 18 then - ( length + 2, [text "…}"]) - - else - let - (finalLength, otherHtmls) = - viewExtraTinyRecord nextLength "," rest - in - ( finalLength - , text starter :: span [purple] [text field] :: otherHtmls - ) - - - --- VIEW HELPERS - - -lineStarter : Maybe String -> Maybe Bool -> List (Html msg) -> List (Html msg) -lineStarter maybeKey maybeIsClosed description = - let - arrow = - case maybeIsClosed of - Nothing -> - makeArrow "" - - Just True -> - makeArrow "▸" - - Just False -> - makeArrow "▾" - in - case maybeKey of - Nothing -> - arrow :: description - - Just key -> - arrow :: span [purple] [text key] :: text " = " :: description - - -makeArrow : String -> Html msg -makeArrow arrow = - span - [ style "color" "#777" - , style "padding-left" "2ch" - , style "width" "2ch" - , style "display" "inline-block" - ] - [ text arrow ] - - -leftPad : Maybe a -> List (Html.Attribute msg) -leftPad maybeKey = - case maybeKey of - Nothing -> - [] - - Just _ -> - [ style "padding-left" "4ch" ] - - -red : Html.Attribute msg -red = - style "color" "rgb(196, 26, 22)" - - -blue : Html.Attribute msg -blue = - style "color" "rgb(28, 0, 207)" - - -purple : Html.Attribute msg -purple = - style "color" "rgb(136, 19, 145)" diff --git a/src/Debugger/History.elm b/src/Debugger/History.elm deleted file mode 100755 index a9a1ccd..0000000 --- a/src/Debugger/History.elm +++ /dev/null @@ -1,353 +0,0 @@ -module Debugger.History exposing - ( History - , empty - , size - , getInitialModel - , add - , get - , view - , decoder - , encode - ) - - -import Array exposing (Array) -import Elm.Kernel.Debugger -import Json.Decode as Decode -import Json.Encode as Encode -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onClick) -import Html.Lazy exposing (..) -import Debugger.Metadata as Metadata - - - --- CONSTANTS - - -maxSnapshotSize : Int -maxSnapshotSize = - 64 - - - --- HISTORY - - -type alias History model msg = - { snapshots : Array (Snapshot model msg) - , recent : RecentHistory model msg - , numMessages : Int - } - - -type alias RecentHistory model msg = - { model : model - , messages : List msg - , numMessages : Int - } - - -type alias Snapshot model msg = - { model : model - , messages : Array msg - } - - -empty : model -> History model msg -empty model = - History Array.empty (RecentHistory model [] 0) 0 - - -size : History model msg -> Int -size history = - history.numMessages - - -getInitialModel : History model msg -> model -getInitialModel { snapshots, recent } = - case Array.get 0 snapshots of - Just { model } -> - model - - Nothing -> - recent.model - - - --- JSON - - -decoder : model -> (msg -> model -> model) -> Decode.Decoder (model, History model msg) -decoder initialModel update = - let - addMessage rawMsg (model, history) = - let - msg = - jsToElm rawMsg - in - (update msg model, add msg model history) - - updateModel rawMsgs = - List.foldl addMessage (initialModel, empty initialModel) rawMsgs - in - Decode.map updateModel (Decode.list Decode.value) - - -jsToElm : Encode.Value -> a -jsToElm = - Elm.Kernel.Debugger.unsafeCoerce - - -encode : History model msg -> Encode.Value -encode { snapshots, recent } = - Encode.list elmToJs <| Array.foldr encodeHelp (List.reverse recent.messages) snapshots - - -encodeHelp : Snapshot model msg -> List msg -> List msg -encodeHelp snapshot allMessages = - Array.foldl (::) allMessages snapshot.messages - - -elmToJs : a -> Encode.Value -elmToJs = - Elm.Kernel.Debugger.unsafeCoerce - - - --- ADD MESSAGES - - -add : msg -> model -> History model msg -> History model msg -add msg model { snapshots, recent, numMessages } = - case addRecent msg model recent of - (Just snapshot, newRecent) -> - History (Array.push snapshot snapshots) newRecent (numMessages + 1) - - (Nothing, newRecent) -> - History snapshots newRecent (numMessages + 1) - - -addRecent - : msg - -> model - -> RecentHistory model msg - -> ( Maybe (Snapshot model msg), RecentHistory model msg ) -addRecent msg newModel { model, messages, numMessages } = - if numMessages == maxSnapshotSize then - ( Just (Snapshot model (Array.fromList messages)) - , RecentHistory newModel [msg] 1 - ) - - else - ( Nothing - , RecentHistory model (msg :: messages) (numMessages + 1) - ) - - - --- GET SUMMARY - - -get : (msg -> model -> (model, a)) -> Int -> History model msg -> ( model, msg ) -get update index history = - let - recent = - history.recent - - snapshotMax = - history.numMessages - recent.numMessages - in - if index >= snapshotMax then - undone <| - List.foldr (getHelp update) (Stepping (index - snapshotMax) recent.model) recent.messages - - else - case Array.get (index // maxSnapshotSize) history.snapshots of - Nothing -> - get update index history - -- Debug.crash "UI should only let you ask for real indexes!" - - Just { model, messages } -> - undone <| - Array.foldr (getHelp update) (Stepping (remainderBy maxSnapshotSize index) model) messages - - -type GetResult model msg - = Stepping Int model - | Done msg model - - -getHelp : (msg -> model -> (model, a)) -> msg -> GetResult model msg -> GetResult model msg -getHelp update msg getResult = - case getResult of - Done _ _ -> - getResult - - Stepping n model -> - if n == 0 then - Done msg (Tuple.first (update msg model)) - - else - Stepping (n - 1) (Tuple.first (update msg model)) - - -undone : GetResult model msg -> ( model, msg ) -undone getResult = - case getResult of - Done msg model -> - ( model, msg ) - - Stepping _ _ -> - undone getResult -- Debug.crash "Bug in History.get" - - - --- VIEW - - -view : Maybe Int -> History model msg -> Html Int -view maybeIndex { snapshots, recent, numMessages } = - let - (index, height) = - case maybeIndex of - Nothing -> - ( -1, "calc(100% - 24px)" ) - Just i -> - ( i, "calc(100% - 54px)" ) - - oldStuff = - lazy2 viewSnapshots index snapshots - - newStuff = - Tuple.second <| List.foldl (consMsg index) (numMessages - 1, []) recent.messages - in - div - [ id "elm-debugger-sidebar" - , style "width" "100%" - , style "overflow-y" "auto" - , style "height" height - ] - (styles :: oldStuff :: newStuff) - - - --- VIEW SNAPSHOTS - - -viewSnapshots : Int -> Array (Snapshot model msg) -> Html Int -viewSnapshots currentIndex snapshots = - let - highIndex = - maxSnapshotSize * Array.length snapshots - in - div [] <| Tuple.second <| - Array.foldr (consSnapshot currentIndex) (highIndex, []) snapshots - - -consSnapshot : Int -> Snapshot model msg -> ( Int, List (Html Int) ) -> ( Int, List (Html Int) ) -consSnapshot currentIndex snapshot (index, rest) = - let - nextIndex = - index - maxSnapshotSize - - currentIndexHelp = - if nextIndex <= currentIndex && currentIndex < index then currentIndex else -1 - in - ( index - maxSnapshotSize - , lazy3 viewSnapshot currentIndexHelp index snapshot :: rest - ) - - -viewSnapshot : Int -> Int -> Snapshot model msg -> Html Int -viewSnapshot currentIndex index { messages } = - div [] <| Tuple.second <| - Array.foldl (consMsg currentIndex) (index - 1, []) messages - - - --- VIEW MESSAGE - - -consMsg : Int -> msg -> ( Int, List (Html Int) ) -> ( Int, List (Html Int) ) -consMsg currentIndex msg (index, rest) = - ( index - 1 - , lazy3 viewMessage currentIndex index msg :: rest - ) - - -viewMessage : Int -> Int -> msg -> Html Int -viewMessage currentIndex index msg = - let - className = - if currentIndex == index then - "elm-debugger-entry elm-debugger-entry-selected" - else - "elm-debugger-entry" - - messageName = - Elm.Kernel.Debugger.messageToString msg - in - div - [ class className - , onClick index - ] - [ span - [ title messageName - , class "elm-debugger-entry-content" - ] - [ text messageName - ] - , span - [ class "elm-debugger-entry-index" - ] - [ text (String.fromInt index) - ] - ] - - - --- STYLES - - -styles : Html msg -styles = - Html.node "style" [] [ text """ - -.elm-debugger-entry { - cursor: pointer; - width: 100%; -} - -.elm-debugger-entry:hover { - background-color: rgb(41, 41, 41); -} - -.elm-debugger-entry-selected, .elm-debugger-entry-selected:hover { - background-color: rgb(10, 10, 10); -} - -.elm-debugger-entry-content { - width: calc(100% - 7ch); - padding-top: 4px; - padding-bottom: 4px; - padding-left: 1ch; - text-overflow: ellipsis; - white-space: nowrap; - overflow: hidden; - display: inline-block; -} - -.elm-debugger-entry-index { - color: #666; - width: 5ch; - padding-top: 4px; - padding-bottom: 4px; - padding-right: 1ch; - text-align: right; - display: block; - float: right; -} - -""" ] diff --git a/src/Debugger/Main.elm b/src/Debugger/Main.elm deleted file mode 100755 index c6f13f4..0000000 --- a/src/Debugger/Main.elm +++ /dev/null @@ -1,480 +0,0 @@ -module Debugger.Main exposing - ( wrapInit - , wrapUpdate - , wrapSubs - , getUserModel - , cornerView - , popoutView - ) - - -import Elm.Kernel.Debugger -import Json.Decode as Decode -import Json.Encode as Encode -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onClick) -import Task exposing (Task) -import Debugger.Expando as Expando exposing (Expando) -import Debugger.History as History exposing (History) -import Debugger.Metadata as Metadata exposing (Metadata) -import Debugger.Overlay as Overlay -import Debugger.Report as Report - - - --- VIEW - - -getUserModel : Model model msg -> model -getUserModel model = - getCurrentModel model.state - - - --- SUBSCRIPTIONS - - -wrapSubs : (model -> Sub msg) -> Model model msg -> Sub (Msg msg) -wrapSubs subscriptions model = - Sub.map UserMsg (subscriptions (getLatestModel model.state)) - - - --- MODEL - - -type alias Model model msg = - { history : History model msg - , state : State model - , expando : Expando - , metadata : Result Metadata.Error Metadata - , overlay : Overlay.State - , popout : Popout - } - - -type Popout = Popout Popout - - - --- STATE - - -type State model - = Running model - | Paused Int model model - - -getLatestModel : State model -> model -getLatestModel state = - case state of - Running model -> - model - - Paused _ _ model -> - model - - -getCurrentModel : State model -> model -getCurrentModel state = - case state of - Running model -> - model - - Paused _ model _ -> - model - - -isPaused : State model -> Bool -isPaused state = - case state of - Running _ -> - False - - Paused _ _ _ -> - True - - - --- INIT - - -wrapInit : Encode.Value -> Popout -> (flags -> (model, Cmd msg)) -> flags -> (Model model msg, Cmd (Msg msg)) -wrapInit metadata popout init flags = - let - (userModel, userCommands) = - init flags - in - ( { history = History.empty userModel - , state = Running userModel - , expando = Expando.init userModel - , metadata = Metadata.decode metadata - , overlay = Overlay.none - , popout = popout - } - , Cmd.map UserMsg userCommands - ) - - - --- UPDATE - - -type Msg msg - = NoOp - | UserMsg msg - | ExpandoMsg Expando.Msg - | Resume - | Jump Int - | Open - | Up - | Down - | Import - | Export - | Upload String - | OverlayMsg Overlay.Msg - - -type alias UserUpdate model msg = - msg -> model -> ( model, Cmd msg ) - - -wrapUpdate : UserUpdate model msg -> Msg msg -> Model model msg -> (Model model msg, Cmd (Msg msg)) -wrapUpdate update msg model = - case msg of - NoOp -> - ( model, Cmd.none ) - - UserMsg userMsg -> - let - userModel = getLatestModel model.state - newHistory = History.add userMsg userModel model.history - (newUserModel, userCmds) = update userMsg userModel - commands = Cmd.map UserMsg userCmds - in - case model.state of - Running _ -> - ( { model - | history = newHistory - , state = Running newUserModel - , expando = Expando.merge newUserModel model.expando - } - , Cmd.batch [ commands, scroll model.popout ] - ) - - Paused index indexModel _ -> - ( { model - | history = newHistory - , state = Paused index indexModel newUserModel - } - , commands - ) - - ExpandoMsg eMsg -> - ( { model | expando = Expando.update eMsg model.expando } - , Cmd.none - ) - - Resume -> - case model.state of - Running _ -> - ( model, Cmd.none ) - - Paused _ _ userModel -> - ( { model - | state = Running userModel - , expando = Expando.merge userModel model.expando - } - , scroll model.popout - ) - - Jump index -> - let - (indexModel, indexMsg) = - History.get update index model.history - in - ( { model - | state = Paused index indexModel (getLatestModel model.state) - , expando = Expando.merge indexModel model.expando - } - , Cmd.none - ) - - Open -> - ( { model | popout = Elm.Kernel.Debugger.open model.popout } - , Cmd.none - ) - - Up -> - let - index = - case model.state of - Paused i _ _ -> - i - - Running _ -> - History.size model.history - in - if index > 0 then - wrapUpdate update (Jump (index - 1)) model - else - ( model, Cmd.none ) - - Down -> - case model.state of - Running _ -> - ( model, Cmd.none ) - - Paused index _ userModel -> - if index == History.size model.history - 1 then - wrapUpdate update Resume model - else - wrapUpdate update (Jump (index + 1)) model - - Import -> - withGoodMetadata model <| \_ -> - ( model, upload ) - - Export -> - withGoodMetadata model <| \metadata -> - ( model, download metadata model.history ) - - Upload jsonString -> - withGoodMetadata model <| \metadata -> - case Overlay.assessImport metadata jsonString of - Err newOverlay -> - ( { model | overlay = newOverlay }, Cmd.none ) - - Ok rawHistory -> - loadNewHistory rawHistory update model - - OverlayMsg overlayMsg -> - case Overlay.close overlayMsg model.overlay of - Nothing -> - ( { model | overlay = Overlay.none }, Cmd.none ) - - Just rawHistory -> - loadNewHistory rawHistory update model - - - --- COMMANDS - - -scroll : Popout -> Cmd (Msg msg) -scroll popout = - Task.perform (always NoOp) (Elm.Kernel.Debugger.scroll popout) - - -upload : Cmd (Msg msg) -upload = - Task.perform Upload (Elm.Kernel.Debugger.upload ()) - - -download : Metadata -> History model msg -> Cmd (Msg msg) -download metadata history = - let - historyLength = - History.size history - - json = - Encode.object - [ ("metadata", Metadata.encode metadata) - , ("history", History.encode history) - ] - in - Task.perform (\_ -> NoOp) (Elm.Kernel.Debugger.download historyLength json) - - - --- UPDATE OVERLAY - - -withGoodMetadata - : Model model msg - -> (Metadata -> (Model model msg, Cmd (Msg msg))) - -> (Model model msg, Cmd (Msg msg)) -withGoodMetadata model func = - case model.metadata of - Ok metadata -> - func metadata - - Err error -> - ( { model | overlay = Overlay.badMetadata error } - , Cmd.none - ) - - -loadNewHistory - : Encode.Value - -> UserUpdate model msg - -> Model model msg - -> ( Model model msg, Cmd (Msg msg) ) -loadNewHistory rawHistory update model = - let - initialUserModel = - History.getInitialModel model.history - - pureUserUpdate msg userModel = - Tuple.first (update msg userModel) - - decoder = - History.decoder initialUserModel pureUserUpdate - in - case Decode.decodeValue decoder rawHistory of - Err _ -> - ( { model | overlay = Overlay.corruptImport } - , Cmd.none - ) - - Ok (latestUserModel, newHistory) -> - ( { model - | history = newHistory - , state = Running latestUserModel - , expando = Expando.init latestUserModel - , overlay = Overlay.none - } - , Cmd.none - ) - - - --- CORNER VIEW - - -cornerView : Model model msg -> Html (Msg msg) -cornerView model = - Overlay.view - { resume = Resume - , open = Open - , importHistory = Import - , exportHistory = Export - , wrap = OverlayMsg - } - (isPaused model.state) - (Elm.Kernel.Debugger.isOpen model.popout) - (History.size model.history) - model.overlay - - -toBlockerType : Model model msg -> Overlay.BlockerType -toBlockerType model = - Overlay.toBlockerType (isPaused model.state) model.overlay - - - --- BIG DEBUG VIEW - - -popoutView : Model model msg -> Html (Msg msg) -popoutView { history, state, expando } = - node "body" - [ style "margin" "0" - , style "padding" "0" - , style "width" "100%" - , style "height" "100%" - , style "font-family" "monospace" - , style "overflow" "auto" - ] - [ viewSidebar state history - , Html.map ExpandoMsg <| - div - [ style "display" "block" - , style "float" "left" - , style "height" "100%" - , style "width" "calc(100% - 30ch)" - , style "margin" "0" - , style "overflow" "auto" - , style "cursor" "default" - ] - [ Expando.view Nothing expando - ] - ] - - -viewSidebar : State model -> History model msg -> Html (Msg msg) -viewSidebar state history = - let - maybeIndex = - case state of - Running _ -> - Nothing - - Paused index _ _ -> - Just index - in - div - [ style "display" "block" - , style "float" "left" - , style "width" "30ch" - , style "height" "100%" - , style "color" "white" - , style "background-color" "rgb(61, 61, 61)" - ] - [ Html.map Jump (History.view maybeIndex history) - , playButton maybeIndex - ] - - -playButton : Maybe Int -> Html (Msg msg) -playButton maybeIndex = - div - [ style "width" "100%" - , style "text-align" "center" - , style "background-color" "rgb(50, 50, 50)" - ] - [ viewResumeButton maybeIndex - , div - [ style "width" "100%" - , style "height" "24px" - , style "line-height" "24px" - , style "font-size" "12px" - ] - [ viewTextButton Import "Import" - , text " / " - , viewTextButton Export "Export" - ] - ] - - -viewTextButton : msg -> String -> Html msg -viewTextButton msg label = - span - [ onClick msg - , style "cursor" "pointer" - ] - [ text label ] - - -viewResumeButton : Maybe Int -> Html (Msg msg) -viewResumeButton maybeIndex = - case maybeIndex of - Nothing -> - text "" - - Just _ -> - div - [ onClick Resume - , class "elm-debugger-resume" - ] - [ text "Resume" - , Html.node "style" [] [ text resumeStyle ] - ] - - -resumeStyle : String -resumeStyle = """ - -.elm-debugger-resume { - width: 100%; - height: 30px; - line-height: 30px; - cursor: pointer; -} - -.elm-debugger-resume:hover { - background-color: rgb(41, 41, 41); -} - -""" diff --git a/src/Debugger/Metadata.elm b/src/Debugger/Metadata.elm deleted file mode 100755 index c923ed6..0000000 --- a/src/Debugger/Metadata.elm +++ /dev/null @@ -1,326 +0,0 @@ -module Debugger.Metadata exposing - ( Metadata - , check - , decode, decoder, encode - , Error, ProblemType, Problem(..) - ) - - -import Array exposing (Array) -import Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode -import Debugger.Report as Report exposing (Report) - - - --- METADATA - - -type alias Metadata = - { versions : Versions - , types : Types - } - - - --- VERSIONS - - -type alias Versions = - { elm : String - } - - - --- TYPES - - -type alias Types = - { message : String - , aliases : Dict String Alias - , unions : Dict String Union - } - - -type alias Alias = - { args : List String - , tipe : String - } - - -type alias Union = - { args : List String - , tags : Dict String (List String) - } - - - --- PORTABILITY - - -isPortable : Metadata -> Maybe Error -isPortable {types} = - let - badAliases = - Dict.foldl collectBadAliases [] types.aliases - in - case Dict.foldl collectBadUnions badAliases types.unions of - [] -> - Nothing - - problems -> - Just (Error types.message problems) - - -type alias Error = - { message : String - , problems : List ProblemType - } - - -type alias ProblemType = - { name : String - , problems : List Problem - } - - -type Problem - = Function - | Decoder - | Task - | Process - | Socket - | Request - | Program - | VirtualDom - - -collectBadAliases : String -> Alias -> List ProblemType -> List ProblemType -collectBadAliases name {tipe} list = - case findProblems tipe of - [] -> - list - - problems -> - ProblemType name problems :: list - - -collectBadUnions : String -> Union -> List ProblemType -> List ProblemType -collectBadUnions name {tags} list = - case List.concatMap findProblems (List.concat (Dict.values tags)) of - [] -> - list - - problems -> - ProblemType name problems :: list - - -findProblems : String -> List Problem -findProblems tipe = - List.filterMap (hasProblem tipe) problemTable - - -hasProblem : String -> (Problem, String) -> Maybe Problem -hasProblem tipe (problem, token) = - if String.contains token tipe then Just problem else Nothing - - -problemTable : List (Problem, String) -problemTable = - [ ( Function, "->" ) - , ( Decoder, "Json.Decode.Decoder" ) - , ( Task, "Task.Task" ) - , ( Process, "Process.Id" ) - , ( Socket, "WebSocket.LowLevel.WebSocket" ) - , ( Request, "Http.Request" ) - , ( Program, "Platform.Program" ) - , ( VirtualDom, "VirtualDom.Node" ) - , ( VirtualDom, "VirtualDom.Attribute" ) - ] - - - --- CHECK - - -check : Metadata -> Metadata -> Report -check old new = - if old.versions.elm /= new.versions.elm then - Report.VersionChanged old.versions.elm new.versions.elm - - else - checkTypes old.types new.types - - -checkTypes : Types -> Types -> Report -checkTypes old new = - if old.message /= new.message then - Report.MessageChanged old.message new.message - - else - [] - |> Dict.merge ignore checkAlias ignore old.aliases new.aliases - |> Dict.merge ignore checkUnion ignore old.unions new.unions - |> Report.SomethingChanged - - -ignore : String -> value -> a -> a -ignore key value report = - report - - - --- CHECK ALIASES - - -checkAlias : String -> Alias -> Alias -> List Report.Change -> List Report.Change -checkAlias name old new changes = - if old.tipe == new.tipe && old.args == new.args then - changes - - else - Report.AliasChange name :: changes - - - --- CHECK UNIONS - - -checkUnion : String -> Union -> Union -> List Report.Change -> List Report.Change -checkUnion name old new changes = - let - tagChanges = - Dict.merge removeTag checkTag addTag old.tags new.tags <| - Report.emptyTagChanges (old.args == new.args) - in - if Report.hasTagChanges tagChanges then - changes - - else - Report.UnionChange name tagChanges :: changes - - -removeTag : String -> a -> Report.TagChanges -> Report.TagChanges -removeTag tag _ changes = - { changes | removed = tag :: changes.removed } - - -addTag : String -> a -> Report.TagChanges -> Report.TagChanges -addTag tag _ changes = - { changes | added = tag :: changes.added } - - -checkTag : String -> a -> a -> Report.TagChanges -> Report.TagChanges -checkTag tag old new changes = - if old == new then - changes - - else - { changes | changed = tag :: changes.changed } - - - --- JSON DECODE - - -decode : Encode.Value -> Result Error Metadata -decode value = - case Decode.decodeValue decoder value of - Err _ -> - Err (Error "The compiler is generating bad metadata. This is a compiler bug!" []) - - Ok metadata -> - case isPortable metadata of - Nothing -> - Ok metadata - - Just error -> - Err error - - -decoder : Decode.Decoder Metadata -decoder = - Decode.map2 Metadata - (Decode.field "versions" decodeVersions) - (Decode.field "types" decodeTypes) - - -decodeVersions : Decode.Decoder Versions -decodeVersions = - Decode.map Versions - (Decode.field "elm" Decode.string) - - -decodeTypes : Decode.Decoder Types -decodeTypes = - Decode.map3 Types - (Decode.field "message" Decode.string) - (Decode.field "aliases" (Decode.dict decodeAlias)) - (Decode.field "unions" (Decode.dict decodeUnion)) - - -decodeUnion : Decode.Decoder Union -decodeUnion = - Decode.map2 Union - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "tags" (Decode.dict (Decode.list Decode.string))) - - -decodeAlias : Decode.Decoder Alias -decodeAlias = - Decode.map2 Alias - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "type" (Decode.string)) - - - --- JSON ENCODE - - -encode : Metadata -> Encode.Value -encode { versions, types } = - Encode.object - [ ("versions", encodeVersions versions) - , ("types", encodeTypes types) - ] - - -encodeVersions : Versions -> Encode.Value -encodeVersions { elm } = - Encode.object [("elm", Encode.string elm)] - - -encodeTypes : Types -> Encode.Value -encodeTypes { message, unions, aliases } = - Encode.object - [ ("message", Encode.string message) - , ("aliases", encodeDict encodeAlias aliases) - , ("unions", encodeDict encodeUnion unions) - ] - - -encodeAlias : Alias -> Encode.Value -encodeAlias { args, tipe } = - Encode.object - [ ("args", Encode.list Encode.string args) - , ("type", Encode.string tipe) - ] - - -encodeUnion : Union -> Encode.Value -encodeUnion { args, tags } = - Encode.object - [ ("args", Encode.list Encode.string args) - , ("tags", encodeDict (Encode.list Encode.string) tags) - ] - - -encodeDict : (a -> Encode.Value) -> Dict String a -> Encode.Value -encodeDict f dict = - dict - |> Dict.map (\key value -> f value) - |> Dict.toList - |> Encode.object - - diff --git a/src/Debugger/Overlay.elm b/src/Debugger/Overlay.elm deleted file mode 100755 index b1dd7de..0000000 --- a/src/Debugger/Overlay.elm +++ /dev/null @@ -1,502 +0,0 @@ -module Debugger.Overlay exposing - ( State, none, corruptImport, badMetadata - , Msg, close, assessImport - , BlockerType(..), toBlockerType - , Config - , view - , viewImportExport - ) - -import Json.Decode as Decode -import Json.Encode as Encode -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onClick) -import Debugger.Metadata as Metadata exposing (Metadata) -import Debugger.Report as Report exposing (Report) - - - -type State - = None - | BadMetadata Metadata.Error - | BadImport Report - | RiskyImport Report Encode.Value - - -none : State -none = - None - - -corruptImport : State -corruptImport = - BadImport Report.CorruptHistory - - -badMetadata : Metadata.Error -> State -badMetadata = - BadMetadata - - - --- UPDATE - - -type Msg = Cancel | Proceed - - -close : Msg -> State -> Maybe Encode.Value -close msg state = - case state of - None -> - Nothing - - BadMetadata _ -> - Nothing - - BadImport _ -> - Nothing - - RiskyImport _ rawHistory -> - case msg of - Cancel -> - Nothing - - Proceed -> - Just rawHistory - - -assessImport : Metadata -> String -> Result State Encode.Value -assessImport metadata jsonString = - case Decode.decodeString uploadDecoder jsonString of - Err _ -> - Err corruptImport - - Ok (foreignMetadata, rawHistory) -> - let - report = - Metadata.check foreignMetadata metadata - in - case Report.evaluate report of - Report.Impossible -> - Err (BadImport report) - - Report.Risky -> - Err (RiskyImport report rawHistory) - - Report.Fine -> - Ok rawHistory - - -uploadDecoder : Decode.Decoder (Metadata, Encode.Value) -uploadDecoder = - Decode.map2 (\x y -> (x,y)) - (Decode.field "metadata" Metadata.decoder) - (Decode.field "history" Decode.value) - - - --- BLOCKERS - - -type BlockerType = BlockNone | BlockMost | BlockAll - - -toBlockerType : Bool -> State -> BlockerType -toBlockerType isPaused state = - case state of - None -> if isPaused then BlockAll else BlockNone - BadMetadata _ -> BlockMost - BadImport _ -> BlockMost - RiskyImport _ _ -> BlockMost - - - --- VIEW - - -type alias Config msg = - { resume : msg - , open : msg - , importHistory : msg - , exportHistory : msg - , wrap : Msg -> msg - } - - -view : Config msg -> Bool -> Bool -> Int -> State -> Html msg -view config isPaused isOpen numMsgs state = - case state of - None -> - if isOpen then - text "" - - else - if isPaused then - div - [ style "width" "100%" - , style "height" "100%" - , style "cursor" "pointer" - , style "text-align" "center" - , style "pointer-events" "auto" - , style "background-color" "rgba(200, 200, 200, 0.7)" - , style "color" "white" - , style "font-family" "'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif" - , style "z-index" "2147483646" - , onClick config.resume - ] - [ div - [ style "position" "absolute" - , style "top" "calc(50% - 40px)" - , style "font-size" "80px" - , style "line-height" "80px" - , style "height" "80px" - , style "width" "100%" - ] - [ text "Click to Resume" - ] - , viewMiniControls config numMsgs - ] - else - viewMiniControls config numMsgs - - BadMetadata badMetadata_ -> - viewMessage config - "Cannot use Import or Export" - (viewBadMetadata badMetadata_) - (Accept "Ok") - - BadImport report -> - viewMessage config - "Cannot Import History" - (viewReport True report) - (Accept "Ok") - - RiskyImport report _ -> - viewMessage config - "Warning" - (viewReport False report) - (Choose "Cancel" "Import Anyway") - - - --- VIEW MESSAGE - - -viewMessage : Config msg -> String -> List (Html msg) -> Buttons -> Html msg -viewMessage config title details buttons = - div - [ id "elm-debugger-overlay" - , style "position" "fixed" - , style "top" "0" - , style "left" "0" - , style "width" "100%" - , style "height" "100%" - , style "color" "white" - , style "pointer-events" "none" - , style "font-family" "'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif" - , style "z-index" "2147483647" - ] - [ div - [ style "position" "absolute" - , style "width" "600px" - , style "height" "100%" - , style "padding-left" "calc(50% - 300px)" - , style "padding-right" "calc(50% - 300px)" - , style "background-color" "rgba(200, 200, 200, 0.7)" - , style "pointer-events" "auto" - ] - [ div - [ style "font-size" "36px" - , style "height" "80px" - , style "background-color" "rgb(50, 50, 50)" - , style "padding-left" "22px" - , style "vertical-align" "middle" - , style "line-height" "80px" - ] - [ text title ] - , div - [ id "elm-debugger-details" - , style "padding" " 8px 20px" - , style "overflow-y" "auto" - , style "max-height" "calc(100% - 156px)" - , style "background-color" "rgb(61, 61, 61)" - ] - details - , Html.map config.wrap (viewButtons buttons) - ] - ] - - -viewReport : Bool -> Report -> List (Html msg) -viewReport isBad report = - case report of - Report.CorruptHistory -> - [ text "Looks like this history file is corrupt. I cannot understand it." - ] - - Report.VersionChanged old new -> - [ text <| - "This history was created with Elm " - ++ old ++ ", but you are using Elm " - ++ new ++ " right now." - ] - - Report.MessageChanged old new -> - [ text <| - "To import some other history, the overall message type must" - ++ " be the same. The old history has " - , viewCode old - , text " messages, but the new program works with " - , viewCode new - , text " messages." - ] - - Report.SomethingChanged changes -> - [ p [] [ text (if isBad then explanationBad else explanationRisky) ] - , ul - [ style "list-style-type" "none" - , style "padding-left" "20px" - ] - (List.map viewChange changes) - ] - - -explanationBad : String -explanationBad = """ -The messages in this history do not match the messages handled by your -program. I noticed changes in the following types: -""" - -explanationRisky : String -explanationRisky = """ -This history seems old. It will work with this program, but some -messages have been added since the history was created: -""" - - -viewCode : String -> Html msg -viewCode name = - code [] [ text name ] - - -viewChange : Report.Change -> Html msg -viewChange change = - li [ style "margin" "8px 0" ] <| - case change of - Report.AliasChange name -> - [ span [ style "font-size" "1.5em" ] [ viewCode name ] - ] - - Report.UnionChange name { removed, changed, added, argsMatch } -> - [ span [ style "font-size" "1.5em" ] [ viewCode name ] - , ul - [ style "list-style-type" "disc" - , style "padding-left" "2em" - ] - [ viewMention removed "Removed " - , viewMention changed "Changed " - , viewMention added "Added " - ] - , if argsMatch then - text "" - else - text "This may be due to the fact that the type variable names changed." - ] - - -viewMention : List String -> String -> Html msg -viewMention tags verbed = - case List.map viewCode (List.reverse tags) of - [] -> - text "" - - [tag] -> - li [] - [ text verbed, tag, text "." ] - - [tag2, tag1] -> - li [] - [ text verbed, tag1, text " and ", tag2, text "." ] - - lastTag :: otherTags -> - li [] <| - text verbed - :: List.intersperse (text ", ") (List.reverse otherTags) - ++ [ text ", and ", lastTag, text "." ] - - -viewBadMetadata : Metadata.Error -> List (Html msg) -viewBadMetadata {message, problems} = - [ p [] - [ text "The " - , viewCode message - , text " type of your program cannot be reliably serialized for history files." - ] - , p [] [ text "Functions cannot be serialized, nor can values that contain functions. This is a problem in these places:" ] - , ul [] (List.map viewProblemType problems) - , p [] - [ text goodNews1 - , a [ href "https://guide.elm-lang.org/types/union_types.html" ] [ text "union types" ] - , text ", in your messages. From there, your " - , viewCode "update" - , text goodNews2 - ] - ] - - -goodNews1 = """ -The good news is that having values like this in your message type is not -so great in the long run. You are better off using simpler data, like -""" - - -goodNews2 = """ -function can pattern match on that data and call whatever functions, JSON -decoders, etc. you need. This makes the code much more explicit and easy to -follow for other readers (or you in a few months!) -""" - - -viewProblemType : Metadata.ProblemType -> Html msg -viewProblemType { name, problems } = - li [] - [ viewCode name - , text (" can contain " ++ addCommas (List.map problemToString problems) ++ ".") - ] - - -problemToString : Metadata.Problem -> String -problemToString problem = - case problem of - Metadata.Function -> - "functions" - - Metadata.Decoder -> - "JSON decoders" - - Metadata.Task -> - "tasks" - - Metadata.Process -> - "processes" - - Metadata.Socket -> - "web sockets" - - Metadata.Request -> - "HTTP requests" - - Metadata.Program -> - "programs" - - Metadata.VirtualDom -> - "virtual DOM values" - - -addCommas : List String -> String -addCommas items = - case items of - [] -> - "" - - [item] -> - item - - [item1, item2] -> - item1 ++ " and " ++ item2 - - lastItem :: otherItems -> - String.join ", " (otherItems ++ [ " and " ++ lastItem ]) - - - --- VIEW MESSAGE BUTTONS - - -type Buttons - = Accept String - | Choose String String - - -viewButtons : Buttons -> Html Msg -viewButtons buttons = - let - btn msg string = - Html.button - [ style "margin-right" "20px" - , onClick msg - ] - [ text string ] - - buttonNodes = - case buttons of - Accept proceed -> - [ btn Proceed proceed - ] - - Choose cancel proceed -> - [ btn Cancel cancel - , btn Proceed proceed - ] - in - div - [ style "height" "60px" - , style "line-height" "60px" - , style "text-align" "right" - , style "background-color" "rgb(50, 50, 50)" - ] - buttonNodes - - - --- VIEW MINI CONTROLS - - -viewMiniControls : Config msg -> Int -> Html msg -viewMiniControls config numMsgs = - div - [ style "position" "fixed" - , style "bottom" "0" - , style "right" "6px" - , style "border-radius" "4px" - , style "background-color" "rgb(61, 61, 61)" - , style "color" "white" - , style "font-family" "monospace" - , style "pointer-events" "auto" - , style "z-index" "2147483647" - ] - [ div - [ style "padding" "6px" - , style "cursor" "pointer" - , style "text-align" "center" - , style "min-width" "24ch" - , onClick config.open - ] - [ text ("Explore History (" ++ String.fromInt numMsgs ++ ")") - ] - , viewImportExport - [ style "padding" "4px 0" - , style "font-size" "0.8em" - , style "text-align" "center" - , style "background-color" "rgb(50, 50, 50)" - ] - config.importHistory - config.exportHistory - ] - - -viewImportExport : List (Attribute msg) -> msg -> msg -> Html msg -viewImportExport props importMsg exportMsg = - div - props - [ button importMsg "Import" - , text " / " - , button exportMsg "Export" - ] - - -button : msg -> String -> Html msg -button msg label = - span [ onClick msg, style "cursor" "pointer" ] [ text label ] diff --git a/src/Debugger/Report.elm b/src/Debugger/Report.elm deleted file mode 100755 index b2b983f..0000000 --- a/src/Debugger/Report.elm +++ /dev/null @@ -1,99 +0,0 @@ -module Debugger.Report exposing - ( Report(..) - , Change(..) - , TagChanges - , emptyTagChanges - , hasTagChanges - , Status(..), evaluate - ) - - - --- REPORTS - - -type Report - = CorruptHistory - | VersionChanged String String - | MessageChanged String String - | SomethingChanged (List Change) - - -type Change - = AliasChange String - | UnionChange String TagChanges - - -type alias TagChanges = - { removed : List String - , changed : List String - , added : List String - , argsMatch : Bool - } - - -emptyTagChanges : Bool -> TagChanges -emptyTagChanges argsMatch = - TagChanges [] [] [] argsMatch - - -hasTagChanges : TagChanges -> Bool -hasTagChanges tagChanges = - tagChanges == TagChanges [] [] [] True - - -type Status = Impossible | Risky | Fine - - -evaluate : Report -> Status -evaluate report = - case report of - CorruptHistory -> - Impossible - - VersionChanged _ _ -> - Impossible - - MessageChanged _ _ -> - Impossible - - SomethingChanged changes -> - worstCase Fine (List.map evaluateChange changes) - - -worstCase : Status -> List Status -> Status -worstCase status statusList = - case statusList of - [] -> - status - - Impossible :: _ -> - Impossible - - Risky :: rest -> - worstCase Risky rest - - Fine :: rest -> - worstCase status rest - - -evaluateChange : Change -> Status -evaluateChange change = - case change of - AliasChange _ -> - Impossible - - UnionChange _ { removed, changed, added, argsMatch } -> - if not argsMatch || some changed || some removed then - Impossible - - else if some added then - Risky - - else - Fine - - -some : List a -> Bool -some list = - not (List.isEmpty list) diff --git a/src/Elm/Kernel/Browser.js b/src/Elm/Kernel/Browser.js deleted file mode 100644 index ea6671d..0000000 --- a/src/Elm/Kernel/Browser.js +++ /dev/null @@ -1,458 +0,0 @@ -/* - -import Basics exposing (never) -import Browser exposing (Internal, External) -import Browser.Dom as Dom exposing (NotFound) -import Elm.Kernel.Debug exposing (crash) -import Elm.Kernel.Debugger exposing (element, document) -import Elm.Kernel.Json exposing (runHelp) -import Elm.Kernel.List exposing (Nil) -import Elm.Kernel.Platform exposing (initialize) -import Elm.Kernel.Scheduler exposing (binding, fail, rawSpawn, succeed, spawn) -import Elm.Kernel.Utils exposing (Tuple0, Tuple2) -import Elm.Kernel.VirtualDom exposing (appendChild, applyPatches, diff, doc, node, passiveSupported, render, divertHrefToApp) -import Json.Decode as Json exposing (map) -import Maybe exposing (Just, Nothing) -import Result exposing (isOk) -import Task exposing (perform) -import Url exposing (fromString) - -*/ - - - -// ELEMENT - - -var __Debugger_element; - -var _Browser_element = __Debugger_element || F4(function(impl, flagDecoder, debugMetadata, args) -{ - return __Platform_initialize( - flagDecoder, - args, - impl.__$init, - impl.__$update, - impl.__$subscriptions, - function(sendToApp, initialModel) { - var view = impl.__$view; - /**__PROD/ - var domNode = args['node']; - //*/ - /**__DEBUG/ - var domNode = args && args['node'] ? args['node'] : __Debug_crash(0); - //*/ - var currNode = _VirtualDom_virtualize(domNode); - - return _Browser_makeAnimator(initialModel, function(model) - { - var nextNode = view(model); - var patches = __VirtualDom_diff(currNode, nextNode); - domNode = __VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); - currNode = nextNode; - }); - } - ); -}); - - - -// DOCUMENT - - -var __Debugger_document; - -var _Browser_document = __Debugger_document || F4(function(impl, flagDecoder, debugMetadata, args) -{ - return __Platform_initialize( - flagDecoder, - args, - impl.__$init, - impl.__$update, - impl.__$subscriptions, - function(sendToApp, initialModel) { - var divertHrefToApp = impl.__$setup && impl.__$setup(sendToApp) - var view = impl.__$view; - var title = __VirtualDom_doc.title; - var bodyNode = __VirtualDom_doc.body; - var currNode = _VirtualDom_virtualize(bodyNode); - return _Browser_makeAnimator(initialModel, function(model) - { - __VirtualDom_divertHrefToApp = divertHrefToApp; - var doc = view(model); - var nextNode = __VirtualDom_node('body')(__List_Nil)(doc.__$body); - var patches = __VirtualDom_diff(currNode, nextNode); - bodyNode = __VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); - currNode = nextNode; - __VirtualDom_divertHrefToApp = 0; - (title !== doc.__$title) && (__VirtualDom_doc.title = title = doc.__$title); - }); - } - ); -}); - - - -// ANIMATION - - -var _Browser_requestAnimationFrame = - typeof requestAnimationFrame !== 'undefined' - ? requestAnimationFrame - : function(callback) { setTimeout(callback, 1000 / 60); }; - - -function _Browser_makeAnimator(model, draw) -{ - draw(model); - - var state = __4_NO_REQUEST; - - function updateIfNeeded() - { - state = state === __4_EXTRA_REQUEST - ? __4_NO_REQUEST - : ( _Browser_requestAnimationFrame(updateIfNeeded), draw(model), __4_EXTRA_REQUEST ); - } - - return function(nextModel, isSync) - { - model = nextModel; - - isSync - ? ( draw(model), - state === __4_PENDING_REQUEST && (state = __4_EXTRA_REQUEST) - ) - : ( state === __4_NO_REQUEST && _Browser_requestAnimationFrame(updateIfNeeded), - state = __4_PENDING_REQUEST - ); - }; -} - - - -// APPLICATION - - -function _Browser_application(impl) -{ - var key = {}; - var onUrlChange = impl.__$onUrlChange; - var onUrlRequest = impl.__$onUrlRequest; - return _Browser_document({ - __$setup: function(sendToApp) - { - function reportChange() - { - sendToApp(onUrlChange(_Browser_getUrl())); - } - - key.__change = reportChange; - - _Browser_window.addEventListener('popstate', reportChange); - _Browser_window.navigator.userAgent.indexOf('Trident') < 0 || _Browser_window.addEventListener('hashchange', reportChange); - - return F2(function(domNode, event) - { - if (!event.ctrlKey && !event.metaKey && !event.shiftKey) - { - event.preventDefault(); - var href = domNode.href; - var curr = _Browser_getUrl(); - var next = __Url_fromString(href).a; - sendToApp(onUrlRequest( - (next - && curr.__$protocol === next.__$protocol - && curr.__$host === next.__$host - && curr.__$port_.a === next.__$port_.a - ) - ? __Browser_Internal(next) - : __Browser_External(href) - )); - } - }); - }, - __$init: function(flags) - { - return A3(impl.__$init, flags, _Browser_getUrl(), key); - }, - __$view: impl.__$view, - __$update: impl.__$update, - __$subscriptions: impl.__$subscriptions - }); -} - -function _Browser_getUrl() -{ - return __Url_fromString(__VirtualDom_doc.location.href).a || __Debug_crash(1); -} - -var _Browser_go = F2(function(key, n) -{ - return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { - n && history.go(n); - key.__change(); - })); -}); - -var _Browser_pushUrl = F2(function(key, url) -{ - return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { - history.pushState({}, '', url); - key.__change(); - })); -}); - -var _Browser_replaceUrl = F2(function(key, url) -{ - return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { - history.replaceState({}, '', url); - key.__change(); - })); -}); - - - -// GLOBAL EVENTS - - -var _Browser_fakeNode = { addEventListener: function() {}, removeEventListener: function() {} }; -var _Browser_doc = typeof document !== 'undefined' ? document : _Browser_fakeNode; -var _Browser_window = typeof window !== 'undefined' ? window : _Browser_fakeNode; - -var _Browser_on = F3(function(node, eventName, sendToSelf) -{ - return __Scheduler_spawn(__Scheduler_binding(function(callback) - { - function handler(event) { __Scheduler_rawSpawn(sendToSelf(event)); } - node.addEventListener(eventName, handler, __VirtualDom_passiveSupported && { passive: true }); - return function() { node.removeEventListener(eventName, handler); }; - })); -}); - -var _Browser_decodeEvent = F2(function(decoder, event) -{ - var result = __Json_runHelp(decoder, event); - return __Result_isOk(result) ? __Maybe_Just(result.a) : __Maybe_Nothing; -}); - - - -// PAGE VISIBILITY - - -function _Browser_visibilityInfo() -{ - return (typeof __VirtualDom_doc.hidden !== 'undefined') - ? { __$hidden: 'hidden', __$change: 'visibilitychange' } - : - (typeof __VirtualDom_doc.mozHidden !== 'undefined') - ? { __$hidden: 'mozHidden', __$change: 'mozvisibilitychange' } - : - (typeof __VirtualDom_doc.msHidden !== 'undefined') - ? { __$hidden: 'msHidden', __$change: 'msvisibilitychange' } - : - (typeof __VirtualDom_doc.webkitHidden !== 'undefined') - ? { __$hidden: 'webkitHidden', __$change: 'webkitvisibilitychange' } - : { __$hidden: 'hidden', __$change: 'visibilitychange' }; -} - - - -// ANIMATION FRAMES - - -function _Browser_rAF() -{ - return __Scheduler_binding(function(callback) - { - var id = requestAnimationFrame(function() { - callback(__Scheduler_succeed(Date.now())); - }); - - return function() { - cancelAnimationFrame(id); - }; - }); -} - - -function _Browser_now() -{ - return __Scheduler_binding(function(callback) - { - callback(__Scheduler_succeed(Date.now())); - }); -} - - - -// DOM STUFF - - -function _Browser_withNode(id, doStuff) -{ - return __Scheduler_binding(function(callback) - { - _Browser_requestAnimationFrame(function() { - var node = document.getElementById(id); - callback(node - ? __Scheduler_succeed(doStuff(node)) - : __Scheduler_fail(__Dom_NotFound(id)) - ); - }); - }); -} - - -function _Browser_withWindow(doStuff) -{ - return __Scheduler_binding(function(callback) - { - _Browser_requestAnimationFrame(function() { - callback(__Scheduler_succeed(doStuff())); - }); - }); -} - - -// FOCUS and BLUR - - -var _Browser_call = F2(function(functionName, id) -{ - return _Browser_withNode(id, function(node) { - node[functionName](); - return __Utils_Tuple0; - }); -}); - - - -// WINDOW VIEWPORT - - -function _Browser_getViewport() -{ - var node = _Browser_doc.documentElement; - return { - __$scene: { - __$width: node.scrollWidth, - __$height: node.scrollHeight - }, - __$viewport: { - __$x: _Browser_window.pageXOffset, - __$y: _Browser_window.pageYOffset, - __$width: node.clientWidth, - __$height: node.clientHeight - } - }; -} - - -var _Browser_setViewport = F2(function(x, y) -{ - return _Browser_withWindow(function() - { - _Browser_window.scroll(x, y); - return __Utils_Tuple0; - }); -}); - - - -// ELEMENT VIEWPORT - - -function _Browser_getViewportOf(id) -{ - return _Browser_withNode(id, function(node) - { - return { - __$scene: { - __$width: node.scrollWidth, - __$height: node.scrollHeight - }, - __$viewport: { - __$x: node.scrollLeft, - __$y: node.scrollTop, - __$width: node.clientWidth, - __$height: node.clientHeight - } - }; - }); -} - - -var _Browser_setViewportOf = F3(function(id, x, y) -{ - return _Browser_withNode(id, function(node) - { - node.scrollLeft = x; - node.scrollTop = y; - return __Utils_Tuple0; - }); -}); - - - -// ELEMENT - - -function _Browser_getElement(id) -{ - return _Browser_withNode(id, function(node) - { - var rect = node.getBoundingClientRect(); - var x = _Browser_window.pageXOffset; - var y = _Browser_window.pageYOffset; - return { - __$scene: { - __$width: node.scrollWidth, - __$height: node.scrollHeight - }, - __$viewport: { - __$x: x, - __$y: y, - __$width: node.clientWidth, - __$height: node.clientHeight - }, - __$element: { - __$x: x + rect.left, - __$y: y + rect.top, - __$width: rect.width, - __$height: rect.height - } - }; - }); -} - - - -// LOAD and RELOAD - - -function _Browser_reload(skipCache) -{ - return A2(__Task_perform, __Basics_never, __Scheduler_binding(function(callback) - { - __VirtualDom_doc.location.reload(skipCache); - })); -} - -function _Browser_load(url) -{ - return A2(__Task_perform, __Basics_never, __Scheduler_binding(function(callback) - { - try - { - _Browser_window.location = url; - } - catch(err) - { - // Only Firefox can throw a NS_ERROR_MALFORMED_URI exception here. - // Other browsers reload the page, so let's be consistent about that. - __VirtualDom_doc.location.reload(false); - } - })); -} diff --git a/src/Elm/Kernel/Browser.server.js b/src/Elm/Kernel/Browser.server.js deleted file mode 100644 index 8335c50..0000000 --- a/src/Elm/Kernel/Browser.server.js +++ /dev/null @@ -1,132 +0,0 @@ -/* - -import Elm.Kernel.Debug exposing (crash) -import Elm.Kernel.Json exposing (run, wrap) -import Elm.Kernel.Platform exposing (preload) -import Elm.Kernel.Scheduler exposing (binding, succeed, spawn) -import Elm.Kernel.Utils exposing (Tuple0) -import Elm.Kernel.VirtualDom exposing (body) -import Json.Decode as Json exposing (map) -import Platform.Sub as Sub exposing (none) -import Result exposing (isOk) - -*/ - - - -// DUMMY STUFF - - -function _Browser_invalidUrl(url) { __Debug_crash(1, url); } -function _Browser_makeUnitTask() { return _Browser_unitTask; } -function _Browser_makeNeverResolve() { return __Scheduler_binding(function(){}); } -var _Browser_unitTask = __Scheduler_succeed(__Utils_Tuple0); -var _Browser_go = _Browser_makeUnitTask; -var _Browser_pushState = _Browser_makeNeverResolve -var _Browser_replaceState = _Browser_makeNeverResolve; -var _Browser_reload = _Browser_makeUnitTask; -var _Browser_load = _Browser_makeUnitTask; -var _Browser_call = F2(_Browser_makeUnitTask); -var _Browser_setPositiveScroll = F3(_Browser_makeUnitTask); -var _Browser_setNegativeScroll = F4(_Browser_makeUnitTask); -var _Browser_getScroll = _Browser_makeNeverResolve; -var _Browser_on = F4(function() { return __Scheduler_spawn(_Browser_unitTask); }); - - - -// PROGRAMS - - -var _Browser_element = F4(function(impl, flagDecoder, object, debugMetadata) -{ - object['prerender'] = function(flags) - { - return _Browser_prerender(flagDecoder, flags, impl); - }; - - object['render'] = function(flags) - { - return _Browser_render(flagDecoder, flags, impl, function(html, preload) { - return { - html: html, - preload: preload - }; - }); - }; -}); - - -var _Browser_document = F4(function(impl, flagDecoder, object, debugMetadata) -{ - object['prerender'] = function(url, flags) - { - return _Browser_prerender(_Browser_addEnv(url, flagDecoder), flags, impl); - }; - - object['render'] = function(url, flags) - { - return _Browser_render(_Browser_addEnv(url, flagDecoder), flags, impl, function(ui, preload) { - return { - title: ui.__$title, - body: __VirtualDom_body(ui.__$body), - preload: preload - }; - }); - }; -}); - - - -// PROGRAM HELPERS - - -function _Browser_prerender(flagDecoder, flags, impl) -{ - __Platform_preload = new Set(); - _Browser_dispatchCommands(_Browser_init(flagDecoder, flags, impl.__$init).b); - var preload = __Platform_preload; - __Platform_preload = null; - return preload; -} - - -function _Browser_render(flagDecoder, flags, impl, toOutput) -{ - __Platform_preload = new Set(); - var pair = _Browser_init(flagDecoder, flags, impl.__$init); - _Browser_dispatchCommands(pair.b); - var view = impl.__$view(pair.a); - var preload = __Platform_preload; - __Platform_preload = null; - return toOutput(view, preload); -} - - -function _Browser_init(flagDecoder, flags, init) -{ - var result = A2(__Json_run, flagDecoder, __Json_wrap(flags)); - return __Result_isOk(result) ? init(result.a) : __Debug_crash(2, result.a); -} - - -function _Browser_dispatchCommands(commands) -{ - var managers = {}; - _Platform_setupEffects(managers, function() {}); - _Platform_dispatchEffects(managers, commands, __Sub_none); -} - - - -// FULLSCREEN ENV - - -function _Browser_addEnv(url, flagDecoder) -{ - return A2(__Json_map, function(flags) { - return { - __$flags: flags, - __$url: url - }; - }, flagDecoder); -} diff --git a/src/Elm/Kernel/Debugger.js b/src/Elm/Kernel/Debugger.js deleted file mode 100755 index 2876fba..0000000 --- a/src/Elm/Kernel/Debugger.js +++ /dev/null @@ -1,539 +0,0 @@ -/* - -import Debugger.Expando as Expando exposing (S, Primitive, Sequence, Dictionary, Record, Constructor, ListSeq, SetSeq, ArraySeq) -import Debugger.Main as Main exposing (getUserModel, wrapInit, wrapUpdate, wrapSubs, cornerView, popoutView, NoOp, UserMsg, Up, Down, toBlockerType) -import Debugger.Overlay as Overlay exposing (BlockNone, BlockMost) -import Elm.Kernel.Browser exposing (makeAnimator) -import Elm.Kernel.Debug exposing (crash) -import Elm.Kernel.List exposing (Cons, Nil) -import Elm.Kernel.Platform exposing (initialize) -import Elm.Kernel.Scheduler exposing (binding, succeed) -import Elm.Kernel.Utils exposing (Tuple0, Tuple2, ap) -import Elm.Kernel.VirtualDom exposing (node, applyPatches, diff, doc, makeStepper, map, render, virtualize) -import Json.Decode as Json exposing (map) -import List exposing (map, reverse) -import Maybe exposing (Just, Nothing) -import Set exposing (foldr) -import Dict exposing (foldr, empty, insert) -import Array exposing (foldr) - -*/ - - - -// HELPERS - - -function _Debugger_unsafeCoerce(value) -{ - return value; -} - - - -// PROGRAMS - - -var _Debugger_element = F4(function(impl, flagDecoder, debugMetadata, args) -{ - return __Platform_initialize( - flagDecoder, - args, - A3(__Main_wrapInit, debugMetadata, _Debugger_popout(), impl.__$init), - __Main_wrapUpdate(impl.__$update), - __Main_wrapSubs(impl.__$subscriptions), - function(sendToApp, initialModel) - { - var view = impl.__$view; - var title = __VirtualDom_doc.title; - var domNode = args && args['node'] ? args['node'] : __Debug_crash(0); - var currNode = __VirtualDom_virtualize(domNode); - var currBlocker = __Main_toBlockerType(initialModel); - var currPopout; - - var cornerNode = __VirtualDom_doc.createElement('div'); - domNode.parentNode.insertBefore(cornerNode, domNode.nextSibling); - var cornerCurr = __VirtualDom_virtualize(cornerNode); - - return _Browser_makeAnimator(initialModel, function(model) - { - var nextNode = A2(__VirtualDom_map, __Main_UserMsg, view(__Main_getUserModel(model))); - var patches = __VirtualDom_diff(currNode, nextNode); - domNode = __VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); - currNode = nextNode; - - // update blocker - - var nextBlocker = __Main_toBlockerType(model); - _Debugger_updateBlocker(currBlocker, nextBlocker); - currBlocker = nextBlocker; - - // view corner - - if (model.__$popout.__isClosed) - { - var cornerNext = __Main_cornerView(model); - var cornerPatches = __VirtualDom_diff(cornerCurr, cornerNext); - cornerNode = __VirtualDom_applyPatches(cornerNode, cornerCurr, cornerPatches, sendToApp); - cornerCurr = cornerNext; - return; - } - - // view popout - - model.__$popout.__doc || (currPopout = _Debugger_openWindow(model.__$popout, sendToApp)); - - __VirtualDom_doc = model.__$popout.__doc; // SWITCH TO POPOUT DOC - var nextPopout = __Main_popoutView(model); - var popoutPatches = __VirtualDom_diff(currPopout, nextPopout); - __VirtualDom_applyPatches(model.__$popout.__doc.body, currPopout, popoutPatches, sendToApp); - currPopout = nextPopout; - __VirtualDom_doc = document; // SWITCH BACK TO NORMAL DOC - }); - } - ); -}); - - -var _Debugger_document = F4(function(impl, flagDecoder, debugMetadata, args) -{ - return __Platform_initialize( - flagDecoder, - args, - A3(__Main_wrapInit, debugMetadata, _Debugger_popout(), impl.__$init), - __Main_wrapUpdate(impl.__$update), - __Main_wrapSubs(impl.__$subscriptions), - function(sendToApp, initialModel) - { - var view = impl.__$view; - var title = __VirtualDom_doc.title; - var bodyNode = __VirtualDom_doc.body; - var currNode = __VirtualDom_virtualize(bodyNode); - var currBlocker = __Main_toBlockerType(initialModel); - var currPopout; - - return _Browser_makeAnimator(initialModel, function(model) - { - var doc = view(__Main_getUserModel(model)); - var nextNode = __VirtualDom_node('body')(__List_Nil)( - __Utils_ap( - A2(__List_map, __VirtualDom_map(__Main_UserMsg), doc.__$body), - __List_Cons(__Main_cornerView(model), __List_Nil) - ) - ); - var patches = __VirtualDom_diff(currNode, nextNode); - bodyNode = __VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); - currNode = nextNode; - (title !== doc.__$title) && (__VirtualDom_doc.title = title = doc.__$title); - - // update blocker - - var nextBlocker = __Main_toBlockerType(model); - _Debugger_updateBlocker(currBlocker, nextBlocker); - currBlocker = nextBlocker; - - // view popout - - if (model.__$popout.__isClosed) return; - - model.__$popout.__doc || (currPopout = _Debugger_openWindow(model.__$popout, sendToApp)); - - __VirtualDom_doc = model.__$popout.__doc; // SWITCH TO POPOUT DOC - var nextPopout = __Main_popoutView(model); - var popoutPatches = __VirtualDom_diff(currPopout, nextPopout); - __VirtualDom_applyPatches(model.__$popout.__doc.body, currPopout, popoutPatches, sendToApp); - currPopout = nextPopout; - __VirtualDom_doc = document; // SWITCH BACK TO NORMAL DOC - }); - } - ); -}); - - -function _Debugger_popout() -{ - return { __doc: undefined, __isClosed: true }; -} - -function _Debugger_isOpen(popout) -{ - return !popout.__isClosed; -} - -function _Debugger_open(popout) -{ - popout.__isClosed = false; - return popout -} - - - -// POPOUT - - -function _Debugger_openWindow(popout, sendToApp) -{ - var w = 900, h = 360, x = screen.width - w, y = screen.height - h; - var debuggerWindow = window.open('', '', 'width=' + w + ',height=' + h + ',left=' + x + ',top=' + y); - var doc = debuggerWindow.document; - doc.title = 'Elm Debugger'; - - // handle arrow keys - doc.addEventListener('keydown', function(event) { - event.metaKey && event.which === 82 && window.location.reload(); - event.which === 38 && (sendToApp(__Main_Up), event.preventDefault()); - event.which === 40 && (sendToApp(__Main_Down), event.preventDefault()); - }); - - // handle window close - window.addEventListener('unload', close); - debuggerWindow.addEventListener('unload', function() { - popout.__doc = undefined; - popout.__isClosed = true; - sendToApp(__Main_NoOp); - window.removeEventListener('unload', close); - }); - function close() { - popout.__doc = undefined; - popout.__isClosed = true; - sendToApp(__Main_NoOp); - debuggerWindow.close(); - } - - // register new window - popout.__doc = doc; - popout.__isClosed = false; - return __VirtualDom_virtualize(doc.body); -} - - - -// SCROLL - - -function _Debugger_scroll(popout) -{ - return __Scheduler_binding(function(callback) - { - if (popout.__doc) - { - var msgs = popout.__doc.getElementById('elm-debugger-sidebar'); - if (msgs) - { - msgs.scrollTop = msgs.scrollHeight; - } - } - callback(__Scheduler_succeed(__Utils_Tuple0)); - }); -} - - - -// UPLOAD - - -function _Debugger_upload() -{ - return __Scheduler_binding(function(callback) - { - var element = document.createElement('input'); - element.setAttribute('type', 'file'); - element.setAttribute('accept', 'text/json'); - element.style.display = 'none'; - element.addEventListener('change', function(event) - { - var fileReader = new FileReader(); - fileReader.onload = function(e) - { - callback(__Scheduler_succeed(e.target.result)); - }; - fileReader.readAsText(event.target.files[0]); - document.body.removeChild(element); - }); - document.body.appendChild(element); - element.click(); - }); -} - - - -// DOWNLOAD - - -var _Debugger_download = F2(function(historyLength, json) -{ - return __Scheduler_binding(function(callback) - { - var fileName = 'history-' + historyLength + '.txt'; - var jsonString = JSON.stringify(json); - var mime = 'text/plain;charset=utf-8'; - var done = __Scheduler_succeed(__Utils_Tuple0); - - // for IE10+ - if (navigator.msSaveBlob) - { - navigator.msSaveBlob(new Blob([jsonString], {type: mime}), fileName); - return callback(done); - } - - // for HTML5 - var element = document.createElement('a'); - element.setAttribute('href', 'data:' + mime + ',' + encodeURIComponent(jsonString)); - element.setAttribute('download', fileName); - element.style.display = 'none'; - document.body.appendChild(element); - element.click(); - document.body.removeChild(element); - callback(done); - }); -}); - - - -// POPOUT CONTENT - - -function _Debugger_messageToString(value) -{ - if (typeof value === 'boolean') - { - return value ? 'True' : 'False'; - } - - if (typeof value === 'number') - { - return value + ''; - } - - if (typeof value === 'string') - { - return '"' + _Debugger_addSlashes(value, false) + '"'; - } - - if (value instanceof String) - { - return "'" + _Debugger_addSlashes(value, true) + "'"; - } - - if (typeof value !== 'object' || value === null || !('$' in value)) - { - return '…'; - } - - if (typeof value.$ === 'number') - { - return '…'; - } - - var code = value.$.charCodeAt(0); - if (code === 0x23 /* # */ || /* a */ 0x61 <= code && code <= 0x7A /* z */) - { - return '…'; - } - - if (['Array_elm_builtin', 'Set_elm_builtin', 'RBNode_elm_builtin', 'RBEmpty_elm_builtin'].indexOf(value.$) >= 0) - { - return '…'; - } - - var keys = Object.keys(value); - switch (keys.length) - { - case 1: - return value.$; - case 2: - return value.$ + ' ' + _Debugger_messageToString(value.a); - default: - return value.$ + ' … ' + _Debugger_messageToString(value[keys[keys.length - 1]]); - } -} - - -function _Debugger_init(value) -{ - if (typeof value === 'boolean') - { - return A3(__Expando_Constructor, __Maybe_Just(value ? 'True' : 'False'), true, __List_Nil); - } - - if (typeof value === 'number') - { - return __Expando_Primitive(value + ''); - } - - if (typeof value === 'string') - { - return __Expando_S('"' + _Debugger_addSlashes(value, false) + '"'); - } - - if (value instanceof String) - { - return __Expando_S("'" + _Debugger_addSlashes(value, true) + "'"); - } - - if (typeof value === 'object' && '$' in value) - { - var tag = value.$; - - if (tag === '::' || tag === '[]') - { - return A3(__Expando_Sequence, __Expando_ListSeq, true, - A2(__List_map, _Debugger_init, value) - ); - } - - if (tag === 'Set_elm_builtin') - { - return A3(__Expando_Sequence, __Expando_SetSeq, true, - A3(__Set_foldr, _Debugger_initCons, __List_Nil, value) - ); - } - - if (tag === 'RBNode_elm_builtin' || tag == 'RBEmpty_elm_builtin') - { - return A2(__Expando_Dictionary, true, - A3(__Dict_foldr, _Debugger_initKeyValueCons, __List_Nil, value) - ); - } - - if (tag === 'Array_elm_builtin') - { - return A3(__Expando_Sequence, __Expando_ArraySeq, true, - A3(__Array_foldr, _Debugger_initCons, __List_Nil, value) - ); - } - - if (typeof tag === 'number') - { - return __Expando_Primitive('<internals>'); - } - - var char = tag.charCodeAt(0); - if (char === 35 || 65 <= char && char <= 90) - { - var list = __List_Nil; - for (var i in value) - { - if (i === '$') continue; - list = __List_Cons(_Debugger_init(value[i]), list); - } - return A3(__Expando_Constructor, char === 35 ? __Maybe_Nothing : __Maybe_Just(tag), true, __List_reverse(list)); - } - - return __Expando_Primitive('<internals>'); - } - - if (typeof value === 'object') - { - var dict = __Dict_empty; - for (var i in value) - { - dict = A3(__Dict_insert, i, _Debugger_init(value[i]), dict); - } - return A2(__Expando_Record, true, dict); - } - - return __Expando_Primitive('<internals>'); -} - -var _Debugger_initCons = F2(function initConsHelp(value, list) -{ - return __List_Cons(_Debugger_init(value), list); -}); - -var _Debugger_initKeyValueCons = F3(function(key, value, list) -{ - return __List_Cons( - __Utils_Tuple2(_Debugger_init(key), _Debugger_init(value)), - list - ); -}); - -function _Debugger_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, '\\"'); - } -} - - - -// BLOCK EVENTS - - -function _Debugger_updateBlocker(oldBlocker, newBlocker) -{ - if (oldBlocker === newBlocker) return; - - var oldEvents = _Debugger_blockerToEvents(oldBlocker); - var newEvents = _Debugger_blockerToEvents(newBlocker); - - // remove old blockers - for (var i = 0; i < oldEvents.length; i++) - { - document.removeEventListener(oldEvents[i], _Debugger_blocker, true); - } - - // add new blockers - for (var i = 0; i < newEvents.length; i++) - { - document.addEventListener(newEvents[i], _Debugger_blocker, true); - } -} - - -function _Debugger_blocker(event) -{ - if (event.type === 'keydown' && event.metaKey && event.which === 82) - { - return; - } - - var isScroll = event.type === 'scroll' || event.type === 'wheel'; - for (var node = event.target; node; node = node.parentNode) - { - if (isScroll ? node.id === 'elm-debugger-details' : node.id === 'elm-debugger-overlay') - { - return; - } - } - - event.stopPropagation(); - event.preventDefault(); -} - -function _Debugger_blockerToEvents(blocker) -{ - return blocker === __Overlay_BlockNone - ? [] - : blocker === __Overlay_BlockMost - ? _Debugger_mostEvents - : _Debugger_allEvents; -} - -var _Debugger_mostEvents = [ - 'click', 'dblclick', 'mousemove', - 'mouseup', 'mousedown', 'mouseenter', 'mouseleave', - 'touchstart', 'touchend', 'touchcancel', 'touchmove', - 'pointerdown', 'pointerup', 'pointerover', 'pointerout', - 'pointerenter', 'pointerleave', 'pointermove', 'pointercancel', - 'dragstart', 'drag', 'dragend', 'dragenter', 'dragover', 'dragleave', 'drop', - 'keyup', 'keydown', 'keypress', - 'input', 'change', - 'focus', 'blur' -]; - -var _Debugger_allEvents = _Debugger_mostEvents.concat('wheel', 'scroll'); - diff --git a/notes/chat.svg b/v1/chat.svg similarity index 100% rename from notes/chat.svg rename to v1/chat.svg diff --git a/notes/getElement.svg b/v1/getElement.svg similarity index 100% rename from notes/getElement.svg rename to v1/getElement.svg diff --git a/notes/getViewport.svg b/v1/getViewport.svg similarity index 100% rename from notes/getViewport.svg rename to v1/getViewport.svg diff --git a/notes/getViewportOf.svg b/v1/getViewportOf.svg similarity index 100% rename from notes/getViewportOf.svg rename to v1/getViewportOf.svg