` and `<body>` 17 | 4. [`application`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#application) — create single-page apps 18 | 19 | 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!** 20 | 21 | 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. 22 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "elm/browser", 4 | "summary": "Run Elm in browsers, with access to browser history for single-page apps (SPAs)", 5 | "license": "BSD-3-Clause", 6 | "version": "1.0.2", 7 | "exposed-modules": [ 8 | "Browser", 9 | "Browser.Dom", 10 | "Browser.Events", 11 | "Browser.Navigation" 12 | ], 13 | "elm-version": "0.19.0 <= v < 0.20.0", 14 | "dependencies": { 15 | "elm/core": "1.0.0 <= v < 2.0.0", 16 | "elm/html": "1.0.0 <= v < 2.0.0", 17 | "elm/json": "1.0.0 <= v < 2.0.0", 18 | "elm/time": "1.0.0 <= v < 2.0.0", 19 | "elm/url": "1.0.0 <= v < 2.0.0", 20 | "elm/virtual-dom": "1.0.2 <= v < 2.0.0" 21 | }, 22 | "test-dependencies": {} 23 | } 24 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | # Examples 2 | 3 | To compile these examples locally, run the following terminal commands: 4 | 5 | ``` 6 | git clone https://github.com/elm/browser.git 7 | cd browser/examples 8 | elm reactor 9 | ``` 10 | 11 | Now go to [`http://localhost:8000`](http://localhost:8000) and navigate to whatever Elm file you want to see. 12 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.2", 10 | "elm/core": "1.0.2", 11 | "elm/html": "1.0.0", 12 | "elm/json": "1.1.3" 13 | }, 14 | "indirect": { 15 | "elm/time": "1.0.0", 16 | "elm/url": "1.0.0", 17 | "elm/virtual-dom": "1.0.2" 18 | } 19 | }, 20 | "test-dependencies": { 21 | "direct": {}, 22 | "indirect": {} 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /examples/src/Drag.elm: -------------------------------------------------------------------------------- 1 | module Drag exposing (main) 2 | 3 | {- You know how the editor on the Elm website has two side-by-side panels that 4 | can be resized? This is a rough implementation of that sort of thing. 5 | 6 | APPROACH: 7 | 1. Have a normal "mousedown" event on the drag zone. 8 | 2. When a drag begins, listen for global onMouseMove and onMouseUp events. 9 | 3. Check which buttons are down on mouse moves to detect a weird scenario. 10 | 11 | -} 12 | 13 | 14 | import Browser 15 | import Browser.Events as E 16 | import Html exposing (..) 17 | import Html.Attributes exposing (..) 18 | import Html.Events exposing (..) 19 | import Json.Decode as D 20 | 21 | 22 | 23 | -- MAIN 24 | 25 | 26 | main = 27 | Browser.element 28 | { init = init 29 | , view = view 30 | , update = update 31 | , subscriptions = subscriptions 32 | } 33 | 34 | 35 | 36 | -- MODEL 37 | 38 | 39 | type alias Model = 40 | { dragState : DragState 41 | } 42 | 43 | 44 | type DragState 45 | = Static Float 46 | | Moving Float 47 | 48 | 49 | init : () -> (Model, Cmd Msg) 50 | init _ = 51 | ( { dragState = Static 0.5 } 52 | , Cmd.none 53 | ) 54 | 55 | 56 | 57 | -- UPDATE 58 | 59 | 60 | type Msg 61 | = DragStart 62 | | DragMove Bool Float 63 | | DragStop Float 64 | 65 | 66 | update : Msg -> Model -> (Model, Cmd Msg) 67 | update msg model = 68 | case msg of 69 | DragStart -> 70 | ( { model | dragState = Moving (toFraction model.dragState) } 71 | , Cmd.none 72 | ) 73 | 74 | DragMove isDown fraction -> 75 | ( { model | dragState = if isDown then Moving fraction else Static (toFraction model.dragState) } 76 | , Cmd.none 77 | ) 78 | 79 | DragStop fraction -> 80 | ( { model | dragState = Static fraction } 81 | , Cmd.none 82 | ) 83 | 84 | 85 | toFraction : DragState -> Float 86 | toFraction dragState = 87 | case dragState of 88 | Static fraction -> fraction 89 | Moving fraction -> fraction 90 | 91 | 92 | 93 | -- VIEW 94 | 95 | 96 | view : Model -> Html Msg 97 | view model = 98 | let 99 | fraction = toFraction model.dragState 100 | pointerEvents = toPointerEvents model.dragState 101 | in 102 | div 103 | [ style "margin" "0" 104 | , style "padding" "0" 105 | , style "width" "100vw" 106 | , style "height" "100vh" 107 | , style "font-family" "monospace" 108 | , style "display" "flex" 109 | , style "flex-direction" "row" 110 | ] 111 | [ viewPanel "#222" "#ddd" fraction pointerEvents 112 | , viewDragZone fraction 113 | , viewPanel "#ddd" "#222" (1 - fraction) pointerEvents 114 | ] 115 | 116 | 117 | toPointerEvents : DragState -> String 118 | toPointerEvents dragState = 119 | case dragState of 120 | Static _ -> "auto" 121 | Moving _ -> "none" 122 | 123 | 124 | 125 | {- The "user-select" and "pointer-event" properties are "none" when resizing, 126 | ensuring that text does not get highlighted as the mouse moves. 127 | -} 128 | viewPanel : String -> String -> Float -> String -> Html msg 129 | viewPanel background foreground fraction pointerEvents = 130 | div 131 | [ style "width" (String.fromFloat (100 * fraction) ++ "vw") 132 | , style "height" "100vh" 133 | , style "user-select" pointerEvents 134 | , style "pointer-events" pointerEvents 135 | -- 136 | , style "background-color" background 137 | , style "color" foreground 138 | , style "font-size" "3em" 139 | -- 140 | , style "display" "flex" 141 | , style "justify-content" "center" 142 | , style "align-items" "center" 143 | ] 144 | [ text (String.left 5 (String.fromFloat (100 * fraction)) ++ "%") 145 | ] 146 | 147 | 148 | 149 | -- VIEW DRAG ZONE 150 | 151 | 152 | {- This does a few tricks to create an invisible drag zone: 153 | 154 | 1. "z-index" is a high number so that this node is in front of both panels. 155 | 2. "width" is 10px so there is something to grab onto. 156 | 3. "position" is absolute so the "width" does not disrupt the panels. 157 | 4. "margin-left" is -5px such that this node overhangs both panels. 158 | 159 | You could avoid the 4th trick by setting "left" to "calc(50vw - 5px)" but I 160 | do not know if there is a strong benefit to one approach or the other. 161 | -} 162 | viewDragZone : Float -> Html Msg 163 | viewDragZone fraction = 164 | div 165 | [ style "position" "absolute" 166 | , style "top" "0" 167 | , style "left" (String.fromFloat (100 * fraction) ++ "vw") 168 | , style "width" "10px" 169 | , style "height" "100vh" 170 | , style "margin-left" "-5px" 171 | , style "cursor" "col-resize" 172 | , style "z-index" "10" 173 | , on "mousedown" (D.succeed DragStart) 174 | ] 175 | [] 176 | 177 | 178 | 179 | -- SUBSCRIPTIONS 180 | 181 | 182 | {- We listen for the "mousemove" and "mouseup" events for the whole window. 183 | This way we catch all events, even if they are not on our drag zone. 184 | 185 | Listening for mouse moves is costly though, so we only listen if there is an 186 | ongoing drag. 187 | -} 188 | subscriptions : Model -> Sub Msg 189 | subscriptions model = 190 | case model.dragState of 191 | Static _ -> 192 | Sub.none 193 | 194 | Moving _ -> 195 | Sub.batch 196 | [ E.onMouseMove (D.map2 DragMove decodeButtons decodeFraction) 197 | , E.onMouseUp (D.map DragStop decodeFraction) 198 | ] 199 | 200 | 201 | {- The goal here is to get (mouse x / window width) on each mouse event. So if 202 | the mouse is at 500px and the screen is 1000px wide, we should get 0.5 from this. 203 | 204 | Getting the mouse x is not too hard, but getting window width is a bit tricky. 205 | We want the window.innerWidth value, which happens to be available at: 206 | 207 | event.currentTarget.defaultView.innerWidth 208 | 209 | The value at event.currentTarget is the document in these cases, but this will 210 | not work if you have a <section> or a <div> with a normal elm/html event handler. 211 | So if currentTarget is NOT the document, you should instead get the value at: 212 | 213 | event.currentTarget.ownerDocument.defaultView.innerWidth 214 | ^^^^^^^^^^^^^ 215 | -} 216 | decodeFraction : D.Decoder Float 217 | decodeFraction = 218 | D.map2 (/) 219 | (D.field "pageX" D.float) 220 | (D.at ["currentTarget","defaultView","innerWidth"] D.float) 221 | 222 | 223 | {- What happens when the user is dragging, but the "mouse up" occurs outside 224 | the browser window? We need to stop listening for mouse movement and end the 225 | drag. We use MouseEvent.buttons to detect this: 226 | 227 | https://developer.mozilla.org/en-US/docs/Web/API/MouseEvent/buttons 228 | 229 | The "buttons" value is 1 when "left-click" is pressed, so we use that to 230 | detect zombie drags. 231 | -} 232 | decodeButtons : D.Decoder Bool 233 | decodeButtons = 234 | D.field "buttons" (D.map (\buttons -> buttons == 1) D.int) 235 | -------------------------------------------------------------------------------- /notes/chat.svg: -------------------------------------------------------------------------------- 1 | <svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:lucid="lucid" width="1040" height="738"><g transform="translate(1642 3826)" lucid:page-tab-id="C9eM8j.usj1J"><path d="M-1600-3741.82h960V-3120h-960z" stroke="#ccc" stroke-width="10" fill="#834187"/><path d="M-1600-3780h960v29h-960z" stroke="#ccc" stroke-width="10" fill="#ccc"/><path d="M-1560-3760.82c0 5.52-4.48 10-10 10s-10-4.48-10-10 4.48-10 10-10 10 4.48 10 10z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#c92d39"/><path d="M-1530-3760.82c0 5.52-4.48 10-10 10s-10-4.48-10-10 4.48-10 10-10 10 4.48 10 10z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#fcc438"/><path d="M-1500-3760.82c0 5.52-4.48 10-10 10s-10-4.48-10-10 4.48-10 10-10 10 4.48 10 10z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#7ab648"/><path d="M-900-3360h220v242.18h-220z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#e5e5e5"/><path d="M-880-3340h120v40h-120z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#fff"/><use xlink:href="#a" transform="matrix(1,0,0,1,-875,-3335) translate(0 10.666666666666668)"/><use xlink:href="#b" transform="matrix(1,0,0,1,-875,-3335) translate(20.703703703703702 10.666666666666668)"/><use xlink:href="#c" transform="matrix(1,0,0,1,-875,-3335) translate(41.407407407407405 10.666666666666668)"/><use xlink:href="#d" transform="matrix(1,0,0,1,-875,-3335) translate(74 10.666666666666668)"/><use xlink:href="#e" transform="matrix(1,0,0,1,-875,-3335) translate(0 26.666666666666668)"/><use xlink:href="#f" transform="matrix(1,0,0,1,-875,-3335) translate(38.48148148148148 26.666666666666668)"/><path d="M-820-3280h120v40h-120z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#3aa6dd"/><g><use xlink:href="#g" transform="matrix(1,0,0,1,-815,-3275) translate(0 10.666666666666668)"/><use xlink:href="#h" transform="matrix(1,0,0,1,-815,-3275) translate(28.888888888888893 10.666666666666668)"/><use xlink:href="#i" transform="matrix(1,0,0,1,-815,-3275) translate(57.037037037037045 10.666666666666668)"/><use xlink:href="#j" transform="matrix(1,0,0,1,-815,-3275) translate(64.44444444444446 10.666666666666668)"/><use xlink:href="#k" transform="matrix(1,0,0,1,-815,-3275) translate(0 26.666666666666668)"/><use xlink:href="#l" transform="matrix(1,0,0,1,-815,-3275) translate(38.518518518518526 26.666666666666668)"/><use xlink:href="#m" transform="matrix(1,0,0,1,-815,-3275) translate(60.74074074074075 26.666666666666668)"/></g><path d="M-820-3220h120v58h-120z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#3aa6dd"/><g><use xlink:href="#n" transform="matrix(1,0,0,1,-815,-3215) translate(0 11.166666666666664)"/><use xlink:href="#o" transform="matrix(1,0,0,1,-815,-3215) translate(37.2962962962963 11.166666666666664)"/><use xlink:href="#p" transform="matrix(1,0,0,1,-815,-3215) translate(58 11.166666666666664)"/><use xlink:href="#q" transform="matrix(1,0,0,1,-815,-3215) translate(0 27.166666666666664)"/><use xlink:href="#r" transform="matrix(1,0,0,1,-815,-3215) translate(24.407407407407412 27.166666666666664)"/><use xlink:href="#s" transform="matrix(1,0,0,1,-815,-3215) translate(49.555555555555564 27.166666666666664)"/><use xlink:href="#t" transform="matrix(1,0,0,1,-815,-3215) translate(0 43.16666666666667)"/></g><path d="M-689-3183v60" stroke="#999" stroke-width="6" fill="none"/><defs><path d="M30-248c118-7 216 8 213 122C240-48 200 0 122 0H30v-248zM63-27c89 8 146-16 146-99s-60-101-146-95v194" id="u"/><path d="M100-194c62-1 85 37 85 99 1 63-27 99-86 99S16-35 15-95c0-66 28-99 85-99zM99-20c44 1 53-31 53-75 0-43-8-75-51-75s-53 32-53 75 10 74 51 75" id="v"/><g id="a"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#u"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#v"/></g><path d="M206 0h-36l-40-164L89 0H53L-1-190h32L70-26l43-164h34l41 164 42-164h31" id="w"/><path d="M100-194c63 0 86 42 84 106H49c0 40 14 67 53 68 26 1 43-12 49-29l28 8c-11 28-37 45-77 45C44 4 14-33 15-96c1-61 26-98 85-98zm52 81c6-60-76-77-97-28-3 7-6 17-6 28h103" id="x"/><g id="b"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#w"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#x"/></g><path d="M106-169C34-169 62-67 57 0H25v-261h32l-1 103c12-21 28-36 61-36 89 0 53 116 60 194h-32v-121c2-32-8-49-39-48" id="y"/><path d="M141-36C126-15 110 5 73 4 37 3 15-17 15-53c-1-64 63-63 125-63 3-35-9-54-41-54-24 1-41 7-42 31l-33-3c5-37 33-52 76-52 45 0 72 20 72 64v82c-1 20 7 32 28 27v20c-31 9-61-2-59-35zM48-53c0 20 12 33 32 33 41-3 63-29 60-74-43 2-92-5-92 41" id="z"/><path d="M108 0H70L1-190h34L89-25l56-165h34" id="A"/><g id="c"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#y"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#z"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#A"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,21.481481481481485,0)" xlink:href="#x"/></g><path d="M117-194c89-4 53 116 60 194h-32v-121c0-31-8-49-39-48C34-167 62-67 57 0H25l-1-190h30c1 10-1 24 2 32 11-22 29-35 61-36" id="B"/><path d="M179-190L93 31C79 59 56 82 12 73V49c39 6 53-20 64-50L1-190h34L92-34l54-156h33" id="C"/><g id="d"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#z"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#B"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#C"/></g><path d="M135-143c-3-34-86-38-87 0 15 53 115 12 119 90S17 21 10-45l28-5c4 36 97 45 98 0-10-56-113-15-118-90-4-57 82-63 122-42 12 7 21 19 24 35" id="D"/><path d="M59-47c-2 24 18 29 38 22v24C64 9 27 4 27-40v-127H5v-23h24l9-43h21v43h35v23H59v120" id="E"/><g id="e"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#D"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,6.666666666666668,0)" xlink:href="#w"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,16.25925925925926,0)" xlink:href="#x"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,23.66666666666667,0)" xlink:href="#x"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,31.07407407407408,0)" xlink:href="#E"/></g><path d="M115-194c55 1 70 41 70 98S169 2 115 4C84 4 66-9 55-30l1 105H24l-1-265h31l2 30c10-21 28-34 59-34zm-8 174c40 0 45-34 45-75s-6-73-45-74c-42 0-51 32-51 76 0 43 10 73 51 73" id="F"/><path d="M103-251c84 0 111 97 45 133-19 10-37 24-39 52H78c0-63 77-55 77-114 0-30-21-42-52-43-32 0-53 17-56 46l-32-2c7-45 34-72 88-72zM77 0v-35h34V0H77" id="G"/><g id="f"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#F"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#v"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#E"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,18.51851851851852,0)" xlink:href="#z"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,25.92592592592593,0)" xlink:href="#E"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,29.629629629629633,0)" xlink:href="#v"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,37.03703703703704,0)" xlink:href="#x"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,44.44444444444444,0)" xlink:href="#D"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,51.11111111111112,0)" xlink:href="#G"/></g><path fill="#fff" d="M140-251c81 0 123 46 123 126C263-46 219 4 140 4 59 4 17-45 17-125s42-126 123-126zm0 227c63 0 89-41 89-101s-29-99-89-99c-61 0-89 39-89 99S79-25 140-24" id="H"/><path fill="#fff" d="M117-194c89-4 53 116 60 194h-32v-121c0-31-8-49-39-48C34-167 62-67 57 0H25l-1-190h30c1 10-1 24 2 32 11-22 29-35 61-36" id="I"/><path fill="#fff" d="M100-194c63 0 86 42 84 106H49c0 40 14 67 53 68 26 1 43-12 49-29l28 8c-11 28-37 45-77 45C44 4 14-33 15-96c1-61 26-98 85-98zm52 81c6-60-76-77-97-28-3 7-6 17-6 28h103" id="J"/><g id="g"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#H"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,10.370370370370372,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,17.77777777777778,0)" xlink:href="#J"/></g><path fill="#fff" d="M135-143c-3-34-86-38-87 0 15 53 115 12 119 90S17 21 10-45l28-5c4 36 97 45 98 0-10-56-113-15-118-90-4-57 82-63 122-42 12 7 21 19 24 35" id="K"/><path fill="#fff" d="M96-169c-40 0-48 33-48 73s9 75 48 75c24 0 41-14 43-38l32 2c-6 37-31 61-74 61-59 0-76-41-82-99-10-93 101-131 147-64 4 7 5 14 7 22l-32 3c-4-21-16-35-41-35" id="L"/><path fill="#fff" d="M33 0v-38h34V0H33" id="M"/><g id="h"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#K"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,6.666666666666668,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.074074074074076,0)" xlink:href="#L"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,20.740740740740744,0)" xlink:href="#M"/></g><path fill="#fff" d="M33 0v-248h34V0H33" id="N"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#N" id="i"/><path fill="#fff" d="M206 0h-36l-40-164L89 0H53L-1-190h32L70-26l43-164h34l41 164 42-164h31" id="O"/><path fill="#fff" d="M24-231v-30h32v30H24zM24 0v-190h32V0H24" id="P"/><path fill="#fff" d="M24 0v-261h32V0H24" id="Q"/><g id="j"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#O"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#P"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,12.518518518518517,0)" xlink:href="#Q"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,15.444444444444446,0)" xlink:href="#Q"/></g><path fill="#fff" d="M106-169C34-169 62-67 57 0H25v-261h32l-1 103c12-21 28-36 61-36 89 0 53 116 60 194h-32v-121c2-32-8-49-39-48" id="R"/><path fill="#fff" d="M143 0L79-87 56-68V0H24v-261h32v163l83-92h37l-77 82L181 0h-38" id="S"/><g id="k"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#L"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,6.666666666666668,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.074074074074076,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,21.481481481481485,0)" xlink:href="#L"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,28.148148148148152,0)" xlink:href="#S"/></g><path fill="#fff" d="M59-47c-2 24 18 29 38 22v24C64 9 27 4 27-40v-127H5v-23h24l9-43h21v43h35v23H59v120" id="T"/><g id="l"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,3.703703703703704,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,11.111111111111112,0)" xlink:href="#J"/></g><path fill="#fff" d="M115-194c55 1 70 41 70 98S169 2 115 4C84 4 66-9 55-30l1 105H24l-1-265h31l2 30c10-21 28-34 59-34zm-8 174c40 0 45-34 45-75s-6-73-45-74c-42 0-51 32-51 76 0 43 10 73 51 73" id="U"/><path fill="#fff" d="M141-36C126-15 110 5 73 4 37 3 15-17 15-53c-1-64 63-63 125-63 3-35-9-54-41-54-24 1-41 7-42 31l-33-3c5-37 33-52 76-52 45 0 72 20 72 64v82c-1 20 7 32 28 27v20c-31 9-61-2-59-35zM48-53c0 20 12 33 32 33 41-3 63-29 60-74-43 2-92-5-92 41" id="V"/><path fill="#fff" d="M114-163C36-179 61-72 57 0H25l-1-190h30c1 12-1 29 2 39 6-27 23-49 58-41v29" id="W"/><path fill="#fff" d="M179-190L93 31C79 59 56 82 12 73V49c39 6 53-20 64-50L1-190h34L92-34l54-156h33" id="X"/><g id="m"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#U"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,22.222222222222225,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,25.92592592592593,0)" xlink:href="#W"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,30.333333333333336,0)" xlink:href="#X"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,36.00000000000001,0)" xlink:href="#M"/></g><path fill="#fff" d="M137-103V0h-34v-103L8-248h37l75 118 75-118h37" id="Y"/><path fill="#fff" d="M68-38c1 34 0 65-14 84H32c9-13 17-26 17-46H33v-38h35" id="Z"/><g id="n"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#Y"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.666666666666667,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,15.074074074074076,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,22.481481481481485,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,29.888888888888893,0)" xlink:href="#Z"/></g><g id="o"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#O"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#J"/></g><path fill="#fff" d="M108 0H70L1-190h34L89-25l56-165h34" id="aa"/><g id="p"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#aa"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,21.481481481481485,0)" xlink:href="#J"/></g><path fill="#fff" d="M100-194c62-1 85 37 85 99 1 63-27 99-86 99S16-35 15-95c0-66 28-99 85-99zM99-20c44 1 53-31 53-75 0-43-8-75-51-75s-53 32-53 75 10 74 51 75" id="ab"/><g id="q"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,3.703703703703704,0)" xlink:href="#O"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,13.296296296296298,0)" xlink:href="#ab"/></g><path fill="#fff" d="M101-234c-31-9-42 10-38 44h38v23H63V0H32v-167H5v-23h27c-7-52 17-82 69-68v24" id="ac"/><g id="r"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#Q"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,2.9259259259259265,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,10.333333333333334,0)" xlink:href="#ac"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.037037037037038,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,17.740740740740744,0)" xlink:href="#M"/></g><path fill="#fff" d="M143 4C61 4 22-44 18-125c-5-107 100-154 193-111 17 8 29 25 37 43l-32 9c-13-25-37-40-76-40-61 0-88 39-88 99 0 61 29 100 91 101 35 0 62-11 79-27v-45h-74v-28h105v86C228-13 192 4 143 4" id="ad"/><g id="s"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#ad"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,10.370370370370372,0)" xlink:href="#P"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,13.296296296296298,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,20.703703703703706,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,28.111111111111114,0)" xlink:href="#T"/></g><path fill="#fff" d="M63-70H37l-4-178h34zM33 0v-35h34V0H33" id="ae"/><g id="t"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#ab"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,22.222222222222225,0)" xlink:href="#K"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,28.888888888888893,0)" xlink:href="#ae"/></g></defs></g></svg> -------------------------------------------------------------------------------- /notes/keyboard.md: -------------------------------------------------------------------------------- 1 | # Which key was pressed? 2 | 3 | When you're 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-fits-all solution. 4 | 5 | [ke]: https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent 6 | 7 | ## `charCode` vs `keyCode` vs `which` vs `key` vs `code` 8 | 9 | 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. 10 | 11 | [key]: https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/key 12 | 13 | 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). 14 | 15 | 16 | ## Writing a `key` decoder 17 | 18 | The simplest approach is to just decode the string value: 19 | 20 | ```elm 21 | import Json.Decode as Decode 22 | 23 | keyDecoder : Decode.Decoder String 24 | keyDecoder = 25 | Decode.field "key" Decode.string 26 | ``` 27 | 28 | Depending on your scenario, you may want something more elaborate though! 29 | 30 | 31 | ### Decoding for User Input 32 | 33 | 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: 34 | 35 | ```elm 36 | import Json.Decode as Decode 37 | 38 | type Key 39 | = Character Char 40 | | Control String 41 | 42 | keyDecoder : Decode.Decoder Key 43 | keyDecoder = 44 | Decode.map toKey (Decode.field "key" Decode.string) 45 | 46 | toKey : String -> Key 47 | toKey string = 48 | case String.uncons string of 49 | Just (char, "") -> 50 | Character char 51 | 52 | _ -> 53 | Control string 54 | ``` 55 | 56 | > **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! 57 | 58 | 59 | ### Decoding for Games 60 | 61 | Or maybe you want to handle left and right arrows specially for a game or a presentation viewer. You could do something like this: 62 | 63 | ```elm 64 | import Json.Decode as Decode 65 | 66 | type Direction 67 | = Left 68 | | Right 69 | | Other 70 | 71 | keyDecoder : Decode.Decoder Direction 72 | keyDecoder = 73 | Decode.map toDirection (Decode.field "key" Decode.string) 74 | 75 | toDirection : String -> Direction 76 | toDirection string = 77 | case string of 78 | "ArrowLeft" -> 79 | Left 80 | 81 | "ArrowRight" -> 82 | Right 83 | 84 | _ -> 85 | Other 86 | ``` 87 | 88 | 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. 89 | 90 | Hope that helps you write a decoder that works for your scenario! 91 | -------------------------------------------------------------------------------- /notes/navigation-in-elements.md: -------------------------------------------------------------------------------- 1 | # How do I manage URL from a `Browser.element`? 2 | 3 | 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. 4 | 5 | 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. 6 | 7 | What do you do? 8 | 9 | 10 | ## Managing the URL from `Browser.element` 11 | 12 | You would initialize your element like this: 13 | 14 | ```javascript 15 | // Initialize your Elm program 16 | var app = Elm.Main.init({ 17 | flags: location.href, 18 | node: document.getElementById('elm-main') 19 | }); 20 | 21 | // Inform app of browser navigation (the BACK and FORWARD buttons) 22 | window.addEventListener('popstate', function () { 23 | app.ports.onUrlChange.send(location.href); 24 | }); 25 | 26 | // Change the URL upon request, inform app of the change. 27 | app.ports.pushUrl.subscribe(function(url) { 28 | history.pushState({}, '', url); 29 | app.ports.onUrlChange.send(location.href); 30 | }); 31 | ``` 32 | 33 | 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 34 | anything like that. 35 | 36 | From there, your Elm code would look something like this: 37 | 38 | ```elm 39 | import Browser 40 | import Html exposing (..) 41 | import Html.Attributes exposing (..) 42 | import Html.Events exposing (..) 43 | import Json.Decode as D 44 | import Url 45 | import Url.Parser as Url 46 | 47 | 48 | main : Program String Model Msg 49 | main = 50 | Browser.element 51 | { init = init 52 | , view = view 53 | , update = update 54 | , subscriptions = subscriptions 55 | } 56 | 57 | 58 | type Msg = UrlChanged (Maybe Route) | ... 59 | 60 | 61 | -- INIT 62 | 63 | init : String -> ( Model, Cmd Msg ) 64 | init locationHref = 65 | ... 66 | 67 | 68 | -- SUBSCRIPTION 69 | 70 | subscriptions : Model -> Sub Msg 71 | subscriptions model = 72 | onUrlChange (locationHrefToRoute >> UrlChanged) 73 | 74 | 75 | -- NAVIGATION 76 | 77 | port onUrlChange : (String -> msg) -> Sub msg 78 | 79 | port pushUrl : String -> Cmd msg 80 | 81 | link : msg -> List (Attribute msg) -> List (Html msg) -> Html msg 82 | link href attrs children = 83 | a (preventDefaultOn "click" (D.succeed (href, True)) :: attrs) children 84 | 85 | locationHrefToRoute : String -> Maybe Route 86 | locationHrefToRoute locationHref = 87 | case Url.fromString locationHref of 88 | Nothing -> Nothing 89 | Just url -> Url.parse myParser url 90 | 91 | -- myParser : Url.Parser (Route -> Route) Route 92 | ``` 93 | 94 | So in contrast with `Browser.application`, you have to manage the URL yourself in JavaScript. What is up with that?! 95 | 96 | 97 | ## Justification 98 | 99 | 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. 100 | 101 | 102 | ### Reliability 103 | 104 | 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. 105 | 106 | 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. 107 | 108 | 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? 109 | 110 | > **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. 111 | 112 | 113 | ### Lines of Code 114 | 115 | 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? 116 | 117 | Well, the JavaScript code would be something like this: 118 | 119 | ```javascript 120 | var app = Elm.Main.init({ 121 | flags: ... 122 | }); 123 | ``` 124 | 125 | And in Elm: 126 | 127 | ```elm 128 | import Browser 129 | import Browser.Navigation as Nav 130 | import Url 131 | import Url.Parser as Url 132 | 133 | 134 | main : Program Flags Model Msg 135 | main = 136 | Browser.application 137 | { init = init 138 | , view = view 139 | , update = update 140 | , subscriptions = subscriptions 141 | , onUrlChange = UrlChanged 142 | , onUrlRequest = LinkClicked 143 | } 144 | 145 | 146 | type Msg = UrlChanged (Maybe Route) | ... 147 | 148 | 149 | -- INIT 150 | 151 | init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) 152 | init flags url key = 153 | ... 154 | 155 | 156 | -- SUBSCRIPTION 157 | 158 | subscriptions : Model -> Sub Msg 159 | subscriptions model = 160 | Sub.none 161 | 162 | 163 | -- NAVIGATION 164 | 165 | urlToRoute : Url.Url -> Maybe Route 166 | urlToRoute url = 167 | Url.parse myParser url 168 | 169 | -- myParser : Url.Parser (Route -> Route) Route 170 | ``` 171 | 172 | So the main differences are: 173 | 174 | 1. You can delete the ports in JavaScript (seven lines) 175 | 2. `port onUrlChanged` becomes `onUrlChanged` in `main` (zero lines) 176 | 3. `locationHrefToRoute` becomes `urlToRoute` (three lines) 177 | 4. `link` becomes `onUrlRequest` and handling code in `update` (depends) 178 | 179 | 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. 180 | 181 | 182 | ### Summary 183 | 184 | 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? 185 | 186 | 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. 187 | 188 | 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. 189 | -------------------------------------------------------------------------------- /src/Browser.elm: -------------------------------------------------------------------------------- 1 | module Browser exposing 2 | ( sandbox 3 | , element 4 | , document, Document 5 | , application, UrlRequest(..) 6 | ) 7 | 8 | {-| This module helps you set up an Elm `Program` with functions like 9 | [`sandbox`](#sandbox) and [`document`](#document). 10 | 11 | 12 | # Sandboxes 13 | 14 | @docs sandbox 15 | 16 | 17 | # Elements 18 | 19 | @docs element 20 | 21 | 22 | # Documents 23 | 24 | @docs document, Document 25 | 26 | 27 | # Applications 28 | 29 | @docs application, UrlRequest 30 | 31 | -} 32 | 33 | import Browser.Navigation as Navigation 34 | import Debugger.Main 35 | import Dict 36 | import Elm.Kernel.Browser 37 | import Html exposing (Html) 38 | import Url 39 | 40 | 41 | 42 | -- SANDBOX 43 | 44 | 45 | {-| Create a “sandboxed” program that cannot communicate with the outside 46 | world. 47 | 48 | This is great for learning the basics of [The Elm Architecture][tea]. You can 49 | see sandboxes in action in the following examples: 50 | 51 | - [Buttons](https://guide.elm-lang.org/architecture/buttons.html) 52 | - [Text Fields](https://guide.elm-lang.org/architecture/text_fields.html) 53 | - [Forms](https://guide.elm-lang.org/architecture/forms.html) 54 | 55 | Those are nice, but **I very highly recommend reading [this guide][guide] 56 | straight through** to really learn how Elm works. Understanding the 57 | fundamentals actually pays off in this language! 58 | 59 | [tea]: https://guide.elm-lang.org/architecture/ 60 | [guide]: https://guide.elm-lang.org/ 61 | 62 | -} 63 | sandbox : 64 | { init : model 65 | , view : model -> Html msg 66 | , update : msg -> model -> model 67 | } 68 | -> Program () model msg 69 | sandbox impl = 70 | Elm.Kernel.Browser.element 71 | { init = \() -> ( impl.init, Cmd.none ) 72 | , view = impl.view 73 | , update = \msg model -> ( impl.update msg model, Cmd.none ) 74 | , subscriptions = \_ -> Sub.none 75 | } 76 | 77 | 78 | 79 | -- ELEMENT 80 | 81 | 82 | {-| Create an HTML element managed by Elm. The resulting elements are easy to 83 | embed in larger JavaScript projects, and lots of companies that use Elm 84 | started with this approach! Try it out on something small. If it works, great, 85 | do more! If not, revert, no big deal. 86 | 87 | Unlike a [`sandbox`](#sandbox), an `element` can talk to the outside world in 88 | a couple ways: 89 | 90 | - `Cmd` — you can “command” the Elm runtime to do stuff, like HTTP. 91 | - `Sub` — you can “subscribe” to event sources, like clock ticks. 92 | - `flags` — JavaScript can pass in data when starting the Elm program 93 | - `ports` — set up a client-server relationship with JavaScript 94 | 95 | As you read [the guide][guide] you will run into a bunch of examples of `element` 96 | in [this section][fx]. You can learn more about flags and ports in [the interop 97 | section][interop]. 98 | 99 | [guide]: https://guide.elm-lang.org/ 100 | [fx]: https://guide.elm-lang.org/effects/ 101 | [interop]: https://guide.elm-lang.org/interop/ 102 | 103 | -} 104 | element : 105 | { init : flags -> ( model, Cmd msg ) 106 | , view : model -> Html msg 107 | , update : msg -> model -> ( model, Cmd msg ) 108 | , subscriptions : model -> Sub msg 109 | } 110 | -> Program flags model msg 111 | element = 112 | Elm.Kernel.Browser.element 113 | 114 | 115 | 116 | -- DOCUMENT 117 | 118 | 119 | {-| Create an HTML document managed by Elm. This expands upon what `element` 120 | can do in that `view` now gives you control over the `<title>` and `<body>`. 121 | -} 122 | document : 123 | { init : flags -> ( model, Cmd msg ) 124 | , view : model -> Document msg 125 | , update : msg -> model -> ( model, Cmd msg ) 126 | , subscriptions : model -> Sub msg 127 | } 128 | -> Program flags model msg 129 | document = 130 | Elm.Kernel.Browser.document 131 | 132 | 133 | {-| This data specifies the `<title>` and all of the nodes that should go in 134 | the `<body>`. This means you can update the title as your application changes. 135 | Maybe your "single-page app" navigates to a "different page", maybe a calendar 136 | app shows an accurate date in the title, etc. 137 | 138 | > **Note about CSS:** This looks similar to an `<html>` document, but this is 139 | > not the place to manage CSS assets. If you want to work with CSS, there are 140 | > a couple ways: 141 | > 142 | > 1. Packages like [`rtfeldman/elm-css`][elm-css] give all of the features 143 | > of CSS without any CSS files. You can add all the styles you need in your 144 | > `view` function, and there is no need to worry about class names matching. 145 | > 146 | > 2. Compile your Elm code to JavaScript with `elm make --output=elm.js` and 147 | > then make your own HTML file that loads `elm.js` and the CSS file you want. 148 | > With this approach, it does not matter where the CSS comes from. Write it 149 | > by hand. Generate it. Whatever you want to do. 150 | > 151 | > 3. If you need to change `<link>` tags dynamically, you can send messages 152 | > out a port to do it in JavaScript. 153 | > 154 | > The bigger point here is that loading assets involves touching the `<head>` 155 | > as an implementation detail of browsers, but that does not mean it should be 156 | > the responsibility of the `view` function in Elm. So we do it differently! 157 | 158 | [elm-css]: /packages/rtfeldman/elm-css/latest/ 159 | 160 | -} 161 | type alias Document msg = 162 | { title : String 163 | , body : List (Html msg) 164 | } 165 | 166 | 167 | 168 | -- APPLICATION 169 | 170 | 171 | {-| Create an application that manages [`Url`][url] changes. 172 | 173 | **When the application starts**, `init` gets the initial `Url`. You can show 174 | different things depending on the `Url`! 175 | 176 | **When someone clicks a link**, like `<a href="/home">Home</a>`, it always goes 177 | through `onUrlRequest`. The resulting message goes to your `update` function, 178 | giving you a chance to save scroll position or persist data before changing 179 | the URL yourself with [`pushUrl`][bnp] or [`load`][bnl]. More info on this in 180 | the [`UrlRequest`](#UrlRequest) docs! 181 | 182 | **When the URL changes**, the new `Url` goes through `onUrlChange`. The 183 | resulting message goes to `update` where you can decide what to show next. 184 | 185 | Applications always use the [`Browser.Navigation`][bn] module for precise 186 | control over `Url` changes. 187 | 188 | **More Info:** Here are some example usages of `application` programs: 189 | 190 | - [RealWorld example app](https://github.com/rtfeldman/elm-spa-example) 191 | - [Elm’s package website](https://github.com/elm/package.elm-lang.org) 192 | 193 | These are quite advanced Elm programs, so be sure to go through [the guide][g] 194 | first to get a solid conceptual foundation before diving in! If you start 195 | reading a calculus book from page 314, it might seem confusing. Same here! 196 | 197 | **Note:** Can an [`element`](#element) manage the URL too? Read [this]! 198 | 199 | [g]: https://guide.elm-lang.org/ 200 | [bn]: Browser-Navigation 201 | [bnp]: Browser-Navigation#pushUrl 202 | [bnl]: Browser-Navigation#load 203 | [url]: /packages/elm/url/latest/Url#Url 204 | [this]: https://github.com/elm/browser/blob/1.0.2/notes/navigation-in-elements.md 205 | 206 | -} 207 | application : 208 | { init : flags -> Url.Url -> Navigation.Key -> ( model, Cmd msg ) 209 | , view : model -> Document msg 210 | , update : msg -> model -> ( model, Cmd msg ) 211 | , subscriptions : model -> Sub msg 212 | , onUrlRequest : UrlRequest -> msg 213 | , onUrlChange : Url.Url -> msg 214 | } 215 | -> Program flags model msg 216 | application = 217 | Elm.Kernel.Browser.application 218 | 219 | 220 | {-| All links in an [`application`](#application) create a `UrlRequest`. So 221 | when you click `<a href="/home">Home</a>`, it does not just navigate! It 222 | notifies `onUrlRequest` that the user wants to change the `Url`. 223 | 224 | 225 | ### `Internal` vs `External` 226 | 227 | Imagine we are browsing `https://example.com`. An `Internal` link would be 228 | like: 229 | 230 | - `settings#privacy` 231 | - `/home` 232 | - `https://example.com/home` 233 | - `//example.com/home` 234 | 235 | All of these links exist under the `https://example.com` domain. An `External` 236 | link would be like: 237 | 238 | - `https://elm-lang.org/examples` 239 | - `https://other.example.com/home` 240 | - `http://example.com/home` 241 | 242 | Anything that changes the domain. Notice that changing the protocol from 243 | `https` to `http` is considered a different domain! (And vice versa!) 244 | 245 | 246 | ### Purpose 247 | 248 | Having a `UrlRequest` requires a case in your `update` like this: 249 | 250 | import Browser exposing (..) 251 | import Browser.Navigation as Nav 252 | import Url 253 | 254 | type Msg 255 | = ClickedLink UrlRequest 256 | 257 | update : Msg -> Model -> ( Model, Cmd msg ) 258 | update msg model = 259 | case msg of 260 | ClickedLink urlRequest -> 261 | case urlRequest of 262 | Internal url -> 263 | ( model 264 | , Nav.pushUrl model.key (Url.toString url) 265 | ) 266 | 267 | External url -> 268 | ( model 269 | , Nav.load url 270 | ) 271 | 272 | This is useful because it gives you a chance to customize the behavior in each 273 | case. Maybe on some `Internal` links you save the scroll position with 274 | [`Browser.Dom.getViewport`](Browser-Dom#getViewport) so you can restore it 275 | later. Maybe on `External` links you persist parts of the `Model` on your 276 | servers before leaving. Whatever you need to do! 277 | 278 | **Note:** Knowing the scroll position is not enough to restore it! What if the 279 | browser dimensions change? The scroll position will not correlate with 280 | “what was on screen” anymore. So it may be better to remember 281 | “what was on screen” and recreate the position based on that. For 282 | example, in a Wikipedia article, remember the header that they were looking at 283 | most recently. [`Browser.Dom.getElement`](Browser-Dom#getElement) is designed 284 | for figuring that out! 285 | 286 | -} 287 | type UrlRequest 288 | = Internal Url.Url 289 | | External String 290 | -------------------------------------------------------------------------------- /src/Browser/AnimationManager.elm: -------------------------------------------------------------------------------- 1 | effect module Browser.AnimationManager where { subscription = MySub } exposing 2 | ( onAnimationFrame 3 | , onAnimationFrameDelta 4 | ) 5 | 6 | import Elm.Kernel.Browser 7 | import Process 8 | import Task exposing (Task) 9 | import Time 10 | 11 | 12 | 13 | -- PUBLIC STUFF 14 | 15 | 16 | onAnimationFrame : (Time.Posix -> msg) -> Sub msg 17 | onAnimationFrame tagger = 18 | subscription (Time tagger) 19 | 20 | 21 | onAnimationFrameDelta : (Float -> msg) -> Sub msg 22 | onAnimationFrameDelta tagger = 23 | subscription (Delta tagger) 24 | 25 | 26 | 27 | -- SUBSCRIPTIONS 28 | 29 | 30 | type MySub msg 31 | = Time (Time.Posix -> msg) 32 | | Delta (Float -> msg) 33 | 34 | 35 | subMap : (a -> b) -> MySub a -> MySub b 36 | subMap func sub = 37 | case sub of 38 | Time tagger -> 39 | Time (func << tagger) 40 | 41 | Delta tagger -> 42 | Delta (func << tagger) 43 | 44 | 45 | 46 | -- EFFECT MANAGER 47 | 48 | 49 | type alias State msg = 50 | { subs : List (MySub msg) 51 | , request : Maybe Process.Id 52 | , oldTime : Int 53 | } 54 | 55 | 56 | 57 | -- NOTE: used in onEffects 58 | -- 59 | 60 | 61 | init : Task Never (State msg) 62 | init = 63 | Task.succeed (State [] Nothing 0) 64 | 65 | 66 | onEffects : Platform.Router msg Int -> List (MySub msg) -> State msg -> Task Never (State msg) 67 | onEffects router subs { request, oldTime } = 68 | case ( request, subs ) of 69 | ( Nothing, [] ) -> 70 | init 71 | 72 | ( Just pid, [] ) -> 73 | Process.kill pid 74 | |> Task.andThen (\_ -> init) 75 | 76 | ( Nothing, _ ) -> 77 | Process.spawn (Task.andThen (Platform.sendToSelf router) rAF) 78 | |> Task.andThen 79 | (\pid -> 80 | now 81 | |> Task.andThen (\time -> Task.succeed (State subs (Just pid) time)) 82 | ) 83 | 84 | ( Just _, _ ) -> 85 | Task.succeed (State subs request oldTime) 86 | 87 | 88 | onSelfMsg : Platform.Router msg Int -> Int -> State msg -> Task Never (State msg) 89 | onSelfMsg router newTime { subs, oldTime } = 90 | let 91 | send sub = 92 | case sub of 93 | Time tagger -> 94 | Platform.sendToApp router (tagger (Time.millisToPosix newTime)) 95 | 96 | Delta tagger -> 97 | Platform.sendToApp router (tagger (toFloat (newTime - oldTime))) 98 | in 99 | Process.spawn (Task.andThen (Platform.sendToSelf router) rAF) 100 | |> Task.andThen 101 | (\pid -> 102 | Task.sequence (List.map send subs) 103 | |> Task.andThen (\_ -> Task.succeed (State subs (Just pid) newTime)) 104 | ) 105 | 106 | 107 | rAF : Task x Int 108 | rAF = 109 | Elm.Kernel.Browser.rAF () 110 | 111 | 112 | now : Task x Int 113 | now = 114 | Elm.Kernel.Browser.now () 115 | -------------------------------------------------------------------------------- /src/Browser/Dom.elm: -------------------------------------------------------------------------------- 1 | module Browser.Dom exposing 2 | ( focus, blur, Error(..) 3 | , getViewport, Viewport, getViewportOf 4 | , setViewport, setViewportOf 5 | , getElement, Element 6 | ) 7 | 8 | {-| This module allows you to manipulate the DOM in various ways. It covers: 9 | 10 | - Focus and blur input elements. 11 | - Get the `width` and `height` of elements. 12 | - Get the `x` and `y` coordinates of elements. 13 | - Figure out the scroll position. 14 | - Change the scroll position! 15 | 16 | We use different terminology than JavaScript though... 17 | 18 | 19 | # Terminology 20 | 21 | Have you ever thought about how “scrolling” is a metaphor about 22 | scrolls? Like hanging scrolls of caligraphy made during the Han Dynasty 23 | in China? 24 | 25 | This metaphor falls apart almost immediately though. For example, many scrolls 26 | read horizontally! Like a [Sefer Torah][torah] or [Chinese Handscrolls][hand]. 27 | The two sides move independently, sometimes kept in place with stones. What is 28 | a scroll bar in this world? And [hanging scrolls][hang] (which _are_ displayed 29 | vertically) do not “scroll” at all! They hang! 30 | 31 | So in JavaScript, we start with a badly stretched metaphor and add a bunch of 32 | DOM details like padding, borders, and margins. How do those relate to scrolls? 33 | For example, JavaScript has `clientWidth`. Client like a feudal state that pays 34 | tribute to the emperor? And `offsetHeight`. Can an offset even have height? And 35 | what has that got to do with scrolls? 36 | 37 | So instead of inheriting this metaphorical hodge-podge, we use terminology from 38 | 3D graphics. You have a **scene** containing all your elements and a **viewport** 39 | into the scene. I think it ends up being a lot clearer, but you can evaluate 40 | for yourself when you see the diagrams later! 41 | 42 | **Note:** For more scroll facts, I recommend [A Day on the Grand Canal with 43 | the Emperor of China or: Surface Is Illusion But So Is Depth][doc] where David 44 | Hockney explores the history of _perspective_ in art. Really interesting! 45 | 46 | [torah]: https://en.wikipedia.org/wiki/Sefer_Torah 47 | [hand]: https://www.metmuseum.org/toah/hd/chhs/hd_chhs.htm 48 | [hang]: https://en.wikipedia.org/wiki/Hanging_scroll 49 | [doc]: https://www.imdb.com/title/tt0164525/ 50 | 51 | 52 | # Focus 53 | 54 | @docs focus, blur, Error 55 | 56 | 57 | # Get Viewport 58 | 59 | @docs getViewport, Viewport, getViewportOf 60 | 61 | 62 | # Set Viewport 63 | 64 | @docs setViewport, setViewportOf 65 | 66 | 67 | # Position 68 | 69 | @docs getElement, Element 70 | 71 | -} 72 | 73 | import Elm.Kernel.Browser 74 | import Task exposing (Task) 75 | 76 | 77 | 78 | -- FOCUS 79 | 80 | 81 | {-| Find a DOM node by `id` and focus on it. So if you wanted to focus a node 82 | like `<input type="text" id="search-box">` you could say: 83 | 84 | import Browser.Dom as Dom 85 | import Task 86 | 87 | type Msg 88 | = NoOp 89 | 90 | focusSearchBox : Cmd Msg 91 | focusSearchBox = 92 | Task.attempt (\_ -> NoOp) (Dom.focus "search-box") 93 | 94 | Notice that this code ignores the possibility that `search-box` is not used 95 | as an `id` by any node, failing silently in that case. It would be better to 96 | log the failure with whatever error reporting system you use. 97 | 98 | -} 99 | focus : String -> Task Error () 100 | focus = 101 | Elm.Kernel.Browser.call "focus" 102 | 103 | 104 | {-| Find a DOM node by `id` and make it lose focus. So if you wanted a node 105 | like `<input type="text" id="search-box">` to lose focus you could say: 106 | 107 | import Browser.Dom as Dom 108 | import Task 109 | 110 | type Msg 111 | = NoOp 112 | 113 | unfocusSearchBox : Cmd Msg 114 | unfocusSearchBox = 115 | Task.attempt (\_ -> NoOp) (Dom.blur "search-box") 116 | 117 | Notice that this code ignores the possibility that `search-box` is not used 118 | as an `id` by any node, failing silently in that case. It would be better to 119 | log the failure with whatever error reporting system you use. 120 | 121 | -} 122 | blur : String -> Task Error () 123 | blur = 124 | Elm.Kernel.Browser.call "blur" 125 | 126 | 127 | 128 | -- ERROR 129 | 130 | 131 | {-| Many functions in this module look up DOM nodes up by their `id`. If you 132 | ask for an `id` that is not in the DOM, you will get this error. 133 | -} 134 | type Error 135 | = NotFound String 136 | 137 | 138 | 139 | -- VIEWPORT 140 | 141 | 142 | {-| Get information on the current viewport of the browser. 143 | 144 | ![getViewport](https://elm.github.io/browser/v1/getViewport.svg) 145 | 146 | If you want to move the viewport around (i.e. change the scroll position) you 147 | can use [`setViewport`](#setViewport) which change the `x` and `y` of the 148 | viewport. 149 | 150 | -} 151 | getViewport : Task x Viewport 152 | getViewport = 153 | Elm.Kernel.Browser.withWindow Elm.Kernel.Browser.getViewport 154 | 155 | 156 | {-| All the information about the current viewport. 157 | 158 | ![getViewport](https://elm.github.io/browser/v1/getViewport.svg) 159 | 160 | -} 161 | type alias Viewport = 162 | { scene : 163 | { width : Float 164 | , height : Float 165 | } 166 | , viewport : 167 | { x : Float 168 | , y : Float 169 | , width : Float 170 | , height : Float 171 | } 172 | } 173 | 174 | 175 | {-| Just like `getViewport`, but for any scrollable DOM node. Say we have an 176 | application with a chat box in the bottow right corner like this: 177 | 178 | ![chat](https://elm.github.io/browser/v1/chat.svg) 179 | 180 | There are probably a whole bunch of messages that are not being shown. You 181 | could scroll up to see them all. Well, we can think of that chat box is a 182 | viewport into a scene! 183 | 184 | ![getViewportOf](https://elm.github.io/browser/v1/getViewportOf.svg) 185 | 186 | This can be useful with [`setViewportOf`](#setViewportOf) to make sure new 187 | messages always appear on the bottom. 188 | 189 | The viewport size _does not_ include the border or margins. 190 | 191 | **Note:** This data is collected from specific fields in JavaScript, so it 192 | may be helpful to know that: 193 | 194 | - `scene.width` = [`scrollWidth`][sw] 195 | - `scene.height` = [`scrollHeight`][sh] 196 | - `viewport.x` = [`scrollLeft`][sl] 197 | - `viewport.y` = [`scrollTop`][st] 198 | - `viewport.width` = [`clientWidth`][cw] 199 | - `viewport.height` = [`clientHeight`][ch] 200 | 201 | Neither [`offsetWidth`][ow] nor [`offsetHeight`][oh] are available. The theory 202 | is that (1) the information can always be obtained by using `getElement` on a 203 | node without margins, (2) no cases came to mind where you actually care in the 204 | first place, and (3) it is available through ports if it is really needed. 205 | If you have a case that really needs it though, please share your specific 206 | scenario in an issue! Nicely presented case studies are the raw ingredients for 207 | API improvements! 208 | 209 | [sw]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollWidth 210 | [sh]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollHeight 211 | [st]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollTop 212 | [sl]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollLeft 213 | [cw]: https://developer.mozilla.org/en-US/docs/Web/API/Element/clientWidth 214 | [ch]: https://developer.mozilla.org/en-US/docs/Web/API/Element/clientHeight 215 | [ow]: https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/offsetWidth 216 | [oh]: https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/offsetHeight 217 | 218 | -} 219 | getViewportOf : String -> Task Error Viewport 220 | getViewportOf = 221 | Elm.Kernel.Browser.getViewportOf 222 | 223 | 224 | 225 | -- SET VIEWPORT 226 | 227 | 228 | {-| Change the `x` and `y` offset of the browser viewport immediately. For 229 | example, you could make a command to jump to the top of the page: 230 | 231 | import Browser.Dom as Dom 232 | import Task 233 | 234 | type Msg 235 | = NoOp 236 | 237 | resetViewport : Cmd Msg 238 | resetViewport = 239 | Task.perform (\_ -> NoOp) (Dom.setViewport 0 0) 240 | 241 | This sets the viewport offset to zero. 242 | 243 | This could be useful with `Browser.application` where you may want to reset 244 | the viewport when the URL changes. Maybe you go to a “new page” 245 | and want people to start at the top! 246 | 247 | -} 248 | setViewport : Float -> Float -> Task x () 249 | setViewport = 250 | Elm.Kernel.Browser.setViewport 251 | 252 | 253 | {-| Change the `x` and `y` offset of a DOM node’s viewport by ID. This 254 | is common in text messaging and chat rooms, where once the messages fill the 255 | screen, you want to always be at the very bottom of the message chain. This 256 | way the latest message is always on screen! You could do this: 257 | 258 | import Browser.Dom as Dom 259 | import Task 260 | 261 | type Msg 262 | = NoOp 263 | 264 | jumpToBottom : String -> Cmd Msg 265 | jumpToBottom id = 266 | Dom.getViewportOf id 267 | |> Task.andThen (\info -> Dom.setViewportOf id 0 info.scene.height) 268 | |> Task.attempt (\_ -> NoOp) 269 | 270 | So you could call `jumpToBottom "chat-box"` whenever you add a new message. 271 | 272 | **Note 1:** What happens if the viewport is placed out of bounds? Where there 273 | is no `scene` to show? To avoid this question, the `x` and `y` offsets are 274 | clamped such that the viewport is always fully within the `scene`. So when 275 | `jumpToBottom` sets the `y` offset of the viewport to the `height` of the 276 | `scene` (i.e. too far!) it relies on this clamping behavior to put the viewport 277 | back in bounds. 278 | 279 | **Note 2:** The example ignores when the element ID is not found, but it would 280 | be great to log that information. It means there may be a bug or a dead link 281 | somewhere! 282 | 283 | -} 284 | setViewportOf : String -> Float -> Float -> Task Error () 285 | setViewportOf = 286 | Elm.Kernel.Browser.setViewportOf 287 | 288 | 289 | 290 | {--SLIDE VIEWPORT 291 | 292 | 293 | {-| Change the `x` and `y` offset of the viewport with an animation. In JS, 294 | this corresponds to setting [`scroll-behavior`][sb] to `smooth`. 295 | 296 | This can definitely be overused, so try to use it specifically when you want 297 | the user to be spatially situated in a scene. For example, a “back to 298 | top” button might use it: 299 | 300 | import Browser.Dom as Dom 301 | import Task 302 | 303 | type Msg = NoOp 304 | 305 | backToTop : Cmd Msg 306 | backToTop = 307 | Task.perform (\_ -> NoOp) (Dom.slideViewport 0 0) 308 | 309 | Be careful when paring this with `Browser.application`. When the URL changes 310 | and a whole new scene is going to be rendered, using `setViewport` is probably 311 | best. If you are moving within a scene, you may benefit from a mix of 312 | `setViewport` and `slideViewport`. Sliding to the top is nice, but sliding 313 | around everywhere is probably annoying. 314 | 315 | [sb]: https://developer.mozilla.org/en-US/docs/Web/CSS/scroll-behavior 316 | -} 317 | slideViewport : Float -> Float -> Task x () 318 | slideViewport = 319 | Debug.todo "slideViewport" 320 | 321 | 322 | slideViewportOf : String -> Float -> Float -> Task Error () 323 | slideViewportOf = 324 | Debug.todo "slideViewportOf" 325 | 326 | --} 327 | -- ELEMENT 328 | 329 | 330 | {-| Get position information about specific elements. Say we put 331 | `id "jesting-aside"` on the seventh paragraph of the text. When we call 332 | `getElement "jesting-aside"` we would get the following information: 333 | 334 | ![getElement](https://elm.github.io/browser/v1/getElement.svg) 335 | 336 | This can be useful for: 337 | 338 | - **Scrolling** — Pair this information with `setViewport` to scroll 339 | specific elements into view. This gives you a lot of control over where exactly 340 | the element would be after the viewport moved. 341 | 342 | - **Drag and Drop** — As of this writing, `touchmove` events do not tell 343 | you which element you are currently above. To figure out if you have dragged 344 | something over the target, you could see if the `pageX` and `pageY` of the 345 | touch are inside the `x`, `y`, `width`, and `height` of the target element. 346 | 347 | **Note:** This corresponds to JavaScript’s [`getBoundingClientRect`][gbcr], 348 | so **the element’s margins are included in its `width` and `height`**. 349 | With scrolling, maybe you want to include the margins. With drag-and-drop, you 350 | probably do not, so some folks set the margins to zero and put the target 351 | element in a `<div>` that adds the spacing. Just something to be aware of! 352 | 353 | [gbcr]: https://developer.mozilla.org/en-US/docs/Web/API/Element/getBoundingClientRect 354 | 355 | -} 356 | getElement : String -> Task Error Element 357 | getElement = 358 | Elm.Kernel.Browser.getElement 359 | 360 | 361 | {-| A bunch of information about the position and size of an element relative 362 | to the overall scene. 363 | 364 | ![getElement](https://elm.github.io/browser/v1/getElement.svg) 365 | 366 | -} 367 | type alias Element = 368 | { scene : 369 | { width : Float 370 | , height : Float 371 | } 372 | , viewport : 373 | { x : Float 374 | , y : Float 375 | , width : Float 376 | , height : Float 377 | } 378 | , element : 379 | { x : Float 380 | , y : Float 381 | , width : Float 382 | , height : Float 383 | } 384 | } 385 | -------------------------------------------------------------------------------- /src/Browser/Events.elm: -------------------------------------------------------------------------------- 1 | effect module Browser.Events where { subscription = MySub } exposing 2 | ( onAnimationFrame, onAnimationFrameDelta 3 | , onKeyPress, onKeyDown, onKeyUp 4 | , onClick, onMouseMove, onMouseDown, onMouseUp 5 | , onResize, onVisibilityChange, Visibility(..) 6 | ) 7 | 8 | {-| In JavaScript, information about the root of an HTML document is held in 9 | the `document` and `window` objects. This module lets you create event 10 | listeners on those objects for the following topics: [animation](#animation), 11 | [keyboard](#keyboard), [mouse](#mouse), and [window](#window). 12 | 13 | If there is something else you need, use [ports] to do it in JavaScript! 14 | 15 | [ports]: https://guide.elm-lang.org/interop/ports.html 16 | 17 | 18 | # Animation 19 | 20 | @docs onAnimationFrame, onAnimationFrameDelta 21 | 22 | 23 | # Keyboard 24 | 25 | @docs onKeyPress, onKeyDown, onKeyUp 26 | 27 | 28 | # Mouse 29 | 30 | @docs onClick, onMouseMove, onMouseDown, onMouseUp 31 | 32 | 33 | # Window 34 | 35 | @docs onResize, onVisibilityChange, Visibility 36 | 37 | -} 38 | 39 | import Browser.AnimationManager as AM 40 | import Dict 41 | import Elm.Kernel.Browser 42 | import Json.Decode as Decode 43 | import Process 44 | import Task exposing (Task) 45 | import Time 46 | 47 | 48 | 49 | -- ANIMATION 50 | 51 | 52 | {-| An animation frame triggers about 60 times per second. Get the POSIX time 53 | on each frame. (See [`elm/time`](/packages/elm/time/latest) for more info on 54 | POSIX times.) 55 | 56 | **Note:** Browsers have their own render loop, repainting things as fast as 57 | possible. If you want smooth animations in your application, it is helpful to 58 | sync up with the browsers natural refresh rate. This hooks into JavaScript's 59 | `requestAnimationFrame` function. 60 | 61 | -} 62 | onAnimationFrame : (Time.Posix -> msg) -> Sub msg 63 | onAnimationFrame = 64 | AM.onAnimationFrame 65 | 66 | 67 | {-| Just like `onAnimationFrame`, except message is the time in milliseconds 68 | since the previous frame. So you should get a sequence of values all around 69 | `1000 / 60` which is nice for stepping animations by a time delta. 70 | -} 71 | onAnimationFrameDelta : (Float -> msg) -> Sub msg 72 | onAnimationFrameDelta = 73 | AM.onAnimationFrameDelta 74 | 75 | 76 | 77 | -- KEYBOARD 78 | 79 | 80 | {-| Subscribe to key presses that normally produce characters. So you should 81 | not rely on this for arrow keys. 82 | 83 | **Note:** Check out [this advice][note] to learn more about decoding key codes. 84 | It is more complicated than it should be. 85 | 86 | [note]: https://github.com/elm/browser/blob/1.0.2/notes/keyboard.md 87 | 88 | -} 89 | onKeyPress : Decode.Decoder msg -> Sub msg 90 | onKeyPress = 91 | on Document "keypress" 92 | 93 | 94 | {-| Subscribe to get codes whenever a key goes down. This can be useful for 95 | creating games. Maybe you want to know if people are pressing `w`, `a`, `s`, 96 | or `d` at any given time. 97 | 98 | **Note:** Check out [this advice][note] to learn more about decoding key codes. 99 | It is more complicated than it should be. 100 | 101 | [note]: https://github.com/elm/browser/blob/1.0.2/notes/keyboard.md 102 | 103 | -} 104 | onKeyDown : Decode.Decoder msg -> Sub msg 105 | onKeyDown = 106 | on Document "keydown" 107 | 108 | 109 | {-| Subscribe to get codes whenever a key goes up. Often used in combination 110 | with [`onVisibilityChange`](#onVisibilityChange) to be sure keys do not appear 111 | to down and never come back up. 112 | -} 113 | onKeyUp : Decode.Decoder msg -> Sub msg 114 | onKeyUp = 115 | on Document "keyup" 116 | 117 | 118 | 119 | -- MOUSE 120 | 121 | 122 | {-| Subscribe to mouse clicks anywhere on screen. Maybe you need to create a 123 | custom drop down. You could listen for clicks when it is open, letting you know 124 | if someone clicked out of it: 125 | 126 | import Browser.Events as Events 127 | import Json.Decode as D 128 | 129 | type Msg 130 | = ClickOut 131 | 132 | subscriptions : Model -> Sub Msg 133 | subscriptions model = 134 | case model.dropDown of 135 | Closed _ -> 136 | Sub.none 137 | 138 | Open _ -> 139 | Events.onClick (D.succeed ClickOut) 140 | 141 | -} 142 | onClick : Decode.Decoder msg -> Sub msg 143 | onClick = 144 | on Document "click" 145 | 146 | 147 | {-| Subscribe to mouse moves anywhere on screen. 148 | 149 | You could use this to implement resizable panels like in Elm's online code 150 | editor. Check out the example imprementation [here][drag]. 151 | 152 | [drag]: https://github.com/elm/browser/blob/1.0.2/examples/src/Drag.elm 153 | 154 | **Note:** Unsubscribe if you do not need these events! Running code on every 155 | single mouse movement can be very costly, and it is recommended to only 156 | subscribe when absolutely necessary. 157 | 158 | -} 159 | onMouseMove : Decode.Decoder msg -> Sub msg 160 | onMouseMove = 161 | on Document "mousemove" 162 | 163 | 164 | {-| Subscribe to get mouse information whenever the mouse button goes down. 165 | -} 166 | onMouseDown : Decode.Decoder msg -> Sub msg 167 | onMouseDown = 168 | on Document "mousedown" 169 | 170 | 171 | {-| Subscribe to get mouse information whenever the mouse button goes up. 172 | Often used in combination with [`onVisibilityChange`](#onVisibilityChange) 173 | to be sure keys do not appear to down and never come back up. 174 | -} 175 | onMouseUp : Decode.Decoder msg -> Sub msg 176 | onMouseUp = 177 | on Document "mouseup" 178 | 179 | 180 | 181 | -- WINDOW 182 | 183 | 184 | {-| Subscribe to any changes in window size. 185 | 186 | For example, you could track the current width by saying: 187 | 188 | import Browser.Events as E 189 | 190 | type Msg 191 | = GotNewWidth Int 192 | 193 | subscriptions : model -> Cmd Msg 194 | subscriptions _ = 195 | E.onResize (\w h -> GotNewWidth w) 196 | 197 | **Note:** This is equivalent to getting events from [`window.onresize`][resize]. 198 | 199 | [resize]: https://developer.mozilla.org/en-US/docs/Web/API/GlobalEventHandlers/onresize 200 | 201 | -} 202 | onResize : (Int -> Int -> msg) -> Sub msg 203 | onResize func = 204 | on Window "resize" <| 205 | Decode.field "target" <| 206 | Decode.map2 func 207 | (Decode.field "innerWidth" Decode.int) 208 | (Decode.field "innerHeight" Decode.int) 209 | 210 | 211 | {-| Subscribe to any visibility changes, like if the user switches to a 212 | different tab or window. When the user looks away, you may want to: 213 | 214 | - Pause a timer. 215 | - Pause an animation. 216 | - Pause video or audio. 217 | - Pause an image carousel. 218 | - Stop polling a server for new information. 219 | - Stop waiting for an [`onKeyUp`](#onKeyUp) event. 220 | 221 | -} 222 | onVisibilityChange : (Visibility -> msg) -> Sub msg 223 | onVisibilityChange func = 224 | let 225 | info = Elm.Kernel.Browser.visibilityInfo () 226 | in 227 | on Document info.change <| 228 | Decode.map (withHidden func) <| 229 | Decode.field "target" <| 230 | Decode.field info.hidden Decode.bool 231 | 232 | 233 | withHidden : (Visibility -> msg) -> Bool -> msg 234 | withHidden func isHidden = 235 | func (if isHidden then Hidden else Visible) 236 | 237 | 238 | {-| Value describing whether the page is hidden or visible. 239 | -} 240 | type Visibility 241 | = Visible 242 | | Hidden 243 | 244 | 245 | 246 | -- SUBSCRIPTIONS 247 | 248 | 249 | type Node 250 | = Document 251 | | Window 252 | 253 | 254 | on : Node -> String -> Decode.Decoder msg -> Sub msg 255 | on node name decoder = 256 | subscription (MySub node name decoder) 257 | 258 | 259 | type MySub msg 260 | = MySub Node String (Decode.Decoder msg) 261 | 262 | 263 | subMap : (a -> b) -> MySub a -> MySub b 264 | subMap func (MySub node name decoder) = 265 | MySub node name (Decode.map func decoder) 266 | 267 | 268 | 269 | -- EFFECT MANAGER 270 | 271 | 272 | type alias State msg = 273 | { subs : List ( String, MySub msg ) 274 | , pids : Dict.Dict String Process.Id 275 | } 276 | 277 | 278 | init : Task Never (State msg) 279 | init = 280 | Task.succeed (State [] Dict.empty) 281 | 282 | 283 | type alias Event = 284 | { key : String 285 | , event : Decode.Value 286 | } 287 | 288 | 289 | onSelfMsg : Platform.Router msg Event -> Event -> State msg -> Task Never (State msg) 290 | onSelfMsg router { key, event } state = 291 | let 292 | toMessage ( subKey, MySub node name decoder ) = 293 | if subKey == key then 294 | Elm.Kernel.Browser.decodeEvent decoder event 295 | else 296 | Nothing 297 | 298 | messages = List.filterMap toMessage state.subs 299 | in 300 | Task.sequence (List.map (Platform.sendToApp router) messages) 301 | |> Task.andThen (\_ -> Task.succeed state) 302 | 303 | 304 | onEffects : Platform.Router msg Event -> List (MySub msg) -> State msg -> Task Never (State msg) 305 | onEffects router subs state = 306 | let 307 | newSubs = List.map addKey subs 308 | 309 | stepLeft _ pid (deads, lives, news) = 310 | (pid :: deads, lives, news) 311 | 312 | stepBoth key pid _ (deads, lives, news) = 313 | (deads, Dict.insert key pid lives, news) 314 | 315 | stepRight key sub (deads, lives, news) = 316 | (deads, lives, spawn router key sub :: news) 317 | 318 | (deadPids, livePids, makeNewPids) = 319 | Dict.merge stepLeft stepBoth stepRight state.pids (Dict.fromList newSubs) ([], Dict.empty, []) 320 | in 321 | Task.sequence (List.map Process.kill deadPids) 322 | |> Task.andThen (\_ -> Task.sequence makeNewPids) 323 | |> Task.andThen (\pids -> Task.succeed (State newSubs (Dict.union livePids (Dict.fromList pids)))) 324 | 325 | 326 | 327 | -- TO KEY 328 | 329 | 330 | addKey : MySub msg -> ( String, MySub msg ) 331 | addKey ((MySub node name _) as sub) = 332 | (nodeToKey node ++ name, sub) 333 | 334 | 335 | nodeToKey : Node -> String 336 | nodeToKey node = 337 | case node of 338 | Document -> "d_" 339 | Window -> "w_" 340 | 341 | 342 | 343 | -- SPAWN 344 | 345 | 346 | spawn : Platform.Router msg Event -> String -> MySub msg -> Task Never ( String, Process.Id ) 347 | spawn router key (MySub node name _) = 348 | let 349 | actualNode = 350 | case node of 351 | Document -> Elm.Kernel.Browser.doc 352 | Window -> Elm.Kernel.Browser.window 353 | in 354 | Task.map (\value -> ( key, value )) <| 355 | Elm.Kernel.Browser.on actualNode name <| 356 | \event -> Platform.sendToSelf router (Event key event) 357 | -------------------------------------------------------------------------------- /src/Browser/Navigation.elm: -------------------------------------------------------------------------------- 1 | module Browser.Navigation exposing 2 | ( Key, pushUrl, replaceUrl, back, forward 3 | , load, reload, reloadAndSkipCache 4 | ) 5 | 6 | {-| This module helps you manage the browser’s URL yourself. This is the 7 | crucial trick when using [`Browser.application`](Browser#application). 8 | 9 | The most important function is [`pushUrl`](#pushUrl) which changes the 10 | address bar _without_ starting a page load. 11 | 12 | 13 | ## What is a page load? 14 | 15 | 1. Request a new HTML document. The page goes blank. 16 | 2. As the HTML loads, request any `<script>` or `<link>` resources. 17 | 3. A `<script>` may mutate the document, so these tags block rendering. 18 | 4. When _all_ of the assets are loaded, actually render the page. 19 | 20 | That means the page will go blank for at least two round-trips to the servers! 21 | You may have 90% of the data you need and be blocked on a font that is taking 22 | a long time. Still blank! 23 | 24 | 25 | ## How does `pushUrl` help? 26 | 27 | The `pushUrl` function changes the URL, but lets you keep the current HTML. 28 | This means the page _never_ goes blank. Instead of making two round-trips to 29 | the server, you load whatever assets you want from within Elm. Maybe you do 30 | not need any round-trips! Meanwhile, you retain full control over the UI, so 31 | you can show a loading bar, show information as it loads, etc. Whatever you 32 | want! 33 | 34 | 35 | # Navigate within Page 36 | 37 | @docs Key, pushUrl, replaceUrl, back, forward 38 | 39 | 40 | # Navigate to other Pages 41 | 42 | @docs load, reload, reloadAndSkipCache 43 | 44 | -} 45 | 46 | import Elm.Kernel.Browser 47 | import Task exposing (Task) 48 | 49 | 50 | 51 | -- WITHIN PAGE 52 | 53 | 54 | {-| A navigation `Key` is needed to create navigation commands that change the 55 | URL. That includes [`pushUrl`](#pushUrl), [`replaceUrl`](#replaceUrl), 56 | [`back`](#back), and [`forward`](#forward). 57 | 58 | You only get access to a `Key` when you create your program with 59 | [`Browser.application`](Browser#application), guaranteeing that your program is 60 | equipped to detect these URL changes. If `Key` values were available in other 61 | kinds of programs, unsuspecting programmers would be sure to run into some 62 | [annoying bugs][bugs] and learn a bunch of techniques the hard way! 63 | 64 | [bugs]: https://github.com/elm/browser/blob/1.0.2/notes/navigation-in-elements.md 65 | 66 | -} 67 | type Key 68 | = Key 69 | 70 | 71 | {-| Change the URL, but do not trigger a page load. 72 | 73 | This will add a new entry to the browser history. 74 | 75 | Check out the [`elm/url`][url] package for help building URLs. The 76 | [`Url.Builder.absolute`][abs] and [`Url.Builder.relative`][rel] functions can 77 | be particularly handy! 78 | 79 | [url]: /packages/elm/url/latest 80 | [abs]: /packages/elm/url/latest/Url-Builder#absolute 81 | [rel]: /packages/elm/url/latest/Url-Builder#relative 82 | 83 | **Note:** If the user has gone `back` a few pages, there will be “future 84 | pages” that the user can go `forward` to. Adding a new URL in that 85 | scenario will clear out any future pages. It is like going back in time and 86 | making a different choice. 87 | 88 | -} 89 | pushUrl : Key -> String -> Cmd msg 90 | pushUrl = 91 | Elm.Kernel.Browser.pushUrl 92 | 93 | 94 | {-| Change the URL, but do not trigger a page load. 95 | 96 | This _will not_ add a new entry to the browser history. 97 | 98 | This can be useful if you have search box and you want the `?search=hats` in 99 | the URL to match without adding a history entry for every single key stroke. 100 | Imagine how annoying it would be to click `back` thirty times and still be on 101 | the same page! 102 | 103 | **Note:** Browsers may rate-limit this function by throwing an exception. The 104 | discussion [here](https://bugs.webkit.org/show_bug.cgi?id=156115) suggests 105 | that the limit is 100 calls per 30 second interval in Safari in 2016. It also 106 | suggests techniques for people changing the URL based on scroll position. 107 | 108 | -} 109 | replaceUrl : Key -> String -> Cmd msg 110 | replaceUrl = 111 | Elm.Kernel.Browser.replaceUrl 112 | 113 | 114 | {-| Go back some number of pages. So `back 1` goes back one page, and `back 2` 115 | goes back two pages. 116 | 117 | **Note:** You only manage the browser history that _you_ created. Think of this 118 | library as letting you have access to a small part of the overall history. So 119 | if you go back farther than the history you own, you will just go back to some 120 | other website! 121 | 122 | -} 123 | back : Key -> Int -> Cmd msg 124 | back key n = 125 | Elm.Kernel.Browser.go key -n 126 | 127 | 128 | {-| Go forward some number of pages. So `forward 1` goes forward one page, and 129 | `forward 2` goes forward two pages. If there are no more pages in the future, 130 | this will do nothing. 131 | 132 | **Note:** You only manage the browser history that _you_ created. Think of this 133 | library as letting you have access to a small part of the overall history. So 134 | if you go forward farther than the history you own, the user will end up on 135 | whatever website they visited next! 136 | 137 | -} 138 | forward : Key -> Int -> Cmd msg 139 | forward = 140 | Elm.Kernel.Browser.go 141 | 142 | 143 | 144 | -- EXTERNAL PAGES 145 | 146 | 147 | {-| Leave the current page and load the given URL. **This always results in a 148 | page load**, even if the provided URL is the same as the current one. 149 | 150 | gotoElmWebsite : Cmd msg 151 | gotoElmWebsite = 152 | load "https://elm-lang.org" 153 | 154 | Check out the [`elm/url`][url] package for help building URLs. The 155 | [`Url.absolute`][abs] and [`Url.relative`][rel] functions can be particularly 156 | handy! 157 | 158 | [url]: /packages/elm/url/latest 159 | [abs]: /packages/elm/url/latest/Url#absolute 160 | [rel]: /packages/elm/url/latest/Url#relative 161 | 162 | -} 163 | load : String -> Cmd msg 164 | load = 165 | Elm.Kernel.Browser.load 166 | 167 | 168 | {-| Reload the current page. **This always results in a page load!** 169 | This may grab resources from the browser cache, so use 170 | [`reloadAndSkipCache`](#reloadAndSkipCache) 171 | if you want to be sure that you are not loading any cached resources. 172 | -} 173 | reload : Cmd msg 174 | reload = 175 | Elm.Kernel.Browser.reload False 176 | 177 | 178 | {-| Reload the current page without using the browser cache. **This always 179 | results in a page load!** It is more common to want [`reload`](#reload). 180 | -} 181 | reloadAndSkipCache : Cmd msg 182 | reloadAndSkipCache = 183 | Elm.Kernel.Browser.reload True 184 | -------------------------------------------------------------------------------- /src/Debugger/Expando.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Expando exposing 2 | ( Expando 3 | , Msg 4 | , init 5 | , merge 6 | , update 7 | , view 8 | ) 9 | 10 | 11 | import Dict exposing (Dict) 12 | import Elm.Kernel.Debugger 13 | import Html exposing (Html, div, span, text) 14 | import Html.Attributes exposing (class, style) 15 | import Html.Events exposing (onClick) 16 | import Json.Decode as Json 17 | 18 | 19 | 20 | -- MODEL 21 | 22 | 23 | type Expando 24 | = S String 25 | | Primitive String 26 | | Sequence SeqType Bool (List Expando) 27 | | Dictionary Bool (List (Expando, Expando)) 28 | | Record Bool (Dict String Expando) 29 | | Constructor (Maybe String) Bool (List Expando) 30 | 31 | 32 | type SeqType 33 | = ListSeq 34 | | SetSeq 35 | | ArraySeq 36 | 37 | 38 | seqTypeToString : Int -> SeqType -> String 39 | seqTypeToString n seqType = 40 | case seqType of 41 | ListSeq -> 42 | "List(" ++ String.fromInt n ++ ")" 43 | 44 | SetSeq -> 45 | "Set(" ++ String.fromInt n ++ ")" 46 | 47 | ArraySeq -> 48 | "Array(" ++ String.fromInt n ++ ")" 49 | 50 | 51 | 52 | -- INITIALIZE 53 | 54 | 55 | init : a -> Expando 56 | init value = 57 | initHelp True (Elm.Kernel.Debugger.init value) 58 | 59 | 60 | initHelp : Bool -> Expando -> Expando 61 | initHelp isOuter expando = 62 | case expando of 63 | S _ -> 64 | expando 65 | 66 | Primitive _ -> 67 | expando 68 | 69 | Sequence seqType isClosed items -> 70 | if isOuter then 71 | Sequence seqType False (List.map (initHelp False) items) 72 | 73 | else if List.length items <= 8 then 74 | Sequence seqType False items 75 | 76 | else 77 | expando 78 | 79 | Dictionary isClosed keyValuePairs -> 80 | if isOuter then 81 | Dictionary False (List.map (\( k, v ) -> ( k, initHelp False v )) keyValuePairs) 82 | 83 | else if List.length keyValuePairs <= 8 then 84 | Dictionary False keyValuePairs 85 | 86 | else 87 | expando 88 | 89 | Record isClosed entries -> 90 | if isOuter then 91 | Record False (Dict.map (\_ v -> initHelp False v) entries) 92 | 93 | else if Dict.size entries <= 4 then 94 | Record False entries 95 | 96 | else 97 | expando 98 | 99 | Constructor maybeName isClosed args -> 100 | if isOuter then 101 | Constructor maybeName False (List.map (initHelp False) args) 102 | 103 | else if List.length args <= 4 then 104 | Constructor maybeName False args 105 | 106 | else 107 | expando 108 | 109 | 110 | 111 | -- PRESERVE OLD EXPANDO STATE (open/closed) 112 | 113 | 114 | merge : a -> Expando -> Expando 115 | merge value expando = 116 | mergeHelp expando (Elm.Kernel.Debugger.init value) 117 | 118 | 119 | mergeHelp : Expando -> Expando -> Expando 120 | mergeHelp old new = 121 | case (old, new) of 122 | (_, S _) -> 123 | new 124 | 125 | (_, Primitive _) -> 126 | new 127 | 128 | (Sequence _ isClosed oldValues, Sequence seqType _ newValues) -> 129 | Sequence seqType isClosed (mergeListHelp oldValues newValues) 130 | 131 | (Dictionary isClosed _, Dictionary _ keyValuePairs) -> 132 | Dictionary isClosed keyValuePairs 133 | 134 | (Record isClosed oldDict, Record _ newDict) -> 135 | Record isClosed <| Dict.map (mergeDictHelp oldDict) newDict 136 | 137 | (Constructor _ isClosed oldValues, Constructor maybeName _ newValues) -> 138 | Constructor maybeName isClosed (mergeListHelp oldValues newValues) 139 | 140 | _ -> 141 | new 142 | 143 | 144 | mergeListHelp : List Expando -> List Expando -> List Expando 145 | mergeListHelp olds news = 146 | case (olds, news) of 147 | ([], _) -> 148 | news 149 | 150 | (_, []) -> 151 | news 152 | 153 | (x :: xs, y :: ys) -> 154 | mergeHelp x y :: mergeListHelp xs ys 155 | 156 | 157 | mergeDictHelp : Dict String Expando -> String -> Expando -> Expando 158 | mergeDictHelp oldDict key value = 159 | case Dict.get key oldDict of 160 | Nothing -> 161 | value 162 | 163 | Just oldValue -> 164 | mergeHelp oldValue value 165 | 166 | 167 | 168 | -- UPDATE 169 | 170 | 171 | type Msg 172 | = Toggle 173 | | Index Redirect Int Msg 174 | | Field String Msg 175 | 176 | 177 | type Redirect 178 | = None 179 | | Key 180 | | Value 181 | 182 | 183 | update : Msg -> Expando -> Expando 184 | update msg value = 185 | case value of 186 | S _ -> 187 | -- Debug.crash "nothing changes a primitive" 188 | value 189 | 190 | Primitive _ -> 191 | -- Debug.crash "nothing changes a primitive" 192 | value 193 | 194 | Sequence seqType isClosed valueList -> 195 | case msg of 196 | Toggle -> 197 | Sequence seqType (not isClosed) valueList 198 | 199 | Index None index subMsg -> 200 | Sequence seqType isClosed <| updateIndex index (update subMsg) valueList 201 | 202 | Index _ _ _ -> 203 | -- Debug.crash "no redirected indexes on sequences" 204 | value 205 | 206 | Field _ _ -> 207 | -- Debug.crash "no field on sequences" 208 | value 209 | 210 | Dictionary isClosed keyValuePairs -> 211 | case msg of 212 | Toggle -> 213 | Dictionary (not isClosed) keyValuePairs 214 | 215 | Index redirect index subMsg -> 216 | case redirect of 217 | None -> 218 | -- Debug.crash "must have redirect for dictionaries" 219 | value 220 | 221 | Key -> 222 | Dictionary isClosed <| 223 | updateIndex index (\( k, v ) -> ( update subMsg k, v )) keyValuePairs 224 | 225 | Value -> 226 | Dictionary isClosed <| 227 | updateIndex index (\( k, v ) -> ( k, update subMsg v )) keyValuePairs 228 | 229 | Field _ _ -> 230 | -- Debug.crash "no field for dictionaries" 231 | value 232 | 233 | Record isClosed valueDict -> 234 | case msg of 235 | Toggle -> 236 | Record (not isClosed) valueDict 237 | 238 | Index _ _ _ -> 239 | -- Debug.crash "no index for records" 240 | value 241 | 242 | Field field subMsg -> 243 | Record isClosed (Dict.update field (updateField subMsg) valueDict) 244 | 245 | Constructor maybeName isClosed valueList -> 246 | case msg of 247 | Toggle -> 248 | Constructor maybeName (not isClosed) valueList 249 | 250 | Index None index subMsg -> 251 | Constructor maybeName isClosed <| 252 | updateIndex index (update subMsg) valueList 253 | 254 | Index _ _ _ -> 255 | -- Debug.crash "no redirected indexes on sequences" 256 | value 257 | 258 | Field _ _ -> 259 | -- Debug.crash "no field for constructors" 260 | value 261 | 262 | 263 | updateIndex : Int -> (a -> a) -> List a -> List a 264 | updateIndex n func list = 265 | case list of 266 | [] -> 267 | [] 268 | 269 | x :: xs -> 270 | if n <= 0 271 | then func x :: xs 272 | else x :: updateIndex (n - 1) func xs 273 | 274 | 275 | updateField : Msg -> Maybe Expando -> Maybe Expando 276 | updateField msg maybeExpando = 277 | case maybeExpando of 278 | Nothing -> 279 | -- Debug.crash "key does not exist" 280 | maybeExpando 281 | 282 | Just expando -> 283 | Just (update msg expando) 284 | 285 | 286 | 287 | -- VIEW 288 | 289 | 290 | view : Maybe String -> Expando -> Html Msg 291 | view maybeKey expando = 292 | case expando of 293 | S stringRep -> 294 | div (leftPad maybeKey) (lineStarter maybeKey Nothing [ span [ red ] [ text stringRep ] ]) 295 | 296 | Primitive stringRep -> 297 | div (leftPad maybeKey) (lineStarter maybeKey Nothing [ span [ blue ] [ text stringRep ] ]) 298 | 299 | Sequence seqType isClosed valueList -> 300 | viewSequence maybeKey seqType isClosed valueList 301 | 302 | Dictionary isClosed keyValuePairs -> 303 | viewDictionary maybeKey isClosed keyValuePairs 304 | 305 | Record isClosed valueDict -> 306 | viewRecord maybeKey isClosed valueDict 307 | 308 | Constructor maybeName isClosed valueList -> 309 | viewConstructor maybeKey maybeName isClosed valueList 310 | 311 | 312 | 313 | -- VIEW SEQUENCE 314 | 315 | 316 | viewSequence : Maybe String -> SeqType -> Bool -> List Expando -> Html Msg 317 | viewSequence maybeKey seqType isClosed valueList = 318 | let 319 | starter = seqTypeToString (List.length valueList) seqType 320 | in 321 | div (leftPad maybeKey) 322 | [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [ text starter ]) 323 | , if isClosed then text "" else viewSequenceOpen valueList 324 | ] 325 | 326 | 327 | viewSequenceOpen : List Expando -> Html Msg 328 | viewSequenceOpen values = 329 | div [] (List.indexedMap viewConstructorEntry values) 330 | 331 | 332 | 333 | -- VIEW DICTIONARY 334 | 335 | 336 | viewDictionary : Maybe String -> Bool -> List (Expando, Expando) -> Html Msg 337 | viewDictionary maybeKey isClosed keyValuePairs = 338 | let 339 | starter = "Dict(" ++ String.fromInt (List.length keyValuePairs) ++ ")" 340 | in 341 | div (leftPad maybeKey) 342 | [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [ text starter ]) 343 | , if isClosed then text "" else viewDictionaryOpen keyValuePairs 344 | ] 345 | 346 | 347 | viewDictionaryOpen : List (Expando, Expando) -> Html Msg 348 | viewDictionaryOpen keyValuePairs = 349 | div [] (List.indexedMap viewDictionaryEntry keyValuePairs) 350 | 351 | 352 | viewDictionaryEntry : Int -> (Expando, Expando) -> Html Msg 353 | viewDictionaryEntry index ( key, value ) = 354 | case key of 355 | S stringRep -> 356 | Html.map (Index Value index) (view (Just stringRep) value) 357 | 358 | Primitive stringRep -> 359 | Html.map (Index Value index) (view (Just stringRep) value) 360 | 361 | _ -> 362 | div [] 363 | [ Html.map (Index Key index) (view (Just "key") key) 364 | , Html.map (Index Value index) (view (Just "value") value) 365 | ] 366 | 367 | 368 | 369 | -- VIEW RECORD 370 | 371 | 372 | viewRecord : Maybe String -> Bool -> Dict String Expando -> Html Msg 373 | viewRecord maybeKey isClosed record = 374 | let 375 | (start, middle, end) = 376 | if isClosed then 377 | (Tuple.second (viewTinyRecord record), text "", text "") 378 | else 379 | ([ text "{" ], viewRecordOpen record, div (leftPad (Just ())) [ text "}" ]) 380 | in 381 | div (leftPad maybeKey) 382 | [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) start) 383 | , middle 384 | , end 385 | ] 386 | 387 | 388 | viewRecordOpen : Dict String Expando -> Html Msg 389 | viewRecordOpen record = 390 | div [] (List.map viewRecordEntry (Dict.toList record)) 391 | 392 | 393 | viewRecordEntry : ( String, Expando ) -> Html Msg 394 | viewRecordEntry ( field, value ) = 395 | Html.map (Field field) (view (Just field) value) 396 | 397 | 398 | 399 | -- VIEW CONSTRUCTOR 400 | 401 | 402 | viewConstructor : Maybe String -> Maybe String -> Bool -> List Expando -> Html Msg 403 | viewConstructor maybeKey maybeName isClosed valueList = 404 | let 405 | tinyArgs = List.map (Tuple.second << viewExtraTiny) valueList 406 | 407 | description = 408 | case (maybeName, tinyArgs) of 409 | (Nothing , [] ) -> [ text "()" ] 410 | (Nothing , x :: xs) -> text "( " :: span [] x :: List.foldr (\args rest -> text ", " :: span [] args :: rest) [ text " )" ] xs 411 | (Just name, [] ) -> [ text name ] 412 | (Just name, x :: xs) -> text (name ++ " ") :: span [] x :: List.foldr (\args rest -> text " " :: span [] args :: rest) [] xs 413 | 414 | (maybeIsClosed, openHtml) = 415 | case valueList of 416 | [] -> 417 | (Nothing, div [] []) 418 | 419 | [ entry ] -> 420 | case entry of 421 | S _ -> 422 | (Nothing, div [] []) 423 | 424 | Primitive _ -> 425 | (Nothing, div [] []) 426 | 427 | Sequence _ _ subValueList -> 428 | ( Just isClosed 429 | , if isClosed then div [] [] else 430 | Html.map (Index None 0) (viewSequenceOpen subValueList) 431 | ) 432 | 433 | Dictionary _ keyValuePairs -> 434 | ( Just isClosed 435 | , if isClosed then div [] [] else 436 | Html.map (Index None 0) (viewDictionaryOpen keyValuePairs) 437 | ) 438 | 439 | Record _ record -> 440 | ( Just isClosed 441 | , if isClosed then div [] [] else 442 | Html.map (Index None 0) (viewRecordOpen record) 443 | ) 444 | 445 | Constructor _ _ subValueList -> 446 | ( Just isClosed 447 | , if isClosed then div [] [] else 448 | Html.map (Index None 0) (viewConstructorOpen subValueList) 449 | ) 450 | 451 | _ -> 452 | ( Just isClosed 453 | , if isClosed then div [] [] else viewConstructorOpen valueList 454 | ) 455 | in 456 | div (leftPad maybeKey) 457 | [ div [ onClick Toggle ] (lineStarter maybeKey maybeIsClosed description) 458 | , openHtml 459 | ] 460 | 461 | 462 | viewConstructorOpen : List Expando -> Html Msg 463 | viewConstructorOpen valueList = 464 | div [] (List.indexedMap viewConstructorEntry valueList) 465 | 466 | 467 | viewConstructorEntry : Int -> Expando -> Html Msg 468 | viewConstructorEntry index value = 469 | Html.map (Index None index) (view (Just (String.fromInt index)) value) 470 | 471 | 472 | 473 | -- VIEW TINY 474 | 475 | 476 | viewTiny : Expando -> ( Int, List (Html msg) ) 477 | viewTiny value = 478 | case value of 479 | S stringRep -> 480 | let 481 | str = elideMiddle stringRep 482 | in 483 | ( String.length str 484 | , [ span [ red ] [ text str ] ] 485 | ) 486 | 487 | Primitive stringRep -> 488 | ( String.length stringRep 489 | , [ span [ blue ] [ text stringRep ] ] 490 | ) 491 | 492 | Sequence seqType _ valueList -> 493 | viewTinyHelp <| seqTypeToString (List.length valueList) seqType 494 | 495 | Dictionary _ keyValuePairs -> 496 | viewTinyHelp <| "Dict(" ++ String.fromInt (List.length keyValuePairs) ++ ")" 497 | 498 | Record _ record -> 499 | viewTinyRecord record 500 | 501 | Constructor maybeName _ [] -> 502 | viewTinyHelp <| Maybe.withDefault "Unit" maybeName 503 | 504 | Constructor maybeName _ valueList -> 505 | viewTinyHelp <| 506 | case maybeName of 507 | Nothing -> "Tuple(" ++ String.fromInt (List.length valueList) ++ ")" 508 | Just name -> name ++ " …" 509 | 510 | 511 | viewTinyHelp : String -> ( Int, List (Html msg) ) 512 | viewTinyHelp str = 513 | (String.length str, [ text str ]) 514 | 515 | 516 | elideMiddle : String -> String 517 | elideMiddle str = 518 | if String.length str <= 18 519 | then str 520 | else String.left 8 str ++ "..." ++ String.right 8 str 521 | 522 | 523 | 524 | -- VIEW TINY RECORDS 525 | 526 | 527 | viewTinyRecord : Dict String Expando -> ( Int, List (Html msg) ) 528 | viewTinyRecord record = 529 | if Dict.isEmpty record then 530 | (2, [ text "{}" ]) 531 | else 532 | viewTinyRecordHelp 0 "{ " (Dict.toList record) 533 | 534 | 535 | viewTinyRecordHelp : Int -> String -> List ( String, Expando ) -> ( Int, List (Html msg) ) 536 | viewTinyRecordHelp length starter entries = 537 | case entries of 538 | [] -> 539 | (length + 2, [ text " }" ]) 540 | 541 | (field, value) :: rest -> 542 | let 543 | fieldLen = String.length field 544 | (valueLen, valueHtmls) = viewExtraTiny value 545 | newLength = length + fieldLen + valueLen + 5 546 | in 547 | if newLength > 60 then 548 | (length + 4, [ text ", … }" ]) 549 | else 550 | let 551 | (finalLength, otherHtmls) = viewTinyRecordHelp newLength ", " rest 552 | in 553 | ( finalLength 554 | , text starter 555 | :: span [ purple ] [ text field ] 556 | :: text " = " 557 | :: span [] valueHtmls 558 | :: otherHtmls 559 | ) 560 | 561 | 562 | viewExtraTiny : Expando -> ( Int, List (Html msg) ) 563 | viewExtraTiny value = 564 | case value of 565 | Record _ record -> 566 | viewExtraTinyRecord 0 "{" (Dict.keys record) 567 | 568 | _ -> 569 | viewTiny value 570 | 571 | 572 | viewExtraTinyRecord : Int -> String -> List String -> ( Int, List (Html msg) ) 573 | viewExtraTinyRecord length starter entries = 574 | case entries of 575 | [] -> 576 | (length + 1, [ text "}" ]) 577 | 578 | field :: rest -> 579 | let 580 | nextLength = length + String.length field + 1 581 | in 582 | if nextLength > 18 then 583 | (length + 2, [ text "…}" ]) 584 | 585 | else 586 | let 587 | (finalLength, otherHtmls) = viewExtraTinyRecord nextLength "," rest 588 | in 589 | ( finalLength 590 | , text starter :: span [ purple ] [ text field ] :: otherHtmls 591 | ) 592 | 593 | 594 | 595 | -- VIEW HELPERS 596 | 597 | 598 | lineStarter : Maybe String -> Maybe Bool -> List (Html msg) -> List (Html msg) 599 | lineStarter maybeKey maybeIsClosed description = 600 | let 601 | arrow = 602 | case maybeIsClosed of 603 | Nothing -> makeArrow "" 604 | Just True -> makeArrow "▸" 605 | Just False -> makeArrow "▾" 606 | in 607 | case maybeKey of 608 | Nothing -> 609 | arrow :: description 610 | 611 | Just key -> 612 | arrow :: span [ purple ] [ text key ] :: text " = " :: description 613 | 614 | 615 | makeArrow : String -> Html msg 616 | makeArrow arrow = 617 | span 618 | [ style "color" "#777" 619 | , style "padding-left" "2ch" 620 | , style "width" "2ch" 621 | , style "display" "inline-block" 622 | ] 623 | [ text arrow ] 624 | 625 | 626 | leftPad : Maybe a -> List (Html.Attribute msg) 627 | leftPad maybeKey = 628 | case maybeKey of 629 | Nothing -> [] 630 | Just _ -> [ style "padding-left" "4ch" ] 631 | 632 | 633 | red : Html.Attribute msg 634 | red = 635 | style "color" "rgb(196, 26, 22)" 636 | 637 | 638 | blue : Html.Attribute msg 639 | blue = 640 | style "color" "rgb(28, 0, 207)" 641 | 642 | 643 | purple : Html.Attribute msg 644 | purple = 645 | style "color" "rgb(136, 19, 145)" 646 | -------------------------------------------------------------------------------- /src/Debugger/History.elm: -------------------------------------------------------------------------------- 1 | module Debugger.History exposing 2 | ( History 3 | , add 4 | , decoder 5 | , empty 6 | , encode 7 | , get 8 | , getInitialModel 9 | , getRecentMsg 10 | , idForMessageIndex 11 | , size 12 | , view 13 | ) 14 | 15 | import Array exposing (Array) 16 | import Debugger.Expando as Expando exposing (Expando) 17 | import Debugger.Metadata as Metadata 18 | import Elm.Kernel.Debugger 19 | import Html exposing (..) 20 | import Html.Attributes exposing (..) 21 | import Html.Events exposing (onClick) 22 | import Html.Keyed 23 | import Html.Lazy exposing (..) 24 | import Json.Decode as Decode 25 | import Json.Encode as Encode 26 | import Set exposing (Set) 27 | 28 | 29 | 30 | -- CONSTANTS 31 | 32 | 33 | maxSnapshotSize : Int 34 | maxSnapshotSize = 35 | -- NOTE: While the app is running we display (maxSnapshotSize * 2) messages 36 | -- in the message panel. We want to keep this number relatively low to reduce 37 | -- the number of DOM nodes the browser have to deal with. However, we want 38 | -- this number to be high to retain as few model snapshots as possible to 39 | -- reduce memory usage. 40 | -- 41 | -- 31 is selected because 62 messages fills up the height of a 27 inch monitor, 42 | -- with the current style, while avoiding a tree representation in Elm arrays. 43 | -- 44 | -- Performance and memory use seems good. 45 | 31 46 | 47 | 48 | 49 | -- HISTORY 50 | 51 | 52 | type alias History model msg = 53 | { snapshots : Array (Snapshot model msg) 54 | , recent : RecentHistory model msg 55 | , numMessages : Int 56 | } 57 | 58 | 59 | type alias RecentHistory model msg = 60 | { model : model 61 | , messages : List msg 62 | , numMessages : Int 63 | } 64 | 65 | 66 | type alias Snapshot model msg = 67 | { model : model 68 | , messages : Array msg 69 | } 70 | 71 | 72 | empty : model -> History model msg 73 | empty model = 74 | History Array.empty (RecentHistory model [] 0) 0 75 | 76 | 77 | size : History model msg -> Int 78 | size history = 79 | history.numMessages 80 | 81 | 82 | getInitialModel : History model msg -> model 83 | getInitialModel { snapshots, recent } = 84 | case Array.get 0 snapshots of 85 | Just { model } -> 86 | model 87 | 88 | Nothing -> 89 | recent.model 90 | 91 | 92 | 93 | -- JSON 94 | 95 | 96 | decoder : model -> (msg -> model -> model) -> Decode.Decoder ( model, History model msg ) 97 | decoder initialModel update = 98 | let 99 | addMessage rawMsg ( model, history ) = 100 | let 101 | msg = 102 | jsToElm rawMsg 103 | in 104 | ( update msg model, add msg model history ) 105 | 106 | updateModel rawMsgs = 107 | List.foldl addMessage ( initialModel, empty initialModel ) rawMsgs 108 | in 109 | Decode.map updateModel (Decode.list Decode.value) 110 | 111 | 112 | jsToElm : Encode.Value -> a 113 | jsToElm = 114 | Elm.Kernel.Json.unwrap 115 | >> Elm.Kernel.Debugger.unsafeCoerce 116 | 117 | 118 | encode : History model msg -> Encode.Value 119 | encode { snapshots, recent } = 120 | Encode.list elmToJs <| Array.foldr encodeHelp (List.reverse recent.messages) snapshots 121 | 122 | 123 | encodeHelp : Snapshot model msg -> List msg -> List msg 124 | encodeHelp snapshot allMessages = 125 | Array.foldl (::) allMessages snapshot.messages 126 | 127 | 128 | elmToJs : a -> Encode.Value 129 | elmToJs = 130 | Elm.Kernel.Json.wrap 131 | >> Elm.Kernel.Debugger.unsafeCoerce 132 | 133 | 134 | 135 | -- ADD MESSAGES 136 | 137 | 138 | add : msg -> model -> History model msg -> History model msg 139 | add msg model { snapshots, recent, numMessages } = 140 | case addRecent msg model recent of 141 | ( Just snapshot, newRecent ) -> 142 | History (Array.push snapshot snapshots) newRecent (numMessages + 1) 143 | 144 | ( Nothing, newRecent ) -> 145 | History snapshots newRecent (numMessages + 1) 146 | 147 | 148 | addRecent : 149 | msg 150 | -> model 151 | -> RecentHistory model msg 152 | -> ( Maybe (Snapshot model msg), RecentHistory model msg ) 153 | addRecent msg newModel { model, messages, numMessages } = 154 | if numMessages == maxSnapshotSize then 155 | ( Just (Snapshot model (Array.fromList messages)) 156 | , RecentHistory newModel [ msg ] 1 157 | ) 158 | 159 | else 160 | ( Nothing 161 | , RecentHistory model (msg :: messages) (numMessages + 1) 162 | ) 163 | 164 | 165 | 166 | -- GET SUMMARY 167 | 168 | 169 | get : (msg -> model -> ( model, a )) -> Int -> History model msg -> ( model, msg ) 170 | get update index history = 171 | let 172 | recent = 173 | history.recent 174 | 175 | snapshotMax = 176 | history.numMessages - recent.numMessages 177 | in 178 | if index >= snapshotMax then 179 | undone <| 180 | List.foldr (getHelp update) (Stepping (index - snapshotMax) recent.model) recent.messages 181 | 182 | else 183 | case Array.get (index // maxSnapshotSize) history.snapshots of 184 | Nothing -> 185 | -- Debug.crash "UI should only let you ask for real indexes!" 186 | get update index history 187 | 188 | Just { model, messages } -> 189 | undone <| 190 | Array.foldr (getHelp update) (Stepping (remainderBy maxSnapshotSize index) model) messages 191 | 192 | 193 | getRecentMsg : History model msg -> msg 194 | getRecentMsg history = 195 | case history.recent.messages of 196 | [] -> 197 | -- Debug.crash "Cannot provide most recent message!" 198 | getRecentMsg history 199 | 200 | first :: _ -> 201 | first 202 | 203 | 204 | type GetResult model msg 205 | = Stepping Int model 206 | | Done msg model 207 | 208 | 209 | getHelp : (msg -> model -> ( model, a )) -> msg -> GetResult model msg -> GetResult model msg 210 | getHelp update msg getResult = 211 | case getResult of 212 | Done _ _ -> 213 | getResult 214 | 215 | Stepping n model -> 216 | if n == 0 then 217 | Done msg (Tuple.first (update msg model)) 218 | 219 | else 220 | Stepping (n - 1) (Tuple.first (update msg model)) 221 | 222 | 223 | undone : GetResult model msg -> ( model, msg ) 224 | undone getResult = 225 | case getResult of 226 | Done msg model -> 227 | ( model, msg ) 228 | 229 | Stepping _ _ -> 230 | -- Debug.crash "Bug in History.get" 231 | undone getResult 232 | 233 | 234 | 235 | -- VIEW 236 | 237 | 238 | view : Maybe Int -> History model msg -> Html Int 239 | view maybeIndex { snapshots, recent, numMessages } = 240 | let 241 | index = Maybe.withDefault -1 maybeIndex 242 | 243 | onlyRenderRecentMessages = 244 | index /= -1 || Array.length snapshots < 2 245 | 246 | oldStuff = 247 | if onlyRenderRecentMessages then 248 | lazy3 viewAllSnapshots index 0 snapshots 249 | 250 | else 251 | lazy3 viewRecentSnapshots index recent.numMessages snapshots 252 | 253 | recentMessageStartIndex = 254 | numMessages - recent.numMessages 255 | 256 | newStuff = 257 | recent.messages 258 | |> List.foldr (consMsg index) ( recentMessageStartIndex, [] ) 259 | |> Tuple.second 260 | |> Html.Keyed.node "div" [] 261 | in 262 | div 263 | [ id "elm-debugger-sidebar" 264 | , style "width" "100%" 265 | , style "overflow-y" "auto" 266 | , style "height" "calc(100% - 72px)" 267 | ] 268 | (styles 269 | :: newStuff 270 | :: oldStuff 271 | :: (if onlyRenderRecentMessages then 272 | [] 273 | 274 | else 275 | [ showMoreButton numMessages ] 276 | ) 277 | ) 278 | 279 | 280 | 281 | -- VIEW SNAPSHOTS 282 | 283 | 284 | viewAllSnapshots : Int -> Int -> Array (Snapshot model msg) -> Html Int 285 | viewAllSnapshots selectedIndex startIndex snapshots = 286 | div [] <| 287 | Tuple.second <| 288 | Array.foldl (consSnapshot selectedIndex) ( startIndex, [] ) snapshots 289 | 290 | 291 | viewRecentSnapshots : Int -> Int -> Array (Snapshot model msg) -> Html Int 292 | viewRecentSnapshots selectedIndex recentMessagesNum snapshots = 293 | let 294 | arrayLength = 295 | Array.length snapshots 296 | 297 | messagesToFill = 298 | maxSnapshotSize - recentMessagesNum 299 | 300 | startingIndex = 301 | (arrayLength * maxSnapshotSize) - maxSnapshotSize - messagesToFill 302 | 303 | snapshotsToRender = 304 | case ( Array.get (arrayLength - 2) snapshots, Array.get (arrayLength - 1) snapshots ) of 305 | ( Just fillerSnapshot, Just recentSnapshot ) -> 306 | Array.fromList 307 | [ { model = fillerSnapshot.model 308 | , messages = Array.slice 0 messagesToFill fillerSnapshot.messages 309 | } 310 | , recentSnapshot 311 | ] 312 | 313 | _ -> 314 | snapshots 315 | in 316 | viewAllSnapshots selectedIndex startingIndex snapshotsToRender 317 | 318 | 319 | consSnapshot : Int -> Snapshot model msg -> ( Int, List (Html Int) ) -> ( Int, List (Html Int) ) 320 | consSnapshot selectedIndex snapshot ( index, rest ) = 321 | let 322 | nextIndex = 323 | index + Array.length snapshot.messages 324 | 325 | selectedIndexHelp = 326 | if nextIndex > selectedIndex && selectedIndex >= index then 327 | selectedIndex 328 | 329 | else 330 | -1 331 | in 332 | ( nextIndex 333 | , lazy3 viewSnapshot selectedIndexHelp index snapshot :: rest 334 | ) 335 | 336 | 337 | viewSnapshot : Int -> Int -> Snapshot model msg -> Html Int 338 | viewSnapshot selectedIndex index { messages } = 339 | Html.Keyed.node "div" [] <| 340 | Tuple.second <| 341 | Array.foldr (consMsg selectedIndex) ( index, [] ) messages 342 | 343 | 344 | 345 | -- VIEW MESSAGE 346 | 347 | 348 | consMsg : Int -> msg -> ( Int, List ( String, Html Int ) ) -> ( Int, List ( String, Html Int ) ) 349 | consMsg currentIndex msg ( index, rest ) = 350 | ( index + 1 351 | , ( String.fromInt index, lazy3 viewMessage currentIndex index msg ) :: rest 352 | ) 353 | 354 | 355 | viewMessage : Int -> Int -> msg -> Html Int 356 | viewMessage currentIndex index msg = 357 | let 358 | className = 359 | if currentIndex == index then 360 | "elm-debugger-entry elm-debugger-entry-selected" 361 | 362 | else 363 | "elm-debugger-entry" 364 | 365 | messageName = 366 | Elm.Kernel.Debugger.messageToString msg 367 | in 368 | div 369 | [ id (idForMessageIndex index) 370 | , class className 371 | , onClick index 372 | ] 373 | [ span 374 | [ title messageName 375 | , class "elm-debugger-entry-content" 376 | ] 377 | [ text messageName 378 | ] 379 | , span 380 | [ class "elm-debugger-entry-index" 381 | ] 382 | [ text (String.fromInt index) 383 | ] 384 | ] 385 | 386 | 387 | showMoreButton : Int -> Html Int 388 | showMoreButton numMessages = 389 | let 390 | labelText = 391 | "View more messages" 392 | 393 | nextIndex = 394 | numMessages - 1 - maxSnapshotSize * 2 395 | in 396 | div 397 | [ class "elm-debugger-entry" 398 | , onClick nextIndex 399 | ] 400 | [ span 401 | [ title labelText 402 | , class "elm-debugger-entry-content" 403 | ] 404 | [ text labelText 405 | ] 406 | , span 407 | [ class "elm-debugger-entry-index" 408 | ] 409 | [] 410 | ] 411 | 412 | 413 | idForMessageIndex : Int -> String 414 | idForMessageIndex index = 415 | "msg-" ++ String.fromInt index 416 | 417 | 418 | 419 | -- STYLES 420 | 421 | 422 | styles : Html msg 423 | styles = 424 | Html.node "style" [] [ text """ 425 | 426 | .elm-debugger-entry { 427 | cursor: pointer; 428 | width: 100%; 429 | box-sizing: border-box; 430 | padding: 8px; 431 | } 432 | 433 | .elm-debugger-entry:hover { 434 | background-color: rgb(41, 41, 41); 435 | } 436 | 437 | .elm-debugger-entry-selected, .elm-debugger-entry-selected:hover { 438 | background-color: rgb(10, 10, 10); 439 | } 440 | 441 | .elm-debugger-entry-content { 442 | width: calc(100% - 40px); 443 | padding: 0 5px; 444 | box-sizing: border-box; 445 | text-overflow: ellipsis; 446 | white-space: nowrap; 447 | overflow: hidden; 448 | display: inline-block; 449 | } 450 | 451 | .elm-debugger-entry-index { 452 | color: #666; 453 | width: 40px; 454 | text-align: right; 455 | display: block; 456 | float: right; 457 | } 458 | 459 | """ ] 460 | -------------------------------------------------------------------------------- /src/Debugger/Main.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Main exposing 2 | ( cornerView 3 | , getUserModel 4 | , initialWindowHeight 5 | , initialWindowWidth 6 | , popoutView 7 | , wrapInit 8 | , wrapSubs 9 | , wrapUpdate 10 | ) 11 | 12 | 13 | import Bitwise 14 | import Debugger.Expando as Expando exposing (Expando) 15 | import Debugger.History as History exposing (History) 16 | import Debugger.Metadata as Metadata exposing (Metadata) 17 | import Debugger.Overlay as Overlay 18 | import Debugger.Report as Report 19 | import Dict exposing (Dict) 20 | import Elm.Kernel.Debugger 21 | import Html exposing (..) 22 | import Html.Attributes as A exposing (..) 23 | import Html.Events exposing (on, onClick, onInput, onMouseDown, onMouseUp) 24 | import Html.Lazy exposing (lazy) 25 | import Json.Decode as Decode exposing (Decoder) 26 | import Json.Encode as Encode 27 | import Task exposing (Task) 28 | import VirtualDom as V 29 | 30 | 31 | 32 | -- CONSTANTS 33 | 34 | 35 | minimumPanelSize : Int 36 | minimumPanelSize = 37 | 150 38 | 39 | 40 | initialWindowWidth : Int 41 | initialWindowWidth = 42 | 900 43 | 44 | 45 | initialWindowHeight : Int 46 | initialWindowHeight = 47 | 420 48 | 49 | 50 | 51 | -- SUBSCRIPTIONS 52 | 53 | 54 | wrapSubs : (model -> Sub msg) -> Model model msg -> Sub (Msg msg) 55 | wrapSubs subscriptions model = 56 | Sub.map UserMsg (subscriptions (getLatestModel model.state)) 57 | 58 | 59 | 60 | -- MODEL 61 | 62 | 63 | type alias Model model msg = 64 | { history : History model msg 65 | , state : State model msg 66 | , expandoModel : Expando 67 | , expandoMsg : Expando 68 | , metadata : Result Metadata.Error Metadata 69 | , overlay : Overlay.State 70 | , popout : Popout 71 | , layout : Layout 72 | } 73 | 74 | 75 | type Popout 76 | = Popout Popout 77 | 78 | 79 | type Layout 80 | = Vertical DragStatus Float Float 81 | | Horizontal DragStatus Float Float 82 | 83 | 84 | type DragStatus 85 | = Static 86 | | Moving 87 | 88 | 89 | getUserModel : Model model msg -> model 90 | getUserModel model = 91 | getCurrentModel model.state 92 | 93 | 94 | 95 | -- STATE 96 | 97 | 98 | type State model msg 99 | = Running model 100 | | Paused Int model model msg (History model msg) 101 | 102 | 103 | getLatestModel : State model msg -> model 104 | getLatestModel state = 105 | case state of 106 | Running model -> 107 | model 108 | 109 | Paused _ _ model _ _ -> 110 | model 111 | 112 | 113 | getCurrentModel : State model msg -> model 114 | getCurrentModel state = 115 | case state of 116 | Running model -> 117 | model 118 | 119 | Paused _ model _ _ _ -> 120 | model 121 | 122 | 123 | isPaused : State model msg -> Bool 124 | isPaused state = 125 | case state of 126 | Running _ -> 127 | False 128 | 129 | Paused _ _ _ _ _ -> 130 | True 131 | 132 | 133 | cachedHistory : Model model msg -> History model msg 134 | cachedHistory model = 135 | case model.state of 136 | Running _ -> 137 | model.history 138 | 139 | Paused _ _ _ _ history -> 140 | history 141 | 142 | 143 | 144 | -- INIT 145 | 146 | 147 | wrapInit : Encode.Value -> Popout -> (flags -> ( model, Cmd msg )) -> flags -> ( Model model msg, Cmd (Msg msg) ) 148 | wrapInit metadata popout init flags = 149 | let 150 | (userModel, userCommands) = init flags 151 | in 152 | ( { history = History.empty userModel 153 | , state = Running userModel 154 | , expandoModel = Expando.init userModel 155 | , expandoMsg = Expando.init () 156 | , metadata = Metadata.decode metadata 157 | , overlay = Overlay.none 158 | , popout = popout 159 | , layout = Horizontal Static 0.3 0.5 160 | } 161 | , Cmd.map UserMsg userCommands 162 | ) 163 | 164 | 165 | 166 | -- UPDATE 167 | 168 | 169 | type Msg msg 170 | = NoOp 171 | | UserMsg msg 172 | | TweakExpandoMsg Expando.Msg 173 | | TweakExpandoModel Expando.Msg 174 | | Resume 175 | | Jump Int 176 | | SliderJump Int 177 | | Open 178 | | Up 179 | | Down 180 | | Import 181 | | Export 182 | | Upload String 183 | | OverlayMsg Overlay.Msg 184 | -- 185 | | SwapLayout 186 | | DragStart 187 | | Drag DragInfo 188 | | DragEnd 189 | 190 | 191 | type alias UserUpdate model msg = 192 | msg -> model -> ( model, Cmd msg ) 193 | 194 | 195 | wrapUpdate : UserUpdate model msg -> Msg msg -> Model model msg -> ( Model model msg, Cmd (Msg msg) ) 196 | wrapUpdate update msg model = 197 | case msg of 198 | NoOp -> 199 | ( model, Cmd.none ) 200 | 201 | UserMsg userMsg -> 202 | let 203 | userModel = getLatestModel model.state 204 | newHistory = History.add userMsg userModel model.history 205 | ( newUserModel, userCmds ) = update userMsg userModel 206 | commands = Cmd.map UserMsg userCmds 207 | in 208 | case model.state of 209 | Running _ -> 210 | ( { model 211 | | history = newHistory 212 | , state = Running newUserModel 213 | , expandoModel = Expando.merge newUserModel model.expandoModel 214 | , expandoMsg = Expando.merge userMsg model.expandoMsg 215 | } 216 | , Cmd.batch [ commands, scroll model.popout ] 217 | ) 218 | 219 | Paused index indexModel _ _ history -> 220 | ( { model 221 | | history = newHistory 222 | , state = Paused index indexModel newUserModel userMsg history 223 | } 224 | , commands 225 | ) 226 | 227 | TweakExpandoMsg eMsg -> 228 | ( { model | expandoMsg = Expando.update eMsg model.expandoMsg } 229 | , Cmd.none 230 | ) 231 | 232 | TweakExpandoModel eMsg -> 233 | ( { model | expandoModel = Expando.update eMsg model.expandoModel } 234 | , Cmd.none 235 | ) 236 | 237 | Resume -> 238 | case model.state of 239 | Running _ -> 240 | ( model, Cmd.none ) 241 | 242 | Paused _ _ userModel userMsg _ -> 243 | ( { model 244 | | state = Running userModel 245 | , expandoMsg = Expando.merge userMsg model.expandoMsg 246 | , expandoModel = Expando.merge userModel model.expandoModel 247 | } 248 | , scroll model.popout 249 | ) 250 | 251 | Jump index -> 252 | ( jumpUpdate update index model 253 | , Cmd.none 254 | ) 255 | 256 | SliderJump index -> 257 | ( jumpUpdate update index model 258 | , scrollTo (History.idForMessageIndex index) model.popout 259 | ) 260 | 261 | Open -> 262 | ( model 263 | , Task.perform (always NoOp) (Elm.Kernel.Debugger.open model.popout) 264 | ) 265 | 266 | Up -> 267 | case model.state of 268 | Running _ -> 269 | ( model, Cmd.none ) 270 | 271 | Paused i _ _ _ history -> 272 | let 273 | targetIndex = i + 1 274 | in 275 | if targetIndex < History.size history then 276 | wrapUpdate update (SliderJump targetIndex) model 277 | else 278 | wrapUpdate update Resume model 279 | 280 | Down -> 281 | case model.state of 282 | Running _ -> 283 | wrapUpdate update (Jump (History.size model.history - 1)) model 284 | 285 | Paused index _ _ _ _ -> 286 | if index > 0 then 287 | wrapUpdate update (SliderJump (index - 1)) model 288 | else 289 | ( model, Cmd.none ) 290 | 291 | Import -> 292 | withGoodMetadata model <| 293 | \_ -> ( model, upload model.popout ) 294 | 295 | Export -> 296 | withGoodMetadata model <| 297 | \metadata -> ( model, download metadata model.history ) 298 | 299 | Upload jsonString -> 300 | withGoodMetadata model <| 301 | \metadata -> 302 | case Overlay.assessImport metadata jsonString of 303 | Err newOverlay -> 304 | ( { model | overlay = newOverlay }, Cmd.none ) 305 | 306 | Ok rawHistory -> 307 | loadNewHistory rawHistory update model 308 | 309 | OverlayMsg overlayMsg -> 310 | case Overlay.close overlayMsg model.overlay of 311 | Nothing -> 312 | ( { model | overlay = Overlay.none }, Cmd.none ) 313 | 314 | Just rawHistory -> 315 | loadNewHistory rawHistory update model 316 | 317 | SwapLayout -> 318 | ( { model | layout = swapLayout model.layout }, Cmd.none ) 319 | 320 | DragStart -> 321 | ( { model | layout = setDragStatus Moving model.layout }, Cmd.none ) 322 | 323 | Drag info -> 324 | ( { model | layout = drag info model.layout }, Cmd.none ) 325 | 326 | DragEnd -> 327 | ( { model | layout = setDragStatus Static model.layout }, Cmd.none ) 328 | 329 | 330 | jumpUpdate : UserUpdate model msg -> Int -> Model model msg -> Model model msg 331 | jumpUpdate update index model = 332 | let 333 | history = 334 | cachedHistory model 335 | 336 | currentMsg = 337 | History.getRecentMsg history 338 | 339 | currentModel = 340 | getLatestModel model.state 341 | 342 | ( indexModel, indexMsg ) = 343 | History.get update index history 344 | in 345 | { model 346 | | state = Paused index indexModel currentModel currentMsg history 347 | , expandoModel = Expando.merge indexModel model.expandoModel 348 | , expandoMsg = Expando.merge indexMsg model.expandoMsg 349 | } 350 | 351 | 352 | 353 | -- LAYOUT HELPERS 354 | 355 | 356 | swapLayout : Layout -> Layout 357 | swapLayout layout = 358 | case layout of 359 | Horizontal s x y -> Vertical s x y 360 | Vertical s x y -> Horizontal s x y 361 | 362 | 363 | setDragStatus : DragStatus -> Layout -> Layout 364 | setDragStatus status layout = 365 | case layout of 366 | Horizontal _ x y -> Horizontal status x y 367 | Vertical _ x y -> Vertical status x y 368 | 369 | 370 | drag : DragInfo -> Layout -> Layout 371 | drag info layout = 372 | case layout of 373 | Horizontal status _ y -> 374 | Horizontal status (info.x / info.width) y 375 | 376 | Vertical status x _ -> 377 | Vertical status x (info.y / info.height) 378 | 379 | 380 | 381 | -- COMMANDS 382 | 383 | 384 | scroll : Popout -> Cmd (Msg msg) 385 | scroll popout = 386 | Task.perform (always NoOp) (Elm.Kernel.Debugger.scroll popout) 387 | 388 | 389 | scrollTo : String -> Popout -> Cmd (Msg msg) 390 | scrollTo id popout = 391 | Task.perform (always NoOp) (Elm.Kernel.Debugger.scrollTo id popout) 392 | 393 | 394 | upload : Popout -> Cmd (Msg msg) 395 | upload popout = 396 | Task.perform Upload (Elm.Kernel.Debugger.upload popout) 397 | 398 | 399 | download : Metadata -> History model msg -> Cmd (Msg msg) 400 | download metadata history = 401 | let 402 | historyLength = History.size history 403 | in 404 | Task.perform (\_ -> NoOp) <| Elm.Kernel.Debugger.download historyLength <| 405 | Elm.Kernel.Json.unwrap <| 406 | Encode.object 407 | [ ( "metadata", Metadata.encode metadata ) 408 | , ( "history", History.encode history ) 409 | ] 410 | 411 | 412 | 413 | -- UPDATE OVERLAY 414 | 415 | 416 | withGoodMetadata : 417 | Model model msg 418 | -> (Metadata -> ( Model model msg, Cmd (Msg msg) )) 419 | -> ( Model model msg, Cmd (Msg msg) ) 420 | withGoodMetadata model func = 421 | case model.metadata of 422 | Ok metadata -> 423 | func metadata 424 | 425 | Err error -> 426 | ( { model | overlay = Overlay.badMetadata error } 427 | , Cmd.none 428 | ) 429 | 430 | 431 | loadNewHistory : Encode.Value -> UserUpdate model msg -> Model model msg -> ( Model model msg, Cmd (Msg msg) ) 432 | loadNewHistory rawHistory update model = 433 | let 434 | initialUserModel = 435 | History.getInitialModel model.history 436 | 437 | pureUserUpdate msg userModel = 438 | Tuple.first (update msg userModel) 439 | 440 | decoder = 441 | History.decoder initialUserModel pureUserUpdate 442 | in 443 | case Decode.decodeValue decoder rawHistory of 444 | Err _ -> 445 | ( { model | overlay = Overlay.corruptImport } 446 | , Cmd.none 447 | ) 448 | 449 | Ok ( latestUserModel, newHistory ) -> 450 | ( { model 451 | | history = newHistory 452 | , state = Running latestUserModel 453 | , expandoModel = Expando.init latestUserModel 454 | , expandoMsg = Expando.init (History.getRecentMsg newHistory) 455 | , overlay = Overlay.none 456 | } 457 | , Cmd.none 458 | ) 459 | 460 | 461 | 462 | -- CORNER VIEW 463 | 464 | 465 | cornerView : Model model msg -> Html (Msg msg) 466 | cornerView model = 467 | Overlay.view 468 | { resume = Resume 469 | , open = Open 470 | , importHistory = Import 471 | , exportHistory = Export 472 | , wrap = OverlayMsg 473 | } 474 | (isPaused model.state) 475 | (Elm.Kernel.Debugger.isOpen model.popout) 476 | (History.size model.history) 477 | model.overlay 478 | 479 | 480 | toBlockerType : Model model msg -> Overlay.BlockerType 481 | toBlockerType model = 482 | Overlay.toBlockerType (isPaused model.state) model.overlay 483 | 484 | 485 | 486 | -- BIG DEBUG VIEW 487 | 488 | 489 | popoutView : Model model msg -> Html (Msg msg) 490 | popoutView model = 491 | let 492 | maybeIndex = 493 | case model.state of 494 | Running _ -> Nothing 495 | Paused index _ _ _ _ -> Just index 496 | 497 | historyToRender = cachedHistory model 498 | in 499 | node "body" 500 | ( 501 | toDragListeners model.layout 502 | ++ 503 | [ style "margin" "0" 504 | , style "padding" "0" 505 | , style "width" "100%" 506 | , style "height" "100%" 507 | , style "font-family" "monospace" 508 | , style "display" "flex" 509 | , style "flex-direction" (toFlexDirection model.layout) 510 | ] 511 | ) 512 | [ viewHistory maybeIndex historyToRender model.layout 513 | , viewDragZone model.layout 514 | , viewExpando model.expandoMsg model.expandoModel model.layout 515 | ] 516 | 517 | 518 | toFlexDirection : Layout -> String 519 | toFlexDirection layout = 520 | case layout of 521 | Horizontal _ _ _ -> "row" 522 | Vertical _ _ _ -> "column-reverse" 523 | 524 | 525 | 526 | -- DRAG LISTENERS 527 | 528 | 529 | toDragListeners : Layout -> List (Attribute (Msg msg)) 530 | toDragListeners layout = 531 | case getDragStatus layout of 532 | Static -> [] 533 | Moving -> [ onMouseMove, onMouseUp DragEnd ] 534 | 535 | 536 | getDragStatus : Layout -> DragStatus 537 | getDragStatus layout = 538 | case layout of 539 | Horizontal status _ _ -> status 540 | Vertical status _ _ -> status 541 | 542 | 543 | type alias DragInfo = 544 | { x : Float 545 | , y : Float 546 | , down : Bool 547 | , width : Float 548 | , height : Float 549 | } 550 | 551 | 552 | onMouseMove : Attribute (Msg msg) 553 | onMouseMove = 554 | on "mousemove" <| Decode.map Drag <| 555 | Decode.map5 DragInfo 556 | (Decode.field "pageX" Decode.float) 557 | (Decode.field "pageY" Decode.float) 558 | (Decode.field "buttons" (Decode.map (\v -> v == 1) Decode.int)) 559 | (decodeDimension "innerWidth") 560 | (decodeDimension "innerHeight") 561 | 562 | 563 | decodeDimension : String -> Decoder Float 564 | decodeDimension field = 565 | Decode.at [ "currentTarget", "ownerDocument", "defaultView", field ] Decode.float 566 | 567 | 568 | 569 | -- VIEW DRAG ZONE 570 | 571 | 572 | viewDragZone : Layout -> Html (Msg msg) 573 | viewDragZone layout = 574 | case layout of 575 | Horizontal _ x _ -> 576 | div 577 | [ style "position" "absolute" 578 | , style "top" "0" 579 | , style "left" (toPercent x) 580 | , style "margin-left" "-5px" 581 | , style "width" "10px" 582 | , style "height" "100%" 583 | , style "cursor" "col-resize" 584 | , onMouseDown DragStart 585 | ] 586 | [] 587 | 588 | Vertical _ _ y -> 589 | div 590 | [ style "position" "absolute" 591 | , style "top" (toPercent y) 592 | , style "left" "0" 593 | , style "margin-top" "-5px" 594 | , style "width" "100%" 595 | , style "height" "10px" 596 | , style "cursor" "row-resize" 597 | , onMouseDown DragStart 598 | ] 599 | [] 600 | 601 | 602 | 603 | -- LAYOUT HELPERS 604 | 605 | 606 | toPercent : Float -> String 607 | toPercent fraction = 608 | String.fromFloat (100 * fraction) ++ "%" 609 | 610 | 611 | toMouseBlocker : Layout -> String 612 | toMouseBlocker layout = 613 | case getDragStatus layout of 614 | Static -> "auto" 615 | Moving -> "none" 616 | 617 | 618 | 619 | -- VIEW HISTORY 620 | 621 | 622 | viewHistory : Maybe Int -> History model msg -> Layout -> Html (Msg msg) 623 | viewHistory maybeIndex history layout = 624 | let 625 | (w,h) = toHistoryPercents layout 626 | block = toMouseBlocker layout 627 | in 628 | div 629 | [ style "width" w 630 | , style "height" h 631 | , style "display" "flex" 632 | , style "flex-direction" "column" 633 | , style "color" "#DDDDDD" 634 | , style "background-color" "rgb(61, 61, 61)" 635 | , style "pointer-events" block 636 | , style "user-select" block 637 | ] 638 | [ viewHistorySlider history maybeIndex 639 | , Html.map Jump (History.view maybeIndex history) 640 | , lazy viewHistoryOptions layout 641 | ] 642 | 643 | 644 | toHistoryPercents : Layout -> (String, String) 645 | toHistoryPercents layout = 646 | case layout of 647 | Horizontal _ x _ -> ( toPercent x, "100%" ) 648 | Vertical _ _ y -> ( "100%", toPercent (1 - y) ) 649 | 650 | 651 | viewHistorySlider : History model msg -> Maybe Int -> Html (Msg msg) 652 | viewHistorySlider history maybeIndex = 653 | let 654 | lastIndex = History.size history - 1 655 | selectedIndex = Maybe.withDefault lastIndex maybeIndex 656 | in 657 | div 658 | [ style "display" "flex" 659 | , style "flex-direction" "row" 660 | , style "align-items" "center" 661 | , style "width" "100%" 662 | , style "height" "36px" 663 | , style "background-color" "rgb(50, 50, 50)" 664 | ] 665 | [ lazy viewPlayButton (isPlaying maybeIndex) 666 | , input 667 | [ type_ "range" 668 | , style "width" "calc(100% - 56px)" 669 | , style "height" "36px" 670 | , style "margin" "0 10px" 671 | , A.min "0" 672 | , A.max (String.fromInt lastIndex) 673 | , value (String.fromInt selectedIndex) 674 | , onInput (String.toInt >> Maybe.withDefault lastIndex >> SliderJump) 675 | ] 676 | [] 677 | ] 678 | 679 | 680 | viewPlayButton : Bool -> Html (Msg msg) 681 | viewPlayButton playing = 682 | button 683 | [ style "background" "#1293D8" 684 | , style "border" "none" 685 | , style "color" "white" 686 | , style "cursor" "pointer" 687 | , style "width" "36px" 688 | , style "height" "36px" 689 | , onClick Resume 690 | ] 691 | [ if playing 692 | then icon "M2 2h4v12h-4v-12z M10 2h4v12h-4v-12z" 693 | else icon "M2 2l12 7l-12 7z" 694 | ] 695 | 696 | 697 | isPlaying : Maybe Int -> Bool 698 | isPlaying maybeIndex = 699 | case maybeIndex of 700 | Nothing -> True 701 | Just _ -> False 702 | 703 | 704 | viewHistoryOptions : Layout -> Html (Msg msg) 705 | viewHistoryOptions layout = 706 | div 707 | [ style "width" "100%" 708 | , style "height" "36px" 709 | , style "display" "flex" 710 | , style "flex-direction" "row" 711 | , style "align-items" "center" 712 | , style "justify-content" "space-between" 713 | , style "background-color" "rgb(50, 50, 50)" 714 | ] 715 | [ viewHistoryButton "Swap Layout" SwapLayout (toHistoryIcon layout) 716 | , div 717 | [ style "display" "flex" 718 | , style "flex-direction" "row" 719 | , style "align-items" "center" 720 | , style "justify-content" "space-between" 721 | ] 722 | [ viewHistoryButton "Import" Import "M5 1a1 1 0 0 1 0 2h-2a1 1 0 0 0-1 1v8a1 1 0 0 0 1 1h10a1 1 0 0 0 1-1a1 1 0 0 1 2 0a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3v-8a3 3 0 0 1 3-3z M10 2a1 1 0 0 0 -2 0v6a1 1 0 0 0 1 1h6a1 1 0 0 0 0-2h-3.586l4.293-4.293a1 1 0 0 0-1.414-1.414l-4.293 4.293z" 723 | , viewHistoryButton "Export" Export "M5 1a1 1 0 0 1 0 2h-2a1 1 0 0 0-1 1v8a1 1 0 0 0 1 1h10a1 1 0 0 0 1-1 a1 1 0 0 1 2 0a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3v-8a3 3 0 0 1 3-3z M9 3a1 1 0 1 1 0-2h6a1 1 0 0 1 1 1v6a1 1 0 1 1-2 0v-3.586l-5.293 5.293 a1 1 0 0 1-1.414-1.414l5.293 -5.293z" 724 | ] 725 | ] 726 | 727 | 728 | viewHistoryButton : String -> msg -> String -> Html msg 729 | viewHistoryButton label msg path = 730 | button 731 | [ style "display" "flex" 732 | , style "flex-direction" "row" 733 | , style "align-items" "center" 734 | , style "background" "none" 735 | , style "border" "none" 736 | , style "color" "inherit" 737 | , style "cursor" "pointer" 738 | , onClick msg 739 | ] 740 | [ icon path 741 | , span [ style "padding-left" "6px" ] [ text label ] 742 | ] 743 | 744 | 745 | icon : String -> Html msg 746 | icon path = 747 | V.nodeNS "http://www.w3.org/2000/svg" "svg" 748 | [ V.attribute "viewBox" "0 0 16 16" 749 | , V.attribute "xmlns" "http://www.w3.org/2000/svg" 750 | , V.attribute "fill" "currentColor" 751 | , V.attribute "width" "16px" 752 | , V.attribute "height" "16px" 753 | ] 754 | [ V.nodeNS "http://www.w3.org/2000/svg" "path" 755 | [ V.attribute "d" path ] 756 | [] 757 | ] 758 | 759 | 760 | toHistoryIcon : Layout -> String 761 | toHistoryIcon layout = 762 | case layout of 763 | Horizontal _ _ _ -> "M13 1a3 3 0 0 1 3 3v8a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3v-8a3 3 0 0 1 3-3z M13 3h-10a1 1 0 0 0-1 1v5h12v-5a1 1 0 0 0-1-1z M14 10h-12v2a1 1 0 0 0 1 1h10a1 1 0 0 0 1-1z" 764 | Vertical _ _ _ -> "M0 4a3 3 0 0 1 3-3h10a3 3 0 0 1 3 3v8a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3z M2 4v8a1 1 0 0 0 1 1h2v-10h-2a1 1 0 0 0-1 1z M6 3v10h7a1 1 0 0 0 1-1v-8a1 1 0 0 0-1-1z" 765 | 766 | 767 | 768 | -- VIEW EXPANDO 769 | 770 | 771 | viewExpando : Expando -> Expando -> Layout -> Html (Msg msg) 772 | viewExpando expandoMsg expandoModel layout = 773 | let 774 | (w,h) = toExpandoPercents layout 775 | block = toMouseBlocker layout 776 | in 777 | div 778 | [ style "display" "block" 779 | , style "width" ("calc(" ++ w ++ " - 4em)") 780 | , style "height" ("calc(" ++ h ++ " - 4em)") 781 | , style "padding" "2em" 782 | , style "margin" "0" 783 | , style "overflow" "auto" 784 | , style "pointer-events" block 785 | , style "-webkit-user-select" block 786 | , style "-moz-user-select" block 787 | , style "-ms-user-select" block 788 | , style "user-select" block 789 | ] 790 | [ div [ style "color" "#ccc", style "padding" "0 0 1em 0" ] [ text "-- MESSAGE" ] 791 | , Html.map TweakExpandoMsg <| Expando.view Nothing expandoMsg 792 | , div [ style "color" "#ccc", style "padding" "1em 0" ] [ text "-- MODEL" ] 793 | , Html.map TweakExpandoModel <| Expando.view Nothing expandoModel 794 | ] 795 | 796 | 797 | toExpandoPercents : Layout -> (String, String) 798 | toExpandoPercents layout = 799 | case layout of 800 | Horizontal _ x _ -> ( toPercent (1 - x), "100%" ) 801 | Vertical _ _ y -> ( "100%", toPercent y ) 802 | 803 | 804 | -- No case/let/if in parentheses. Always new top-level function. 805 | -- No case/let/if within a let. Always new top-level function. 806 | -- Replace "creating variable to use in different branches" with "same function call in different branches" 807 | -------------------------------------------------------------------------------- /src/Debugger/Metadata.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Metadata exposing 2 | ( Error 3 | , Metadata 4 | , Problem(..) 5 | , ProblemType 6 | , check 7 | , decode 8 | , decoder 9 | , encode 10 | ) 11 | 12 | import Array exposing (Array) 13 | import Debugger.Report as Report exposing (Report) 14 | import Dict exposing (Dict) 15 | import Json.Decode as Decode 16 | import Json.Encode as Encode 17 | 18 | 19 | 20 | -- METADATA 21 | 22 | 23 | type alias Metadata = 24 | { versions : Versions 25 | , types : Types 26 | } 27 | 28 | 29 | 30 | -- VERSIONS 31 | 32 | 33 | type alias Versions = 34 | { elm : String 35 | } 36 | 37 | 38 | 39 | -- TYPES 40 | 41 | 42 | type alias Types = 43 | { message : String 44 | , aliases : Dict String Alias 45 | , unions : Dict String Union 46 | } 47 | 48 | 49 | type alias Alias = 50 | { args : List String 51 | , tipe : String 52 | } 53 | 54 | 55 | type alias Union = 56 | { args : List String 57 | , tags : Dict String (List String) 58 | } 59 | 60 | 61 | 62 | -- PORTABILITY 63 | 64 | 65 | isPortable : Metadata -> Maybe Error 66 | isPortable { types } = 67 | let 68 | badAliases = 69 | Dict.foldl collectBadAliases [] types.aliases 70 | in 71 | case Dict.foldl collectBadUnions badAliases types.unions of 72 | [] -> 73 | Nothing 74 | 75 | problems -> 76 | Just (Error types.message problems) 77 | 78 | 79 | type alias Error = 80 | { message : String 81 | , problems : List ProblemType 82 | } 83 | 84 | 85 | type alias ProblemType = 86 | { name : String 87 | , problems : List Problem 88 | } 89 | 90 | 91 | type Problem 92 | = Function 93 | | Decoder 94 | | Task 95 | | Process 96 | | Socket 97 | | Request 98 | | Program 99 | | VirtualDom 100 | 101 | 102 | collectBadAliases : String -> Alias -> List ProblemType -> List ProblemType 103 | collectBadAliases name { tipe } list = 104 | case findProblems tipe of 105 | [] -> 106 | list 107 | 108 | problems -> 109 | ProblemType name problems :: list 110 | 111 | 112 | collectBadUnions : String -> Union -> List ProblemType -> List ProblemType 113 | collectBadUnions name { tags } list = 114 | case List.concatMap findProblems (List.concat (Dict.values tags)) of 115 | [] -> 116 | list 117 | 118 | problems -> 119 | ProblemType name problems :: list 120 | 121 | 122 | findProblems : String -> List Problem 123 | findProblems tipe = 124 | List.filterMap (hasProblem tipe) problemTable 125 | 126 | 127 | hasProblem : String -> ( Problem, String ) -> Maybe Problem 128 | hasProblem tipe ( problem, token ) = 129 | if String.contains token tipe then 130 | Just problem 131 | 132 | else 133 | Nothing 134 | 135 | 136 | problemTable : List ( Problem, String ) 137 | problemTable = 138 | [ ( Function, "->" ) 139 | , ( Decoder, "Json.Decode.Decoder" ) 140 | , ( Task, "Task.Task" ) 141 | , ( Process, "Process.Id" ) 142 | , ( Socket, "WebSocket.LowLevel.WebSocket" ) 143 | , ( Request, "Http.Request" ) 144 | , ( Program, "Platform.Program" ) 145 | , ( VirtualDom, "VirtualDom.Node" ) 146 | , ( VirtualDom, "VirtualDom.Attribute" ) 147 | ] 148 | 149 | 150 | 151 | -- CHECK 152 | 153 | 154 | check : Metadata -> Metadata -> Report 155 | check old new = 156 | if old.versions.elm /= new.versions.elm then 157 | Report.VersionChanged old.versions.elm new.versions.elm 158 | 159 | else 160 | checkTypes old.types new.types 161 | 162 | 163 | checkTypes : Types -> Types -> Report 164 | checkTypes old new = 165 | if old.message /= new.message then 166 | Report.MessageChanged old.message new.message 167 | 168 | else 169 | [] 170 | |> Dict.merge ignore checkAlias ignore old.aliases new.aliases 171 | |> Dict.merge ignore checkUnion ignore old.unions new.unions 172 | |> Report.SomethingChanged 173 | 174 | 175 | ignore : String -> value -> a -> a 176 | ignore key value report = 177 | report 178 | 179 | 180 | 181 | -- CHECK ALIASES 182 | 183 | 184 | checkAlias : String -> Alias -> Alias -> List Report.Change -> List Report.Change 185 | checkAlias name old new changes = 186 | if old.tipe == new.tipe && old.args == new.args then 187 | changes 188 | 189 | else 190 | Report.AliasChange name :: changes 191 | 192 | 193 | 194 | -- CHECK UNIONS 195 | 196 | 197 | checkUnion : String -> Union -> Union -> List Report.Change -> List Report.Change 198 | checkUnion name old new changes = 199 | let 200 | tagChanges = 201 | Dict.merge removeTag checkTag addTag old.tags new.tags <| 202 | Report.emptyTagChanges (old.args == new.args) 203 | in 204 | if Report.hasTagChanges tagChanges then 205 | changes 206 | 207 | else 208 | Report.UnionChange name tagChanges :: changes 209 | 210 | 211 | removeTag : String -> a -> Report.TagChanges -> Report.TagChanges 212 | removeTag tag _ changes = 213 | { changes | removed = tag :: changes.removed } 214 | 215 | 216 | addTag : String -> a -> Report.TagChanges -> Report.TagChanges 217 | addTag tag _ changes = 218 | { changes | added = tag :: changes.added } 219 | 220 | 221 | checkTag : String -> a -> a -> Report.TagChanges -> Report.TagChanges 222 | checkTag tag old new changes = 223 | if old == new then 224 | changes 225 | 226 | else 227 | { changes | changed = tag :: changes.changed } 228 | 229 | 230 | 231 | -- JSON DECODE 232 | 233 | 234 | decode : Encode.Value -> Result Error Metadata 235 | decode value = 236 | case Decode.decodeValue decoder value of 237 | Err _ -> 238 | Err (Error "The compiler is generating bad metadata. This is a compiler bug!" []) 239 | 240 | Ok metadata -> 241 | case isPortable metadata of 242 | Nothing -> 243 | Ok metadata 244 | 245 | Just error -> 246 | Err error 247 | 248 | 249 | decoder : Decode.Decoder Metadata 250 | decoder = 251 | Decode.map2 Metadata 252 | (Decode.field "versions" decodeVersions) 253 | (Decode.field "types" decodeTypes) 254 | 255 | 256 | decodeVersions : Decode.Decoder Versions 257 | decodeVersions = 258 | Decode.map Versions 259 | (Decode.field "elm" Decode.string) 260 | 261 | 262 | decodeTypes : Decode.Decoder Types 263 | decodeTypes = 264 | Decode.map3 Types 265 | (Decode.field "message" Decode.string) 266 | (Decode.field "aliases" (Decode.dict decodeAlias)) 267 | (Decode.field "unions" (Decode.dict decodeUnion)) 268 | 269 | 270 | decodeUnion : Decode.Decoder Union 271 | decodeUnion = 272 | Decode.map2 Union 273 | (Decode.field "args" (Decode.list Decode.string)) 274 | (Decode.field "tags" (Decode.dict (Decode.list Decode.string))) 275 | 276 | 277 | decodeAlias : Decode.Decoder Alias 278 | decodeAlias = 279 | Decode.map2 Alias 280 | (Decode.field "args" (Decode.list Decode.string)) 281 | (Decode.field "type" Decode.string) 282 | 283 | 284 | 285 | -- JSON ENCODE 286 | 287 | 288 | encode : Metadata -> Encode.Value 289 | encode { versions, types } = 290 | Encode.object 291 | [ ( "versions", encodeVersions versions ) 292 | , ( "types", encodeTypes types ) 293 | ] 294 | 295 | 296 | encodeVersions : Versions -> Encode.Value 297 | encodeVersions { elm } = 298 | Encode.object [ ( "elm", Encode.string elm ) ] 299 | 300 | 301 | encodeTypes : Types -> Encode.Value 302 | encodeTypes { message, unions, aliases } = 303 | Encode.object 304 | [ ( "message", Encode.string message ) 305 | , ( "aliases", encodeDict encodeAlias aliases ) 306 | , ( "unions", encodeDict encodeUnion unions ) 307 | ] 308 | 309 | 310 | encodeAlias : Alias -> Encode.Value 311 | encodeAlias { args, tipe } = 312 | Encode.object 313 | [ ( "args", Encode.list Encode.string args ) 314 | , ( "type", Encode.string tipe ) 315 | ] 316 | 317 | 318 | encodeUnion : Union -> Encode.Value 319 | encodeUnion { args, tags } = 320 | Encode.object 321 | [ ( "args", Encode.list Encode.string args ) 322 | , ( "tags", encodeDict (Encode.list Encode.string) tags ) 323 | ] 324 | 325 | 326 | encodeDict : (a -> Encode.Value) -> Dict String a -> Encode.Value 327 | encodeDict f dict = 328 | dict 329 | |> Dict.map (\key value -> f value) 330 | |> Dict.toList 331 | |> Encode.object 332 | -------------------------------------------------------------------------------- /src/Debugger/Overlay.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Overlay exposing 2 | ( BlockerType(..) 3 | , Config 4 | , Msg 5 | , State 6 | , assessImport 7 | , badMetadata 8 | , close 9 | , corruptImport 10 | , none 11 | , toBlockerType 12 | , view 13 | ) 14 | 15 | import Debugger.Metadata as Metadata exposing (Metadata) 16 | import Debugger.Report as Report exposing (Report) 17 | import Html exposing (..) 18 | import Html.Attributes exposing (..) 19 | import Html.Events exposing (onClick) 20 | import Json.Decode as Decode 21 | import Json.Encode as Encode 22 | import VirtualDom as V 23 | 24 | 25 | 26 | type State 27 | = None 28 | | BadMetadata Metadata.Error 29 | | BadImport Report 30 | | RiskyImport Report Encode.Value 31 | 32 | 33 | none : State 34 | none = 35 | None 36 | 37 | 38 | corruptImport : State 39 | corruptImport = 40 | BadImport Report.CorruptHistory 41 | 42 | 43 | badMetadata : Metadata.Error -> State 44 | badMetadata = 45 | BadMetadata 46 | 47 | 48 | 49 | -- UPDATE 50 | 51 | 52 | type Msg 53 | = Cancel 54 | | Proceed 55 | 56 | 57 | close : Msg -> State -> Maybe Encode.Value 58 | close msg state = 59 | case state of 60 | None -> 61 | Nothing 62 | 63 | BadMetadata _ -> 64 | Nothing 65 | 66 | BadImport _ -> 67 | Nothing 68 | 69 | RiskyImport _ rawHistory -> 70 | case msg of 71 | Cancel -> 72 | Nothing 73 | 74 | Proceed -> 75 | Just rawHistory 76 | 77 | 78 | assessImport : Metadata -> String -> Result State Encode.Value 79 | assessImport metadata jsonString = 80 | case Decode.decodeString uploadDecoder jsonString of 81 | Err _ -> 82 | Err corruptImport 83 | 84 | Ok ( foreignMetadata, rawHistory ) -> 85 | let 86 | report = 87 | Metadata.check foreignMetadata metadata 88 | in 89 | case Report.evaluate report of 90 | Report.Impossible -> 91 | Err (BadImport report) 92 | 93 | Report.Risky -> 94 | Err (RiskyImport report rawHistory) 95 | 96 | Report.Fine -> 97 | Ok rawHistory 98 | 99 | 100 | uploadDecoder : Decode.Decoder ( Metadata, Encode.Value ) 101 | uploadDecoder = 102 | Decode.map2 (\x y -> ( x, y )) 103 | (Decode.field "metadata" Metadata.decoder) 104 | (Decode.field "history" Decode.value) 105 | 106 | 107 | 108 | -- BLOCKERS 109 | 110 | 111 | type BlockerType 112 | = BlockNone 113 | | BlockMost 114 | | BlockAll 115 | 116 | 117 | toBlockerType : Bool -> State -> BlockerType 118 | toBlockerType isPaused state = 119 | case state of 120 | None -> 121 | if isPaused then 122 | BlockAll 123 | 124 | else 125 | BlockNone 126 | 127 | BadMetadata _ -> 128 | BlockMost 129 | 130 | BadImport _ -> 131 | BlockMost 132 | 133 | RiskyImport _ _ -> 134 | BlockMost 135 | 136 | 137 | 138 | -- VIEW 139 | 140 | 141 | type alias Config msg = 142 | { resume : msg 143 | , open : msg 144 | , importHistory : msg 145 | , exportHistory : msg 146 | , wrap : Msg -> msg 147 | } 148 | 149 | 150 | view : Config msg -> Bool -> Bool -> Int -> State -> Html msg 151 | view config isPaused isOpen numMsgs state = 152 | case state of 153 | None -> 154 | if isOpen then 155 | text "" 156 | 157 | else if isPaused then 158 | div 159 | [ id "elm-debugger-overlay" 160 | , style "position" "fixed" 161 | , style "top" "0" 162 | , style "left" "0" 163 | , style "width" "100vw" 164 | , style "height" "100vh" 165 | , style "cursor" "pointer" 166 | , style "display" "flex" 167 | , style "align-items" "center" 168 | , style "justify-content" "center" 169 | , style "pointer-events" "auto" 170 | , style "background-color" "rgba(200, 200, 200, 0.7)" 171 | , style "color" "white" 172 | , style "font-family" "'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif" 173 | , style "z-index" "2147483646" 174 | , onClick config.resume 175 | ] 176 | [ span [ style "font-size" "80px" ] [ text "Click to Resume" ] 177 | , viewMiniControls config numMsgs 178 | ] 179 | 180 | else 181 | viewMiniControls config numMsgs 182 | 183 | BadMetadata badMetadata_ -> 184 | viewMessage config 185 | "Cannot use Import or Export" 186 | (viewBadMetadata badMetadata_) 187 | (Accept "Ok") 188 | 189 | BadImport report -> 190 | viewMessage config 191 | "Cannot Import History" 192 | (viewReport True report) 193 | (Accept "Ok") 194 | 195 | RiskyImport report _ -> 196 | viewMessage config 197 | "Warning" 198 | (viewReport False report) 199 | (Choose "Cancel" "Import Anyway") 200 | 201 | 202 | 203 | -- VIEW MESSAGE 204 | 205 | 206 | viewMessage : Config msg -> String -> List (Html msg) -> Buttons -> Html msg 207 | viewMessage config title details buttons = 208 | div 209 | [ id "elm-debugger-overlay" 210 | , style "position" "fixed" 211 | , style "top" "0" 212 | , style "left" "0" 213 | , style "width" "100vw" 214 | , style "height" "100vh" 215 | , style "color" "white" 216 | , style "pointer-events" "none" 217 | , style "font-family" "'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif" 218 | , style "z-index" "2147483647" 219 | ] 220 | [ div 221 | [ style "position" "absolute" 222 | , style "width" "600px" 223 | , style "height" "100vh" 224 | , style "padding-left" "calc(50% - 300px)" 225 | , style "padding-right" "calc(50% - 300px)" 226 | , style "background-color" "rgba(200, 200, 200, 0.7)" 227 | , style "pointer-events" "auto" 228 | ] 229 | [ div 230 | [ style "font-size" "36px" 231 | , style "height" "80px" 232 | , style "background-color" "rgb(50, 50, 50)" 233 | , style "padding-left" "22px" 234 | , style "vertical-align" "middle" 235 | , style "line-height" "80px" 236 | ] 237 | [ text title ] 238 | , div 239 | [ id "elm-debugger-details" 240 | , style "padding" " 8px 20px" 241 | , style "overflow-y" "auto" 242 | , style "max-height" "calc(100vh - 156px)" 243 | , style "background-color" "rgb(61, 61, 61)" 244 | ] 245 | details 246 | , Html.map config.wrap (viewButtons buttons) 247 | ] 248 | ] 249 | 250 | 251 | viewReport : Bool -> Report -> List (Html msg) 252 | viewReport isBad report = 253 | case report of 254 | Report.CorruptHistory -> 255 | [ text "Looks like this history file is corrupt. I cannot understand it." 256 | ] 257 | 258 | Report.VersionChanged old new -> 259 | [ text <| 260 | "This history was created with Elm " 261 | ++ old 262 | ++ ", but you are using Elm " 263 | ++ new 264 | ++ " right now." 265 | ] 266 | 267 | Report.MessageChanged old new -> 268 | [ text <| 269 | "To import some other history, the overall message type must" 270 | ++ " be the same. The old history has " 271 | , viewCode old 272 | , text " messages, but the new program works with " 273 | , viewCode new 274 | , text " messages." 275 | ] 276 | 277 | Report.SomethingChanged changes -> 278 | [ p [] 279 | [ text 280 | (if isBad then 281 | explanationBad 282 | 283 | else 284 | explanationRisky 285 | ) 286 | ] 287 | , ul 288 | [ style "list-style-type" "none" 289 | , style "padding-left" "20px" 290 | ] 291 | (List.map viewChange changes) 292 | ] 293 | 294 | 295 | explanationBad : String 296 | explanationBad = 297 | """ 298 | The messages in this history do not match the messages handled by your 299 | program. I noticed changes in the following types: 300 | """ 301 | 302 | 303 | explanationRisky : String 304 | explanationRisky = 305 | """ 306 | This history seems old. It will work with this program, but some 307 | messages have been added since the history was created: 308 | """ 309 | 310 | 311 | viewCode : String -> Html msg 312 | viewCode name = 313 | code [] [ text name ] 314 | 315 | 316 | viewChange : Report.Change -> Html msg 317 | viewChange change = 318 | li [ style "margin" "8px 0" ] <| 319 | case change of 320 | Report.AliasChange name -> 321 | [ span [ style "font-size" "1.5em" ] [ viewCode name ] 322 | ] 323 | 324 | Report.UnionChange name { removed, changed, added, argsMatch } -> 325 | [ span [ style "font-size" "1.5em" ] [ viewCode name ] 326 | , ul 327 | [ style "list-style-type" "disc" 328 | , style "padding-left" "2em" 329 | ] 330 | [ viewMention removed "Removed " 331 | , viewMention changed "Changed " 332 | , viewMention added "Added " 333 | ] 334 | , if argsMatch then 335 | text "" 336 | 337 | else 338 | text "This may be due to the fact that the type variable names changed." 339 | ] 340 | 341 | 342 | viewMention : List String -> String -> Html msg 343 | viewMention tags verbed = 344 | case List.map viewCode (List.reverse tags) of 345 | [] -> 346 | text "" 347 | 348 | [ tag ] -> 349 | li [] 350 | [ text verbed, tag, text "." ] 351 | 352 | [ tag2, tag1 ] -> 353 | li [] 354 | [ text verbed, tag1, text " and ", tag2, text "." ] 355 | 356 | lastTag :: otherTags -> 357 | li [] <| 358 | text verbed 359 | :: List.intersperse (text ", ") (List.reverse otherTags) 360 | ++ [ text ", and ", lastTag, text "." ] 361 | 362 | 363 | viewBadMetadata : Metadata.Error -> List (Html msg) 364 | viewBadMetadata {message, problems} = 365 | [ p [] 366 | [ text "The " 367 | , viewCode message 368 | , text " type of your program cannot be reliably serialized for history files." 369 | ] 370 | , p [] [ text "Functions cannot be serialized, nor can values that contain functions. This is a problem in these places:" ] 371 | , ul [] (List.map viewProblemType problems) 372 | , p [] 373 | [ text goodNews1 374 | , a [ href "https://guide.elm-lang.org/types/custom_types.html" ] [ text "custom types" ] 375 | , text ", in your messages. From there, your " 376 | , viewCode "update" 377 | , text goodNews2 378 | ] 379 | ] 380 | 381 | 382 | goodNews1 = """ 383 | The good news is that having values like this in your message type is not 384 | so great in the long run. You are better off using simpler data, like 385 | """ 386 | 387 | 388 | goodNews2 = """ 389 | function can pattern match on that data and call whatever functions, JSON 390 | decoders, etc. you need. This makes the code much more explicit and easy to 391 | follow for other readers (or you in a few months!) 392 | """ 393 | 394 | 395 | viewProblemType : Metadata.ProblemType -> Html msg 396 | viewProblemType { name, problems } = 397 | li [] 398 | [ viewCode name 399 | , text (" can contain " ++ addCommas (List.map problemToString problems) ++ ".") 400 | ] 401 | 402 | 403 | problemToString : Metadata.Problem -> String 404 | problemToString problem = 405 | case problem of 406 | Metadata.Function -> "functions" 407 | Metadata.Decoder -> "JSON decoders" 408 | Metadata.Task -> "tasks" 409 | Metadata.Process -> "processes" 410 | Metadata.Socket -> "web sockets" 411 | Metadata.Request -> "HTTP requests" 412 | Metadata.Program -> "programs" 413 | Metadata.VirtualDom -> "virtual DOM values" 414 | 415 | 416 | addCommas : List String -> String 417 | addCommas items = 418 | case items of 419 | [] -> 420 | "" 421 | 422 | [item] -> 423 | item 424 | 425 | [item1,item2] -> 426 | item1 ++ " and " ++ item2 427 | 428 | lastItem :: otherItems -> 429 | String.join ", " (otherItems ++ [ " and " ++ lastItem ]) 430 | 431 | 432 | 433 | -- VIEW MESSAGE BUTTONS 434 | 435 | 436 | type Buttons 437 | = Accept String 438 | | Choose String String 439 | 440 | 441 | viewButtons : Buttons -> Html Msg 442 | viewButtons buttons = 443 | let 444 | btn msg string = 445 | Html.button [ style "margin-right" "20px", onClick msg ] [ text string ] 446 | 447 | buttonNodes = 448 | case buttons of 449 | Accept proceed -> 450 | [ btn Proceed proceed 451 | ] 452 | 453 | Choose cancel proceed -> 454 | [ btn Cancel cancel 455 | , btn Proceed proceed 456 | ] 457 | in 458 | div 459 | [ style "height" "60px" 460 | , style "line-height" "60px" 461 | , style "text-align" "right" 462 | , style "background-color" "rgb(50, 50, 50)" 463 | ] 464 | buttonNodes 465 | 466 | 467 | 468 | -- VIEW MINI CONTROLS 469 | 470 | 471 | viewMiniControls : Config msg -> Int -> Html msg 472 | viewMiniControls config numMsgs = 473 | let 474 | string = String.fromInt numMsgs 475 | width = String.fromInt (2 + String.length string) 476 | in 477 | div 478 | [ style "position" "fixed" 479 | , style "bottom" "2em" 480 | , style "right" "2em" 481 | , style "width" ("calc(42px + " ++ width ++ "ch)") 482 | , style "height" "36px" 483 | , style "background-color" "#1293D8" 484 | , style "color" "white" 485 | , style "font-family" "monospace" 486 | , style "pointer-events" "auto" 487 | , style "z-index" "2147483647" 488 | , style "display" "flex" 489 | , style "justify-content" "center" 490 | , style "align-items" "center" 491 | , style "cursor" "pointer" 492 | , onClick config.open 493 | ] 494 | [ elmLogo 495 | , span 496 | [ style "padding-left" "calc(1ch + 6px)" 497 | , style "padding-right" "1ch" 498 | ] 499 | [ text string ] 500 | ] 501 | 502 | 503 | elmLogo : Html msg 504 | elmLogo = 505 | V.nodeNS "http://www.w3.org/2000/svg" "svg" 506 | [ V.attribute "viewBox" "-300 -300 600 600" 507 | , V.attribute "xmlns" "http://www.w3.org/2000/svg" 508 | , V.attribute "fill" "currentColor" 509 | , V.attribute "width" "24px" 510 | , V.attribute "height" "24px" 511 | ] 512 | [ V.nodeNS "http://www.w3.org/2000/svg" "g" 513 | [ V.attribute "transform" "scale(1 -1)" 514 | ] 515 | [ viewShape 0 -210 0 "-280,-90 0,190 280,-90" 516 | , viewShape -210 0 90 "-280,-90 0,190 280,-90" 517 | , viewShape 207 207 45 "-198,-66 0,132 198,-66" 518 | , viewShape 150 0 0 "-130,0 0,-130 130,0 0,130" 519 | , viewShape -89 239 0 "-191,61 69,61 191,-61 -69,-61" 520 | , viewShape 0 106 180 "-130,-44 0,86 130,-44" 521 | , viewShape 256 -150 270 "-130,-44 0,86 130,-44" 522 | ] 523 | ] 524 | 525 | 526 | viewShape : Float -> Float -> Float -> String -> Html msg 527 | viewShape x y angle coordinates = 528 | V.nodeNS "http://www.w3.org/2000/svg" "polygon" 529 | [ V.attribute "points" coordinates 530 | , V.attribute "transform" <| 531 | "translate(" ++ String.fromFloat x ++ " " ++ String.fromFloat y 532 | ++ ") rotate(" ++ String.fromFloat -angle ++ ")" 533 | ] 534 | [] 535 | -------------------------------------------------------------------------------- /src/Debugger/Report.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Report exposing 2 | ( Change(..) 3 | , Report(..) 4 | , Status(..) 5 | , TagChanges 6 | , emptyTagChanges 7 | , evaluate 8 | , hasTagChanges 9 | ) 10 | 11 | -- REPORTS 12 | 13 | 14 | type Report 15 | = CorruptHistory 16 | | VersionChanged String String 17 | | MessageChanged String String 18 | | SomethingChanged (List Change) 19 | 20 | 21 | type Change 22 | = AliasChange String 23 | | UnionChange String TagChanges 24 | 25 | 26 | type alias TagChanges = 27 | { removed : List String 28 | , changed : List String 29 | , added : List String 30 | , argsMatch : Bool 31 | } 32 | 33 | 34 | emptyTagChanges : Bool -> TagChanges 35 | emptyTagChanges argsMatch = 36 | TagChanges [] [] [] argsMatch 37 | 38 | 39 | hasTagChanges : TagChanges -> Bool 40 | hasTagChanges tagChanges = 41 | tagChanges == TagChanges [] [] [] True 42 | 43 | 44 | type Status 45 | = Impossible 46 | | Risky 47 | | Fine 48 | 49 | 50 | evaluate : Report -> Status 51 | evaluate report = 52 | case report of 53 | CorruptHistory -> 54 | Impossible 55 | 56 | VersionChanged _ _ -> 57 | Impossible 58 | 59 | MessageChanged _ _ -> 60 | Impossible 61 | 62 | SomethingChanged changes -> 63 | worstCase Fine (List.map evaluateChange changes) 64 | 65 | 66 | worstCase : Status -> List Status -> Status 67 | worstCase status statusList = 68 | case statusList of 69 | [] -> 70 | status 71 | 72 | Impossible :: _ -> 73 | Impossible 74 | 75 | Risky :: rest -> 76 | worstCase Risky rest 77 | 78 | Fine :: rest -> 79 | worstCase status rest 80 | 81 | 82 | evaluateChange : Change -> Status 83 | evaluateChange change = 84 | case change of 85 | AliasChange _ -> 86 | Impossible 87 | 88 | UnionChange _ { removed, changed, added, argsMatch } -> 89 | if not argsMatch || some changed || some removed then 90 | Impossible 91 | 92 | else if some added then 93 | Risky 94 | 95 | else 96 | Fine 97 | 98 | 99 | some : List a -> Bool 100 | some list = 101 | not (List.isEmpty list) 102 | -------------------------------------------------------------------------------- /src/Elm/Kernel/Browser.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Basics exposing (never) 4 | import Browser exposing (Internal, External) 5 | import Browser.Dom as Dom exposing (NotFound) 6 | import Elm.Kernel.Debug exposing (crash) 7 | import Elm.Kernel.Debugger exposing (element, document) 8 | import Elm.Kernel.Json exposing (runHelp) 9 | import Elm.Kernel.List exposing (Nil) 10 | import Elm.Kernel.Platform exposing (initialize) 11 | import Elm.Kernel.Scheduler exposing (binding, fail, rawSpawn, succeed, spawn) 12 | import Elm.Kernel.Utils exposing (Tuple0, Tuple2) 13 | import Elm.Kernel.VirtualDom exposing (appendChild, applyPatches, diff, doc, node, passiveSupported, render, divertHrefToApp) 14 | import Json.Decode as Json exposing (map) 15 | import Maybe exposing (Just, Nothing) 16 | import Result exposing (isOk) 17 | import Task exposing (perform) 18 | import Url exposing (fromString) 19 | 20 | */ 21 | 22 | 23 | 24 | // ELEMENT 25 | 26 | 27 | var __Debugger_element; 28 | 29 | var _Browser_element = __Debugger_element || F4(function(impl, flagDecoder, debugMetadata, args) 30 | { 31 | return __Platform_initialize( 32 | flagDecoder, 33 | args, 34 | impl.__$init, 35 | impl.__$update, 36 | impl.__$subscriptions, 37 | function(sendToApp, initialModel) { 38 | var view = impl.__$view; 39 | /**__PROD/ 40 | var domNode = args['node']; 41 | //*/ 42 | /**__DEBUG/ 43 | var domNode = args && args['node'] ? args['node'] : __Debug_crash(0); 44 | //*/ 45 | var currNode = _VirtualDom_virtualize(domNode); 46 | 47 | return _Browser_makeAnimator(initialModel, function(model) 48 | { 49 | var nextNode = view(model); 50 | var patches = __VirtualDom_diff(currNode, nextNode); 51 | domNode = __VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); 52 | currNode = nextNode; 53 | }); 54 | } 55 | ); 56 | }); 57 | 58 | 59 | 60 | // DOCUMENT 61 | 62 | 63 | var __Debugger_document; 64 | 65 | var _Browser_document = __Debugger_document || F4(function(impl, flagDecoder, debugMetadata, args) 66 | { 67 | return __Platform_initialize( 68 | flagDecoder, 69 | args, 70 | impl.__$init, 71 | impl.__$update, 72 | impl.__$subscriptions, 73 | function(sendToApp, initialModel) { 74 | var divertHrefToApp = impl.__$setup && impl.__$setup(sendToApp) 75 | var view = impl.__$view; 76 | var title = __VirtualDom_doc.title; 77 | var bodyNode = __VirtualDom_doc.body; 78 | var currNode = _VirtualDom_virtualize(bodyNode); 79 | return _Browser_makeAnimator(initialModel, function(model) 80 | { 81 | __VirtualDom_divertHrefToApp = divertHrefToApp; 82 | var doc = view(model); 83 | var nextNode = __VirtualDom_node('body')(__List_Nil)(doc.__$body); 84 | var patches = __VirtualDom_diff(currNode, nextNode); 85 | bodyNode = __VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); 86 | currNode = nextNode; 87 | __VirtualDom_divertHrefToApp = 0; 88 | (title !== doc.__$title) && (__VirtualDom_doc.title = title = doc.__$title); 89 | }); 90 | } 91 | ); 92 | }); 93 | 94 | 95 | 96 | // ANIMATION 97 | 98 | 99 | var _Browser_cancelAnimationFrame = 100 | typeof cancelAnimationFrame !== 'undefined' 101 | ? cancelAnimationFrame 102 | : function(id) { clearTimeout(id); }; 103 | 104 | var _Browser_requestAnimationFrame = 105 | typeof requestAnimationFrame !== 'undefined' 106 | ? requestAnimationFrame 107 | : function(callback) { return setTimeout(callback, 1000 / 60); }; 108 | 109 | 110 | function _Browser_makeAnimator(model, draw) 111 | { 112 | draw(model); 113 | 114 | var state = __4_NO_REQUEST; 115 | 116 | function updateIfNeeded() 117 | { 118 | state = state === __4_EXTRA_REQUEST 119 | ? __4_NO_REQUEST 120 | : ( _Browser_requestAnimationFrame(updateIfNeeded), draw(model), __4_EXTRA_REQUEST ); 121 | } 122 | 123 | return function(nextModel, isSync) 124 | { 125 | model = nextModel; 126 | 127 | isSync 128 | ? ( draw(model), 129 | state === __4_PENDING_REQUEST && (state = __4_EXTRA_REQUEST) 130 | ) 131 | : ( state === __4_NO_REQUEST && _Browser_requestAnimationFrame(updateIfNeeded), 132 | state = __4_PENDING_REQUEST 133 | ); 134 | }; 135 | } 136 | 137 | 138 | 139 | // APPLICATION 140 | 141 | 142 | function _Browser_application(impl) 143 | { 144 | var onUrlChange = impl.__$onUrlChange; 145 | var onUrlRequest = impl.__$onUrlRequest; 146 | var key = function() { key.__sendToApp(onUrlChange(_Browser_getUrl())); }; 147 | 148 | return _Browser_document({ 149 | __$setup: function(sendToApp) 150 | { 151 | key.__sendToApp = sendToApp; 152 | _Browser_window.addEventListener('popstate', key); 153 | _Browser_window.navigator.userAgent.indexOf('Trident') < 0 || _Browser_window.addEventListener('hashchange', key); 154 | 155 | return F2(function(domNode, event) 156 | { 157 | if (!event.ctrlKey && !event.metaKey && !event.shiftKey && event.button < 1 && !domNode.target && !domNode.hasAttribute('download')) 158 | { 159 | event.preventDefault(); 160 | var href = domNode.href; 161 | var curr = _Browser_getUrl(); 162 | var next = __Url_fromString(href).a; 163 | sendToApp(onUrlRequest( 164 | (next 165 | && curr.__$protocol === next.__$protocol 166 | && curr.__$host === next.__$host 167 | && curr.__$port_.a === next.__$port_.a 168 | ) 169 | ? __Browser_Internal(next) 170 | : __Browser_External(href) 171 | )); 172 | } 173 | }); 174 | }, 175 | __$init: function(flags) 176 | { 177 | return A3(impl.__$init, flags, _Browser_getUrl(), key); 178 | }, 179 | __$view: impl.__$view, 180 | __$update: impl.__$update, 181 | __$subscriptions: impl.__$subscriptions 182 | }); 183 | } 184 | 185 | function _Browser_getUrl() 186 | { 187 | return __Url_fromString(__VirtualDom_doc.location.href).a || __Debug_crash(1); 188 | } 189 | 190 | var _Browser_go = F2(function(key, n) 191 | { 192 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { 193 | n && history.go(n); 194 | key(); 195 | })); 196 | }); 197 | 198 | var _Browser_pushUrl = F2(function(key, url) 199 | { 200 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { 201 | history.pushState({}, '', url); 202 | key(); 203 | })); 204 | }); 205 | 206 | var _Browser_replaceUrl = F2(function(key, url) 207 | { 208 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { 209 | history.replaceState({}, '', url); 210 | key(); 211 | })); 212 | }); 213 | 214 | 215 | 216 | // GLOBAL EVENTS 217 | 218 | 219 | var _Browser_fakeNode = { addEventListener: function() {}, removeEventListener: function() {} }; 220 | var _Browser_doc = typeof document !== 'undefined' ? document : _Browser_fakeNode; 221 | var _Browser_window = typeof window !== 'undefined' ? window : _Browser_fakeNode; 222 | 223 | var _Browser_on = F3(function(node, eventName, sendToSelf) 224 | { 225 | return __Scheduler_spawn(__Scheduler_binding(function(callback) 226 | { 227 | function handler(event) { __Scheduler_rawSpawn(sendToSelf(event)); } 228 | node.addEventListener(eventName, handler, __VirtualDom_passiveSupported && { passive: true }); 229 | return function() { node.removeEventListener(eventName, handler); }; 230 | })); 231 | }); 232 | 233 | var _Browser_decodeEvent = F2(function(decoder, event) 234 | { 235 | var result = __Json_runHelp(decoder, event); 236 | return __Result_isOk(result) ? __Maybe_Just(result.a) : __Maybe_Nothing; 237 | }); 238 | 239 | 240 | 241 | // PAGE VISIBILITY 242 | 243 | 244 | function _Browser_visibilityInfo() 245 | { 246 | return (typeof __VirtualDom_doc.hidden !== 'undefined') 247 | ? { __$hidden: 'hidden', __$change: 'visibilitychange' } 248 | : 249 | (typeof __VirtualDom_doc.mozHidden !== 'undefined') 250 | ? { __$hidden: 'mozHidden', __$change: 'mozvisibilitychange' } 251 | : 252 | (typeof __VirtualDom_doc.msHidden !== 'undefined') 253 | ? { __$hidden: 'msHidden', __$change: 'msvisibilitychange' } 254 | : 255 | (typeof __VirtualDom_doc.webkitHidden !== 'undefined') 256 | ? { __$hidden: 'webkitHidden', __$change: 'webkitvisibilitychange' } 257 | : { __$hidden: 'hidden', __$change: 'visibilitychange' }; 258 | } 259 | 260 | 261 | 262 | // ANIMATION FRAMES 263 | 264 | 265 | function _Browser_rAF() 266 | { 267 | return __Scheduler_binding(function(callback) 268 | { 269 | var id = _Browser_requestAnimationFrame(function() { 270 | callback(__Scheduler_succeed(Date.now())); 271 | }); 272 | 273 | return function() { 274 | _Browser_cancelAnimationFrame(id); 275 | }; 276 | }); 277 | } 278 | 279 | 280 | function _Browser_now() 281 | { 282 | return __Scheduler_binding(function(callback) 283 | { 284 | callback(__Scheduler_succeed(Date.now())); 285 | }); 286 | } 287 | 288 | 289 | 290 | // DOM STUFF 291 | 292 | 293 | function _Browser_withNode(id, doStuff) 294 | { 295 | return __Scheduler_binding(function(callback) 296 | { 297 | _Browser_requestAnimationFrame(function() { 298 | var node = document.getElementById(id); 299 | callback(node 300 | ? __Scheduler_succeed(doStuff(node)) 301 | : __Scheduler_fail(__Dom_NotFound(id)) 302 | ); 303 | }); 304 | }); 305 | } 306 | 307 | 308 | function _Browser_withWindow(doStuff) 309 | { 310 | return __Scheduler_binding(function(callback) 311 | { 312 | _Browser_requestAnimationFrame(function() { 313 | callback(__Scheduler_succeed(doStuff())); 314 | }); 315 | }); 316 | } 317 | 318 | 319 | // FOCUS and BLUR 320 | 321 | 322 | var _Browser_call = F2(function(functionName, id) 323 | { 324 | return _Browser_withNode(id, function(node) { 325 | node[functionName](); 326 | return __Utils_Tuple0; 327 | }); 328 | }); 329 | 330 | 331 | 332 | // WINDOW VIEWPORT 333 | 334 | 335 | function _Browser_getViewport() 336 | { 337 | return { 338 | __$scene: _Browser_getScene(), 339 | __$viewport: { 340 | __$x: _Browser_window.pageXOffset, 341 | __$y: _Browser_window.pageYOffset, 342 | __$width: _Browser_doc.documentElement.clientWidth, 343 | __$height: _Browser_doc.documentElement.clientHeight 344 | } 345 | }; 346 | } 347 | 348 | function _Browser_getScene() 349 | { 350 | var body = _Browser_doc.body; 351 | var elem = _Browser_doc.documentElement; 352 | return { 353 | __$width: Math.max(body.scrollWidth, body.offsetWidth, elem.scrollWidth, elem.offsetWidth, elem.clientWidth), 354 | __$height: Math.max(body.scrollHeight, body.offsetHeight, elem.scrollHeight, elem.offsetHeight, elem.clientHeight) 355 | }; 356 | } 357 | 358 | var _Browser_setViewport = F2(function(x, y) 359 | { 360 | return _Browser_withWindow(function() 361 | { 362 | _Browser_window.scroll(x, y); 363 | return __Utils_Tuple0; 364 | }); 365 | }); 366 | 367 | 368 | 369 | // ELEMENT VIEWPORT 370 | 371 | 372 | function _Browser_getViewportOf(id) 373 | { 374 | return _Browser_withNode(id, function(node) 375 | { 376 | return { 377 | __$scene: { 378 | __$width: node.scrollWidth, 379 | __$height: node.scrollHeight 380 | }, 381 | __$viewport: { 382 | __$x: node.scrollLeft, 383 | __$y: node.scrollTop, 384 | __$width: node.clientWidth, 385 | __$height: node.clientHeight 386 | } 387 | }; 388 | }); 389 | } 390 | 391 | 392 | var _Browser_setViewportOf = F3(function(id, x, y) 393 | { 394 | return _Browser_withNode(id, function(node) 395 | { 396 | node.scrollLeft = x; 397 | node.scrollTop = y; 398 | return __Utils_Tuple0; 399 | }); 400 | }); 401 | 402 | 403 | 404 | // ELEMENT 405 | 406 | 407 | function _Browser_getElement(id) 408 | { 409 | return _Browser_withNode(id, function(node) 410 | { 411 | var rect = node.getBoundingClientRect(); 412 | var x = _Browser_window.pageXOffset; 413 | var y = _Browser_window.pageYOffset; 414 | return { 415 | __$scene: _Browser_getScene(), 416 | __$viewport: { 417 | __$x: x, 418 | __$y: y, 419 | __$width: _Browser_doc.documentElement.clientWidth, 420 | __$height: _Browser_doc.documentElement.clientHeight 421 | }, 422 | __$element: { 423 | __$x: x + rect.left, 424 | __$y: y + rect.top, 425 | __$width: rect.width, 426 | __$height: rect.height 427 | } 428 | }; 429 | }); 430 | } 431 | 432 | 433 | 434 | // LOAD and RELOAD 435 | 436 | 437 | function _Browser_reload(skipCache) 438 | { 439 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function(callback) 440 | { 441 | __VirtualDom_doc.location.reload(skipCache); 442 | })); 443 | } 444 | 445 | function _Browser_load(url) 446 | { 447 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function(callback) 448 | { 449 | try 450 | { 451 | _Browser_window.location = url; 452 | } 453 | catch(err) 454 | { 455 | // Only Firefox can throw a NS_ERROR_MALFORMED_URI exception here. 456 | // Other browsers reload the page, so let's be consistent about that. 457 | __VirtualDom_doc.location.reload(false); 458 | } 459 | })); 460 | } 461 | -------------------------------------------------------------------------------- /src/Elm/Kernel/Browser.server.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Elm.Kernel.Debug exposing (crash) 4 | import Elm.Kernel.Json exposing (run, wrap) 5 | import Elm.Kernel.Platform exposing (preload) 6 | import Elm.Kernel.Scheduler exposing (binding, succeed, spawn) 7 | import Elm.Kernel.Utils exposing (Tuple0) 8 | import Elm.Kernel.VirtualDom exposing (body) 9 | import Json.Decode as Json exposing (map) 10 | import Platform.Sub as Sub exposing (none) 11 | import Result exposing (isOk) 12 | 13 | */ 14 | 15 | 16 | 17 | // DUMMY STUFF 18 | 19 | 20 | function _Browser_invalidUrl(url) { __Debug_crash(1, url); } 21 | function _Browser_makeUnitTask() { return _Browser_unitTask; } 22 | function _Browser_makeNeverResolve() { return __Scheduler_binding(function(){}); } 23 | var _Browser_unitTask = __Scheduler_succeed(__Utils_Tuple0); 24 | var _Browser_go = _Browser_makeUnitTask; 25 | var _Browser_pushState = _Browser_makeNeverResolve 26 | var _Browser_replaceState = _Browser_makeNeverResolve; 27 | var _Browser_reload = _Browser_makeUnitTask; 28 | var _Browser_load = _Browser_makeUnitTask; 29 | var _Browser_call = F2(_Browser_makeUnitTask); 30 | var _Browser_setPositiveScroll = F3(_Browser_makeUnitTask); 31 | var _Browser_setNegativeScroll = F4(_Browser_makeUnitTask); 32 | var _Browser_getScroll = _Browser_makeNeverResolve; 33 | var _Browser_on = F4(function() { return __Scheduler_spawn(_Browser_unitTask); }); 34 | 35 | 36 | 37 | // PROGRAMS 38 | 39 | 40 | var _Browser_element = F4(function(impl, flagDecoder, object, debugMetadata) 41 | { 42 | object['prerender'] = function(flags) 43 | { 44 | return _Browser_prerender(flagDecoder, flags, impl); 45 | }; 46 | 47 | object['render'] = function(flags) 48 | { 49 | return _Browser_render(flagDecoder, flags, impl, function(html, preload) { 50 | return { 51 | html: html, 52 | preload: preload 53 | }; 54 | }); 55 | }; 56 | }); 57 | 58 | 59 | var _Browser_document = F4(function(impl, flagDecoder, object, debugMetadata) 60 | { 61 | object['prerender'] = function(url, flags) 62 | { 63 | return _Browser_prerender(_Browser_addEnv(url, flagDecoder), flags, impl); 64 | }; 65 | 66 | object['render'] = function(url, flags) 67 | { 68 | return _Browser_render(_Browser_addEnv(url, flagDecoder), flags, impl, function(ui, preload) { 69 | return { 70 | title: ui.__$title, 71 | body: __VirtualDom_body(ui.__$body), 72 | preload: preload 73 | }; 74 | }); 75 | }; 76 | }); 77 | 78 | 79 | 80 | // PROGRAM HELPERS 81 | 82 | 83 | function _Browser_prerender(flagDecoder, flags, impl) 84 | { 85 | __Platform_preload = new Set(); 86 | _Browser_dispatchCommands(_Browser_init(flagDecoder, flags, impl.__$init).b); 87 | var preload = __Platform_preload; 88 | __Platform_preload = null; 89 | return preload; 90 | } 91 | 92 | 93 | function _Browser_render(flagDecoder, flags, impl, toOutput) 94 | { 95 | __Platform_preload = new Set(); 96 | var pair = _Browser_init(flagDecoder, flags, impl.__$init); 97 | _Browser_dispatchCommands(pair.b); 98 | var view = impl.__$view(pair.a); 99 | var preload = __Platform_preload; 100 | __Platform_preload = null; 101 | return toOutput(view, preload); 102 | } 103 | 104 | 105 | function _Browser_init(flagDecoder, flags, init) 106 | { 107 | var result = A2(__Json_run, flagDecoder, __Json_wrap(flags)); 108 | return __Result_isOk(result) ? init(result.a) : __Debug_crash(2, result.a); 109 | } 110 | 111 | 112 | function _Browser_dispatchCommands(commands) 113 | { 114 | var managers = {}; 115 | _Platform_setupEffects(managers, function() {}); 116 | _Platform_dispatchEffects(managers, commands, __Sub_none); 117 | } 118 | 119 | 120 | 121 | // FULLSCREEN ENV 122 | 123 | 124 | function _Browser_addEnv(url, flagDecoder) 125 | { 126 | return A2(__Json_map, function(flags) { 127 | return { 128 | __$flags: flags, 129 | __$url: url 130 | }; 131 | }, flagDecoder); 132 | } 133 | -------------------------------------------------------------------------------- /src/Elm/Kernel/Debugger.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Debugger.Expando as Expando exposing (S, Primitive, Sequence, Dictionary, Record, Constructor, ListSeq, SetSeq, ArraySeq) 4 | import Debugger.Main as Main exposing (getUserModel, wrapInit, wrapUpdate, wrapSubs, cornerView, popoutView, NoOp, UserMsg, Up, Down, toBlockerType, initialWindowWidth, initialWindowHeight) 5 | import Debugger.Overlay as Overlay exposing (BlockNone, BlockMost) 6 | import Elm.Kernel.Browser exposing (makeAnimator) 7 | import Elm.Kernel.Debug exposing (crash) 8 | import Elm.Kernel.Json exposing (wrap) 9 | import Elm.Kernel.List exposing (Cons, Nil) 10 | import Elm.Kernel.Platform exposing (initialize) 11 | import Elm.Kernel.Scheduler exposing (binding, succeed) 12 | import Elm.Kernel.Utils exposing (Tuple0, Tuple2, ap) 13 | import Elm.Kernel.VirtualDom exposing (node, applyPatches, diff, doc, makeStepper, map, render, virtualize, divertHrefToApp) 14 | import Json.Decode as Json exposing (map) 15 | import List exposing (map, reverse) 16 | import Maybe exposing (Just, Nothing) 17 | import Set exposing (foldr) 18 | import Dict exposing (foldr, empty, insert) 19 | import Array exposing (foldr) 20 | 21 | */ 22 | 23 | 24 | 25 | // HELPERS 26 | 27 | 28 | function _Debugger_unsafeCoerce(value) 29 | { 30 | return value; 31 | } 32 | 33 | 34 | 35 | // PROGRAMS 36 | 37 | 38 | var _Debugger_element = F4(function(impl, flagDecoder, debugMetadata, args) 39 | { 40 | return __Platform_initialize( 41 | flagDecoder, 42 | args, 43 | A3(__Main_wrapInit, __Json_wrap(debugMetadata), _Debugger_popout(), impl.__$init), 44 | __Main_wrapUpdate(impl.__$update), 45 | __Main_wrapSubs(impl.__$subscriptions), 46 | function(sendToApp, initialModel) 47 | { 48 | var view = impl.__$view; 49 | var title = __VirtualDom_doc.title; 50 | var domNode = args && args['node'] ? args['node'] : __Debug_crash(0); 51 | var currNode = __VirtualDom_virtualize(domNode); 52 | var currBlocker = __Main_toBlockerType(initialModel); 53 | var currPopout; 54 | 55 | var cornerNode = __VirtualDom_doc.createElement('div'); 56 | domNode.parentNode.insertBefore(cornerNode, domNode.nextSibling); 57 | var cornerCurr = __VirtualDom_virtualize(cornerNode); 58 | 59 | initialModel.__$popout.__sendToApp = sendToApp; 60 | 61 | return _Browser_makeAnimator(initialModel, function(model) 62 | { 63 | var nextNode = A2(__VirtualDom_map, __Main_UserMsg, view(__Main_getUserModel(model))); 64 | var patches = __VirtualDom_diff(currNode, nextNode); 65 | domNode = __VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); 66 | currNode = nextNode; 67 | 68 | // update blocker 69 | 70 | var nextBlocker = __Main_toBlockerType(model); 71 | _Debugger_updateBlocker(currBlocker, nextBlocker); 72 | currBlocker = nextBlocker; 73 | 74 | // view corner 75 | 76 | var cornerNext = __Main_cornerView(model); 77 | var cornerPatches = __VirtualDom_diff(cornerCurr, cornerNext); 78 | cornerNode = __VirtualDom_applyPatches(cornerNode, cornerCurr, cornerPatches, sendToApp); 79 | cornerCurr = cornerNext; 80 | 81 | if (!model.__$popout.__doc) 82 | { 83 | currPopout = undefined; 84 | return; 85 | } 86 | 87 | // view popout 88 | 89 | __VirtualDom_doc = model.__$popout.__doc; // SWITCH TO POPOUT DOC 90 | currPopout || (currPopout = __VirtualDom_virtualize(model.__$popout.__doc)); 91 | var nextPopout = __Main_popoutView(model); 92 | var popoutPatches = __VirtualDom_diff(currPopout, nextPopout); 93 | __VirtualDom_applyPatches(model.__$popout.__doc.body, currPopout, popoutPatches, sendToApp); 94 | currPopout = nextPopout; 95 | __VirtualDom_doc = document; // SWITCH BACK TO NORMAL DOC 96 | }); 97 | } 98 | ); 99 | }); 100 | 101 | 102 | var _Debugger_document = F4(function(impl, flagDecoder, debugMetadata, args) 103 | { 104 | return __Platform_initialize( 105 | flagDecoder, 106 | args, 107 | A3(__Main_wrapInit, __Json_wrap(debugMetadata), _Debugger_popout(), impl.__$init), 108 | __Main_wrapUpdate(impl.__$update), 109 | __Main_wrapSubs(impl.__$subscriptions), 110 | function(sendToApp, initialModel) 111 | { 112 | var divertHrefToApp = impl.__$setup && impl.__$setup(function(x) { return sendToApp(__Main_UserMsg(x)); }); 113 | var view = impl.__$view; 114 | var title = __VirtualDom_doc.title; 115 | var bodyNode = __VirtualDom_doc.body; 116 | var currNode = __VirtualDom_virtualize(bodyNode); 117 | var currBlocker = __Main_toBlockerType(initialModel); 118 | var currPopout; 119 | 120 | initialModel.__$popout.__sendToApp = sendToApp; 121 | 122 | return _Browser_makeAnimator(initialModel, function(model) 123 | { 124 | __VirtualDom_divertHrefToApp = divertHrefToApp; 125 | var doc = view(__Main_getUserModel(model)); 126 | var nextNode = __VirtualDom_node('body')(__List_Nil)( 127 | __Utils_ap( 128 | A2(__List_map, __VirtualDom_map(__Main_UserMsg), doc.__$body), 129 | __List_Cons(__Main_cornerView(model), __List_Nil) 130 | ) 131 | ); 132 | var patches = __VirtualDom_diff(currNode, nextNode); 133 | bodyNode = __VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); 134 | currNode = nextNode; 135 | __VirtualDom_divertHrefToApp = 0; 136 | (title !== doc.__$title) && (__VirtualDom_doc.title = title = doc.__$title); 137 | 138 | // update blocker 139 | 140 | var nextBlocker = __Main_toBlockerType(model); 141 | _Debugger_updateBlocker(currBlocker, nextBlocker); 142 | currBlocker = nextBlocker; 143 | 144 | // view popout 145 | 146 | if (!model.__$popout.__doc) { currPopout = undefined; return; } 147 | 148 | __VirtualDom_doc = model.__$popout.__doc; // SWITCH TO POPOUT DOC 149 | currPopout || (currPopout = __VirtualDom_virtualize(model.__$popout.__doc)); 150 | var nextPopout = __Main_popoutView(model); 151 | var popoutPatches = __VirtualDom_diff(currPopout, nextPopout); 152 | __VirtualDom_applyPatches(model.__$popout.__doc.body, currPopout, popoutPatches, sendToApp); 153 | currPopout = nextPopout; 154 | __VirtualDom_doc = document; // SWITCH BACK TO NORMAL DOC 155 | }); 156 | } 157 | ); 158 | }); 159 | 160 | 161 | function _Debugger_popout() 162 | { 163 | return { 164 | __doc: undefined, 165 | __sendToApp: undefined 166 | }; 167 | } 168 | 169 | function _Debugger_isOpen(popout) 170 | { 171 | return !!popout.__doc; 172 | } 173 | 174 | function _Debugger_open(popout) 175 | { 176 | return __Scheduler_binding(function(callback) 177 | { 178 | _Debugger_openWindow(popout); 179 | callback(__Scheduler_succeed(__Utils_Tuple0)); 180 | }); 181 | } 182 | 183 | function _Debugger_openWindow(popout) 184 | { 185 | var w = __Main_initialWindowWidth, 186 | h = __Main_initialWindowHeight, 187 | x = screen.width - w, 188 | y = screen.height - h; 189 | 190 | var debuggerWindow = window.open('', '', 'width=' + w + ',height=' + h + ',left=' + x + ',top=' + y); 191 | var doc = debuggerWindow.document; 192 | doc.title = 'Elm Debugger'; 193 | 194 | // handle arrow keys 195 | doc.addEventListener('keydown', function(event) { 196 | event.metaKey && event.which === 82 && window.location.reload(); 197 | event.key === 'ArrowUp' && (popout.__sendToApp(__Main_Up ), event.preventDefault()); 198 | event.key === 'ArrowDown' && (popout.__sendToApp(__Main_Down), event.preventDefault()); 199 | }); 200 | 201 | // handle window close 202 | window.addEventListener('unload', close); 203 | debuggerWindow.addEventListener('unload', function() { 204 | popout.__doc = undefined; 205 | popout.__sendToApp(__Main_NoOp); 206 | window.removeEventListener('unload', close); 207 | }); 208 | 209 | function close() { 210 | popout.__doc = undefined; 211 | popout.__sendToApp(__Main_NoOp); 212 | debuggerWindow.close(); 213 | } 214 | 215 | // register new window 216 | popout.__doc = doc; 217 | } 218 | 219 | 220 | 221 | // SCROLL 222 | 223 | 224 | function _Debugger_scroll(popout) 225 | { 226 | return __Scheduler_binding(function(callback) 227 | { 228 | if (popout.__doc) 229 | { 230 | var msgs = popout.__doc.getElementById('elm-debugger-sidebar'); 231 | if (msgs && msgs.scrollTop !== 0) 232 | { 233 | msgs.scrollTop = 0; 234 | } 235 | } 236 | callback(__Scheduler_succeed(__Utils_Tuple0)); 237 | }); 238 | } 239 | 240 | 241 | var _Debugger_scrollTo = F2(function(id, popout) 242 | { 243 | return __Scheduler_binding(function(callback) 244 | { 245 | if (popout.__doc) 246 | { 247 | var msg = popout.__doc.getElementById(id); 248 | if (msg) 249 | { 250 | msg.scrollIntoView(false); 251 | } 252 | } 253 | callback(__Scheduler_succeed(__Utils_Tuple0)); 254 | }); 255 | }); 256 | 257 | 258 | 259 | // UPLOAD 260 | 261 | 262 | function _Debugger_upload(popout) 263 | { 264 | return __Scheduler_binding(function(callback) 265 | { 266 | var doc = popout.__doc || document; 267 | var element = doc.createElement('input'); 268 | element.setAttribute('type', 'file'); 269 | element.setAttribute('accept', 'text/json'); 270 | element.style.display = 'none'; 271 | element.addEventListener('change', function(event) 272 | { 273 | var fileReader = new FileReader(); 274 | fileReader.onload = function(e) 275 | { 276 | callback(__Scheduler_succeed(e.target.result)); 277 | }; 278 | fileReader.readAsText(event.target.files[0]); 279 | doc.body.removeChild(element); 280 | }); 281 | doc.body.appendChild(element); 282 | element.click(); 283 | }); 284 | } 285 | 286 | 287 | 288 | // DOWNLOAD 289 | 290 | 291 | var _Debugger_download = F2(function(historyLength, json) 292 | { 293 | return __Scheduler_binding(function(callback) 294 | { 295 | var fileName = 'history-' + historyLength + '.txt'; 296 | var jsonString = JSON.stringify(json); 297 | var mime = 'text/plain;charset=utf-8'; 298 | var done = __Scheduler_succeed(__Utils_Tuple0); 299 | 300 | // for IE10+ 301 | if (navigator.msSaveBlob) 302 | { 303 | navigator.msSaveBlob(new Blob([jsonString], {type: mime}), fileName); 304 | return callback(done); 305 | } 306 | 307 | // for HTML5 308 | var element = document.createElement('a'); 309 | element.setAttribute('href', 'data:' + mime + ',' + encodeURIComponent(jsonString)); 310 | element.setAttribute('download', fileName); 311 | element.style.display = 'none'; 312 | document.body.appendChild(element); 313 | element.click(); 314 | document.body.removeChild(element); 315 | callback(done); 316 | }); 317 | }); 318 | 319 | 320 | 321 | // POPOUT CONTENT 322 | 323 | 324 | function _Debugger_messageToString(value) 325 | { 326 | if (typeof value === 'boolean') 327 | { 328 | return value ? 'True' : 'False'; 329 | } 330 | 331 | if (typeof value === 'number') 332 | { 333 | return value + ''; 334 | } 335 | 336 | if (typeof value === 'string') 337 | { 338 | return '"' + _Debugger_addSlashes(value, false) + '"'; 339 | } 340 | 341 | if (value instanceof String) 342 | { 343 | return "'" + _Debugger_addSlashes(value, true) + "'"; 344 | } 345 | 346 | if (typeof value !== 'object' || value === null || !('$' in value)) 347 | { 348 | return '…'; 349 | } 350 | 351 | if (typeof value.$ === 'number') 352 | { 353 | return '…'; 354 | } 355 | 356 | var code = value.$.charCodeAt(0); 357 | if (code === 0x23 /* # */ || /* a */ 0x61 <= code && code <= 0x7A /* z */) 358 | { 359 | return '…'; 360 | } 361 | 362 | if (['Array_elm_builtin', 'Set_elm_builtin', 'RBNode_elm_builtin', 'RBEmpty_elm_builtin'].indexOf(value.$) >= 0) 363 | { 364 | return '…'; 365 | } 366 | 367 | var keys = Object.keys(value); 368 | switch (keys.length) 369 | { 370 | case 1: 371 | return value.$; 372 | case 2: 373 | return value.$ + ' ' + _Debugger_messageToString(value.a); 374 | default: 375 | return value.$ + ' … ' + _Debugger_messageToString(value[keys[keys.length - 1]]); 376 | } 377 | } 378 | 379 | 380 | function _Debugger_init(value) 381 | { 382 | if (typeof value === 'boolean') 383 | { 384 | return A3(__Expando_Constructor, __Maybe_Just(value ? 'True' : 'False'), true, __List_Nil); 385 | } 386 | 387 | if (typeof value === 'number') 388 | { 389 | return __Expando_Primitive(value + ''); 390 | } 391 | 392 | if (typeof value === 'string') 393 | { 394 | return __Expando_S('"' + _Debugger_addSlashes(value, false) + '"'); 395 | } 396 | 397 | if (value instanceof String) 398 | { 399 | return __Expando_S("'" + _Debugger_addSlashes(value, true) + "'"); 400 | } 401 | 402 | if (typeof value === 'object' && '$' in value) 403 | { 404 | var tag = value.$; 405 | 406 | if (tag === '::' || tag === '[]') 407 | { 408 | return A3(__Expando_Sequence, __Expando_ListSeq, true, 409 | A2(__List_map, _Debugger_init, value) 410 | ); 411 | } 412 | 413 | if (tag === 'Set_elm_builtin') 414 | { 415 | return A3(__Expando_Sequence, __Expando_SetSeq, true, 416 | A3(__Set_foldr, _Debugger_initCons, __List_Nil, value) 417 | ); 418 | } 419 | 420 | if (tag === 'RBNode_elm_builtin' || tag == 'RBEmpty_elm_builtin') 421 | { 422 | return A2(__Expando_Dictionary, true, 423 | A3(__Dict_foldr, _Debugger_initKeyValueCons, __List_Nil, value) 424 | ); 425 | } 426 | 427 | if (tag === 'Array_elm_builtin') 428 | { 429 | return A3(__Expando_Sequence, __Expando_ArraySeq, true, 430 | A3(__Array_foldr, _Debugger_initCons, __List_Nil, value) 431 | ); 432 | } 433 | 434 | if (typeof tag === 'number') 435 | { 436 | return __Expando_Primitive('<internals>'); 437 | } 438 | 439 | var char = tag.charCodeAt(0); 440 | if (char === 35 || 65 <= char && char <= 90) 441 | { 442 | var list = __List_Nil; 443 | for (var i in value) 444 | { 445 | if (i === '$') continue; 446 | list = __List_Cons(_Debugger_init(value[i]), list); 447 | } 448 | return A3(__Expando_Constructor, char === 35 ? __Maybe_Nothing : __Maybe_Just(tag), true, __List_reverse(list)); 449 | } 450 | 451 | return __Expando_Primitive('<internals>'); 452 | } 453 | 454 | if (typeof value === 'object') 455 | { 456 | var dict = __Dict_empty; 457 | for (var i in value) 458 | { 459 | dict = A3(__Dict_insert, i, _Debugger_init(value[i]), dict); 460 | } 461 | return A2(__Expando_Record, true, dict); 462 | } 463 | 464 | return __Expando_Primitive('<internals>'); 465 | } 466 | 467 | var _Debugger_initCons = F2(function initConsHelp(value, list) 468 | { 469 | return __List_Cons(_Debugger_init(value), list); 470 | }); 471 | 472 | var _Debugger_initKeyValueCons = F3(function(key, value, list) 473 | { 474 | return __List_Cons( 475 | __Utils_Tuple2(_Debugger_init(key), _Debugger_init(value)), 476 | list 477 | ); 478 | }); 479 | 480 | function _Debugger_addSlashes(str, isChar) 481 | { 482 | var s = str 483 | .replace(/\\/g, '\\\\') 484 | .replace(/\n/g, '\\n') 485 | .replace(/\t/g, '\\t') 486 | .replace(/\r/g, '\\r') 487 | .replace(/\v/g, '\\v') 488 | .replace(/\0/g, '\\0'); 489 | if (isChar) 490 | { 491 | return s.replace(/\'/g, '\\\''); 492 | } 493 | else 494 | { 495 | return s.replace(/\"/g, '\\"'); 496 | } 497 | } 498 | 499 | 500 | 501 | // BLOCK EVENTS 502 | 503 | 504 | function _Debugger_updateBlocker(oldBlocker, newBlocker) 505 | { 506 | if (oldBlocker === newBlocker) return; 507 | 508 | var oldEvents = _Debugger_blockerToEvents(oldBlocker); 509 | var newEvents = _Debugger_blockerToEvents(newBlocker); 510 | 511 | // remove old blockers 512 | for (var i = 0; i < oldEvents.length; i++) 513 | { 514 | document.removeEventListener(oldEvents[i], _Debugger_blocker, true); 515 | } 516 | 517 | // add new blockers 518 | for (var i = 0; i < newEvents.length; i++) 519 | { 520 | document.addEventListener(newEvents[i], _Debugger_blocker, true); 521 | } 522 | } 523 | 524 | 525 | function _Debugger_blocker(event) 526 | { 527 | if (event.type === 'keydown' && event.metaKey && event.which === 82) 528 | { 529 | return; 530 | } 531 | 532 | var isScroll = event.type === 'scroll' || event.type === 'wheel'; 533 | for (var node = event.target; node; node = node.parentNode) 534 | { 535 | if (isScroll ? node.id === 'elm-debugger-details' : node.id === 'elm-debugger-overlay') 536 | { 537 | return; 538 | } 539 | } 540 | 541 | event.stopPropagation(); 542 | event.preventDefault(); 543 | } 544 | 545 | function _Debugger_blockerToEvents(blocker) 546 | { 547 | return blocker === __Overlay_BlockNone 548 | ? [] 549 | : blocker === __Overlay_BlockMost 550 | ? _Debugger_mostEvents 551 | : _Debugger_allEvents; 552 | } 553 | 554 | var _Debugger_mostEvents = [ 555 | 'click', 'dblclick', 'mousemove', 556 | 'mouseup', 'mousedown', 'mouseenter', 'mouseleave', 557 | 'touchstart', 'touchend', 'touchcancel', 'touchmove', 558 | 'pointerdown', 'pointerup', 'pointerover', 'pointerout', 559 | 'pointerenter', 'pointerleave', 'pointermove', 'pointercancel', 560 | 'dragstart', 'drag', 'dragend', 'dragenter', 'dragover', 'dragleave', 'drop', 561 | 'keyup', 'keydown', 'keypress', 562 | 'input', 'change', 563 | 'focus', 'blur' 564 | ]; 565 | 566 | var _Debugger_allEvents = _Debugger_mostEvents.concat('wheel', 'scroll'); 567 | --------------------------------------------------------------------------------

├── .gitignore ├── LICENSE ├── README.md ├── elm.json ├── examples ├── README.md ├── elm.json └── src │ └── Drag.elm ├── notes ├── chat.svg ├── getElement.svg ├── getViewport.svg ├── getViewportOf.svg ├── keyboard.md └── navigation-in-elements.md └── src ├── Browser.elm ├── Browser ├── AnimationManager.elm ├── Dom.elm ├── Events.elm └── Navigation.elm ├── Debugger ├── Expando.elm ├── History.elm ├── Main.elm ├── Metadata.elm ├── Overlay.elm └── Report.elm └── Elm └── Kernel ├── Browser.js ├── Browser.server.js └── Debugger.js /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2017-present Evan Czaplicki 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Elm in the Browser! 2 | 3 | This package allows you to create Elm programs that run in browsers. 4 | 5 | 6 | ## Learning Path 7 | 8 | **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. 9 | 10 | [guide]: https://guide.elm-lang.org/ 11 | 12 | You can see the outline of that learning path in the `Browser` module. It lets you create Elm programs with the following functions: 13 | 14 | 1. [`sandbox`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#sandbox) — react to user input, like buttons and checkboxes 15 | 2. [`element`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#element) — talk to the outside world, like HTTP and JS interop 16 | 3. [`document`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#document) — control the `` and `<body>` 17 | 4. [`application`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#application) — create single-page apps 18 | 19 | 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!** 20 | 21 | 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. 22 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "elm/browser", 4 | "summary": "Run Elm in browsers, with access to browser history for single-page apps (SPAs)", 5 | "license": "BSD-3-Clause", 6 | "version": "1.0.2", 7 | "exposed-modules": [ 8 | "Browser", 9 | "Browser.Dom", 10 | "Browser.Events", 11 | "Browser.Navigation" 12 | ], 13 | "elm-version": "0.19.0 <= v < 0.20.0", 14 | "dependencies": { 15 | "elm/core": "1.0.0 <= v < 2.0.0", 16 | "elm/html": "1.0.0 <= v < 2.0.0", 17 | "elm/json": "1.0.0 <= v < 2.0.0", 18 | "elm/time": "1.0.0 <= v < 2.0.0", 19 | "elm/url": "1.0.0 <= v < 2.0.0", 20 | "elm/virtual-dom": "1.0.2 <= v < 2.0.0" 21 | }, 22 | "test-dependencies": {} 23 | } 24 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | # Examples 2 | 3 | To compile these examples locally, run the following terminal commands: 4 | 5 | ``` 6 | git clone https://github.com/elm/browser.git 7 | cd browser/examples 8 | elm reactor 9 | ``` 10 | 11 | Now go to [`http://localhost:8000`](http://localhost:8000) and navigate to whatever Elm file you want to see. 12 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.2", 10 | "elm/core": "1.0.2", 11 | "elm/html": "1.0.0", 12 | "elm/json": "1.1.3" 13 | }, 14 | "indirect": { 15 | "elm/time": "1.0.0", 16 | "elm/url": "1.0.0", 17 | "elm/virtual-dom": "1.0.2" 18 | } 19 | }, 20 | "test-dependencies": { 21 | "direct": {}, 22 | "indirect": {} 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /examples/src/Drag.elm: -------------------------------------------------------------------------------- 1 | module Drag exposing (main) 2 | 3 | {- You know how the editor on the Elm website has two side-by-side panels that 4 | can be resized? This is a rough implementation of that sort of thing. 5 | 6 | APPROACH: 7 | 1. Have a normal "mousedown" event on the drag zone. 8 | 2. When a drag begins, listen for global onMouseMove and onMouseUp events. 9 | 3. Check which buttons are down on mouse moves to detect a weird scenario. 10 | 11 | -} 12 | 13 | 14 | import Browser 15 | import Browser.Events as E 16 | import Html exposing (..) 17 | import Html.Attributes exposing (..) 18 | import Html.Events exposing (..) 19 | import Json.Decode as D 20 | 21 | 22 | 23 | -- MAIN 24 | 25 | 26 | main = 27 | Browser.element 28 | { init = init 29 | , view = view 30 | , update = update 31 | , subscriptions = subscriptions 32 | } 33 | 34 | 35 | 36 | -- MODEL 37 | 38 | 39 | type alias Model = 40 | { dragState : DragState 41 | } 42 | 43 | 44 | type DragState 45 | = Static Float 46 | | Moving Float 47 | 48 | 49 | init : () -> (Model, Cmd Msg) 50 | init _ = 51 | ( { dragState = Static 0.5 } 52 | , Cmd.none 53 | ) 54 | 55 | 56 | 57 | -- UPDATE 58 | 59 | 60 | type Msg 61 | = DragStart 62 | | DragMove Bool Float 63 | | DragStop Float 64 | 65 | 66 | update : Msg -> Model -> (Model, Cmd Msg) 67 | update msg model = 68 | case msg of 69 | DragStart -> 70 | ( { model | dragState = Moving (toFraction model.dragState) } 71 | , Cmd.none 72 | ) 73 | 74 | DragMove isDown fraction -> 75 | ( { model | dragState = if isDown then Moving fraction else Static (toFraction model.dragState) } 76 | , Cmd.none 77 | ) 78 | 79 | DragStop fraction -> 80 | ( { model | dragState = Static fraction } 81 | , Cmd.none 82 | ) 83 | 84 | 85 | toFraction : DragState -> Float 86 | toFraction dragState = 87 | case dragState of 88 | Static fraction -> fraction 89 | Moving fraction -> fraction 90 | 91 | 92 | 93 | -- VIEW 94 | 95 | 96 | view : Model -> Html Msg 97 | view model = 98 | let 99 | fraction = toFraction model.dragState 100 | pointerEvents = toPointerEvents model.dragState 101 | in 102 | div 103 | [ style "margin" "0" 104 | , style "padding" "0" 105 | , style "width" "100vw" 106 | , style "height" "100vh" 107 | , style "font-family" "monospace" 108 | , style "display" "flex" 109 | , style "flex-direction" "row" 110 | ] 111 | [ viewPanel "#222" "#ddd" fraction pointerEvents 112 | , viewDragZone fraction 113 | , viewPanel "#ddd" "#222" (1 - fraction) pointerEvents 114 | ] 115 | 116 | 117 | toPointerEvents : DragState -> String 118 | toPointerEvents dragState = 119 | case dragState of 120 | Static _ -> "auto" 121 | Moving _ -> "none" 122 | 123 | 124 | 125 | {- The "user-select" and "pointer-event" properties are "none" when resizing, 126 | ensuring that text does not get highlighted as the mouse moves. 127 | -} 128 | viewPanel : String -> String -> Float -> String -> Html msg 129 | viewPanel background foreground fraction pointerEvents = 130 | div 131 | [ style "width" (String.fromFloat (100 * fraction) ++ "vw") 132 | , style "height" "100vh" 133 | , style "user-select" pointerEvents 134 | , style "pointer-events" pointerEvents 135 | -- 136 | , style "background-color" background 137 | , style "color" foreground 138 | , style "font-size" "3em" 139 | -- 140 | , style "display" "flex" 141 | , style "justify-content" "center" 142 | , style "align-items" "center" 143 | ] 144 | [ text (String.left 5 (String.fromFloat (100 * fraction)) ++ "%") 145 | ] 146 | 147 | 148 | 149 | -- VIEW DRAG ZONE 150 | 151 | 152 | {- This does a few tricks to create an invisible drag zone: 153 | 154 | 1. "z-index" is a high number so that this node is in front of both panels. 155 | 2. "width" is 10px so there is something to grab onto. 156 | 3. "position" is absolute so the "width" does not disrupt the panels. 157 | 4. "margin-left" is -5px such that this node overhangs both panels. 158 | 159 | You could avoid the 4th trick by setting "left" to "calc(50vw - 5px)" but I 160 | do not know if there is a strong benefit to one approach or the other. 161 | -} 162 | viewDragZone : Float -> Html Msg 163 | viewDragZone fraction = 164 | div 165 | [ style "position" "absolute" 166 | , style "top" "0" 167 | , style "left" (String.fromFloat (100 * fraction) ++ "vw") 168 | , style "width" "10px" 169 | , style "height" "100vh" 170 | , style "margin-left" "-5px" 171 | , style "cursor" "col-resize" 172 | , style "z-index" "10" 173 | , on "mousedown" (D.succeed DragStart) 174 | ] 175 | [] 176 | 177 | 178 | 179 | -- SUBSCRIPTIONS 180 | 181 | 182 | {- We listen for the "mousemove" and "mouseup" events for the whole window. 183 | This way we catch all events, even if they are not on our drag zone. 184 | 185 | Listening for mouse moves is costly though, so we only listen if there is an 186 | ongoing drag. 187 | -} 188 | subscriptions : Model -> Sub Msg 189 | subscriptions model = 190 | case model.dragState of 191 | Static _ -> 192 | Sub.none 193 | 194 | Moving _ -> 195 | Sub.batch 196 | [ E.onMouseMove (D.map2 DragMove decodeButtons decodeFraction) 197 | , E.onMouseUp (D.map DragStop decodeFraction) 198 | ] 199 | 200 | 201 | {- The goal here is to get (mouse x / window width) on each mouse event. So if 202 | the mouse is at 500px and the screen is 1000px wide, we should get 0.5 from this. 203 | 204 | Getting the mouse x is not too hard, but getting window width is a bit tricky. 205 | We want the window.innerWidth value, which happens to be available at: 206 | 207 | event.currentTarget.defaultView.innerWidth 208 | 209 | The value at event.currentTarget is the document in these cases, but this will 210 | not work if you have a <section> or a <div> with a normal elm/html event handler. 211 | So if currentTarget is NOT the document, you should instead get the value at: 212 | 213 | event.currentTarget.ownerDocument.defaultView.innerWidth 214 | ^^^^^^^^^^^^^ 215 | -} 216 | decodeFraction : D.Decoder Float 217 | decodeFraction = 218 | D.map2 (/) 219 | (D.field "pageX" D.float) 220 | (D.at ["currentTarget","defaultView","innerWidth"] D.float) 221 | 222 | 223 | {- What happens when the user is dragging, but the "mouse up" occurs outside 224 | the browser window? We need to stop listening for mouse movement and end the 225 | drag. We use MouseEvent.buttons to detect this: 226 | 227 | https://developer.mozilla.org/en-US/docs/Web/API/MouseEvent/buttons 228 | 229 | The "buttons" value is 1 when "left-click" is pressed, so we use that to 230 | detect zombie drags. 231 | -} 232 | decodeButtons : D.Decoder Bool 233 | decodeButtons = 234 | D.field "buttons" (D.map (\buttons -> buttons == 1) D.int) 235 | -------------------------------------------------------------------------------- /notes/chat.svg: -------------------------------------------------------------------------------- 1 | <svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:lucid="lucid" width="1040" height="738"><g transform="translate(1642 3826)" lucid:page-tab-id="C9eM8j.usj1J"><path d="M-1600-3741.82h960V-3120h-960z" stroke="#ccc" stroke-width="10" fill="#834187"/><path d="M-1600-3780h960v29h-960z" stroke="#ccc" stroke-width="10" fill="#ccc"/><path d="M-1560-3760.82c0 5.52-4.48 10-10 10s-10-4.48-10-10 4.48-10 10-10 10 4.48 10 10z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#c92d39"/><path d="M-1530-3760.82c0 5.52-4.48 10-10 10s-10-4.48-10-10 4.48-10 10-10 10 4.48 10 10z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#fcc438"/><path d="M-1500-3760.82c0 5.52-4.48 10-10 10s-10-4.48-10-10 4.48-10 10-10 10 4.48 10 10z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#7ab648"/><path d="M-900-3360h220v242.18h-220z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#e5e5e5"/><path d="M-880-3340h120v40h-120z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#fff"/><use xlink:href="#a" transform="matrix(1,0,0,1,-875,-3335) translate(0 10.666666666666668)"/><use xlink:href="#b" transform="matrix(1,0,0,1,-875,-3335) translate(20.703703703703702 10.666666666666668)"/><use xlink:href="#c" transform="matrix(1,0,0,1,-875,-3335) translate(41.407407407407405 10.666666666666668)"/><use xlink:href="#d" transform="matrix(1,0,0,1,-875,-3335) translate(74 10.666666666666668)"/><use xlink:href="#e" transform="matrix(1,0,0,1,-875,-3335) translate(0 26.666666666666668)"/><use xlink:href="#f" transform="matrix(1,0,0,1,-875,-3335) translate(38.48148148148148 26.666666666666668)"/><path d="M-820-3280h120v40h-120z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#3aa6dd"/><g><use xlink:href="#g" transform="matrix(1,0,0,1,-815,-3275) translate(0 10.666666666666668)"/><use xlink:href="#h" transform="matrix(1,0,0,1,-815,-3275) translate(28.888888888888893 10.666666666666668)"/><use xlink:href="#i" transform="matrix(1,0,0,1,-815,-3275) translate(57.037037037037045 10.666666666666668)"/><use xlink:href="#j" transform="matrix(1,0,0,1,-815,-3275) translate(64.44444444444446 10.666666666666668)"/><use xlink:href="#k" transform="matrix(1,0,0,1,-815,-3275) translate(0 26.666666666666668)"/><use xlink:href="#l" transform="matrix(1,0,0,1,-815,-3275) translate(38.518518518518526 26.666666666666668)"/><use xlink:href="#m" transform="matrix(1,0,0,1,-815,-3275) translate(60.74074074074075 26.666666666666668)"/></g><path d="M-820-3220h120v58h-120z" stroke="#000" stroke-opacity="0" stroke-width="2" fill="#3aa6dd"/><g><use xlink:href="#n" transform="matrix(1,0,0,1,-815,-3215) translate(0 11.166666666666664)"/><use xlink:href="#o" transform="matrix(1,0,0,1,-815,-3215) translate(37.2962962962963 11.166666666666664)"/><use xlink:href="#p" transform="matrix(1,0,0,1,-815,-3215) translate(58 11.166666666666664)"/><use xlink:href="#q" transform="matrix(1,0,0,1,-815,-3215) translate(0 27.166666666666664)"/><use xlink:href="#r" transform="matrix(1,0,0,1,-815,-3215) translate(24.407407407407412 27.166666666666664)"/><use xlink:href="#s" transform="matrix(1,0,0,1,-815,-3215) translate(49.555555555555564 27.166666666666664)"/><use xlink:href="#t" transform="matrix(1,0,0,1,-815,-3215) translate(0 43.16666666666667)"/></g><path d="M-689-3183v60" stroke="#999" stroke-width="6" fill="none"/><defs><path d="M30-248c118-7 216 8 213 122C240-48 200 0 122 0H30v-248zM63-27c89 8 146-16 146-99s-60-101-146-95v194" id="u"/><path d="M100-194c62-1 85 37 85 99 1 63-27 99-86 99S16-35 15-95c0-66 28-99 85-99zM99-20c44 1 53-31 53-75 0-43-8-75-51-75s-53 32-53 75 10 74 51 75" id="v"/><g id="a"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#u"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#v"/></g><path d="M206 0h-36l-40-164L89 0H53L-1-190h32L70-26l43-164h34l41 164 42-164h31" id="w"/><path d="M100-194c63 0 86 42 84 106H49c0 40 14 67 53 68 26 1 43-12 49-29l28 8c-11 28-37 45-77 45C44 4 14-33 15-96c1-61 26-98 85-98zm52 81c6-60-76-77-97-28-3 7-6 17-6 28h103" id="x"/><g id="b"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#w"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#x"/></g><path d="M106-169C34-169 62-67 57 0H25v-261h32l-1 103c12-21 28-36 61-36 89 0 53 116 60 194h-32v-121c2-32-8-49-39-48" id="y"/><path d="M141-36C126-15 110 5 73 4 37 3 15-17 15-53c-1-64 63-63 125-63 3-35-9-54-41-54-24 1-41 7-42 31l-33-3c5-37 33-52 76-52 45 0 72 20 72 64v82c-1 20 7 32 28 27v20c-31 9-61-2-59-35zM48-53c0 20 12 33 32 33 41-3 63-29 60-74-43 2-92-5-92 41" id="z"/><path d="M108 0H70L1-190h34L89-25l56-165h34" id="A"/><g id="c"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#y"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#z"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#A"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,21.481481481481485,0)" xlink:href="#x"/></g><path d="M117-194c89-4 53 116 60 194h-32v-121c0-31-8-49-39-48C34-167 62-67 57 0H25l-1-190h30c1 10-1 24 2 32 11-22 29-35 61-36" id="B"/><path d="M179-190L93 31C79 59 56 82 12 73V49c39 6 53-20 64-50L1-190h34L92-34l54-156h33" id="C"/><g id="d"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#z"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#B"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#C"/></g><path d="M135-143c-3-34-86-38-87 0 15 53 115 12 119 90S17 21 10-45l28-5c4 36 97 45 98 0-10-56-113-15-118-90-4-57 82-63 122-42 12 7 21 19 24 35" id="D"/><path d="M59-47c-2 24 18 29 38 22v24C64 9 27 4 27-40v-127H5v-23h24l9-43h21v43h35v23H59v120" id="E"/><g id="e"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#D"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,6.666666666666668,0)" xlink:href="#w"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,16.25925925925926,0)" xlink:href="#x"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,23.66666666666667,0)" xlink:href="#x"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,31.07407407407408,0)" xlink:href="#E"/></g><path d="M115-194c55 1 70 41 70 98S169 2 115 4C84 4 66-9 55-30l1 105H24l-1-265h31l2 30c10-21 28-34 59-34zm-8 174c40 0 45-34 45-75s-6-73-45-74c-42 0-51 32-51 76 0 43 10 73 51 73" id="F"/><path d="M103-251c84 0 111 97 45 133-19 10-37 24-39 52H78c0-63 77-55 77-114 0-30-21-42-52-43-32 0-53 17-56 46l-32-2c7-45 34-72 88-72zM77 0v-35h34V0H77" id="G"/><g id="f"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#F"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#v"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#E"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,18.51851851851852,0)" xlink:href="#z"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,25.92592592592593,0)" xlink:href="#E"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,29.629629629629633,0)" xlink:href="#v"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,37.03703703703704,0)" xlink:href="#x"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,44.44444444444444,0)" xlink:href="#D"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,51.11111111111112,0)" xlink:href="#G"/></g><path fill="#fff" d="M140-251c81 0 123 46 123 126C263-46 219 4 140 4 59 4 17-45 17-125s42-126 123-126zm0 227c63 0 89-41 89-101s-29-99-89-99c-61 0-89 39-89 99S79-25 140-24" id="H"/><path fill="#fff" d="M117-194c89-4 53 116 60 194h-32v-121c0-31-8-49-39-48C34-167 62-67 57 0H25l-1-190h30c1 10-1 24 2 32 11-22 29-35 61-36" id="I"/><path fill="#fff" d="M100-194c63 0 86 42 84 106H49c0 40 14 67 53 68 26 1 43-12 49-29l28 8c-11 28-37 45-77 45C44 4 14-33 15-96c1-61 26-98 85-98zm52 81c6-60-76-77-97-28-3 7-6 17-6 28h103" id="J"/><g id="g"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#H"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,10.370370370370372,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,17.77777777777778,0)" xlink:href="#J"/></g><path fill="#fff" d="M135-143c-3-34-86-38-87 0 15 53 115 12 119 90S17 21 10-45l28-5c4 36 97 45 98 0-10-56-113-15-118-90-4-57 82-63 122-42 12 7 21 19 24 35" id="K"/><path fill="#fff" d="M96-169c-40 0-48 33-48 73s9 75 48 75c24 0 41-14 43-38l32 2c-6 37-31 61-74 61-59 0-76-41-82-99-10-93 101-131 147-64 4 7 5 14 7 22l-32 3c-4-21-16-35-41-35" id="L"/><path fill="#fff" d="M33 0v-38h34V0H33" id="M"/><g id="h"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#K"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,6.666666666666668,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.074074074074076,0)" xlink:href="#L"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,20.740740740740744,0)" xlink:href="#M"/></g><path fill="#fff" d="M33 0v-248h34V0H33" id="N"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#N" id="i"/><path fill="#fff" d="M206 0h-36l-40-164L89 0H53L-1-190h32L70-26l43-164h34l41 164 42-164h31" id="O"/><path fill="#fff" d="M24-231v-30h32v30H24zM24 0v-190h32V0H24" id="P"/><path fill="#fff" d="M24 0v-261h32V0H24" id="Q"/><g id="j"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#O"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#P"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,12.518518518518517,0)" xlink:href="#Q"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,15.444444444444446,0)" xlink:href="#Q"/></g><path fill="#fff" d="M106-169C34-169 62-67 57 0H25v-261h32l-1 103c12-21 28-36 61-36 89 0 53 116 60 194h-32v-121c2-32-8-49-39-48" id="R"/><path fill="#fff" d="M143 0L79-87 56-68V0H24v-261h32v163l83-92h37l-77 82L181 0h-38" id="S"/><g id="k"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#L"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,6.666666666666668,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.074074074074076,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,21.481481481481485,0)" xlink:href="#L"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,28.148148148148152,0)" xlink:href="#S"/></g><path fill="#fff" d="M59-47c-2 24 18 29 38 22v24C64 9 27 4 27-40v-127H5v-23h24l9-43h21v43h35v23H59v120" id="T"/><g id="l"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,3.703703703703704,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,11.111111111111112,0)" xlink:href="#J"/></g><path fill="#fff" d="M115-194c55 1 70 41 70 98S169 2 115 4C84 4 66-9 55-30l1 105H24l-1-265h31l2 30c10-21 28-34 59-34zm-8 174c40 0 45-34 45-75s-6-73-45-74c-42 0-51 32-51 76 0 43 10 73 51 73" id="U"/><path fill="#fff" d="M141-36C126-15 110 5 73 4 37 3 15-17 15-53c-1-64 63-63 125-63 3-35-9-54-41-54-24 1-41 7-42 31l-33-3c5-37 33-52 76-52 45 0 72 20 72 64v82c-1 20 7 32 28 27v20c-31 9-61-2-59-35zM48-53c0 20 12 33 32 33 41-3 63-29 60-74-43 2-92-5-92 41" id="V"/><path fill="#fff" d="M114-163C36-179 61-72 57 0H25l-1-190h30c1 12-1 29 2 39 6-27 23-49 58-41v29" id="W"/><path fill="#fff" d="M179-190L93 31C79 59 56 82 12 73V49c39 6 53-20 64-50L1-190h34L92-34l54-156h33" id="X"/><g id="m"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#U"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,22.222222222222225,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,25.92592592592593,0)" xlink:href="#W"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,30.333333333333336,0)" xlink:href="#X"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,36.00000000000001,0)" xlink:href="#M"/></g><path fill="#fff" d="M137-103V0h-34v-103L8-248h37l75 118 75-118h37" id="Y"/><path fill="#fff" d="M68-38c1 34 0 65-14 84H32c9-13 17-26 17-46H33v-38h35" id="Z"/><g id="n"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#Y"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.666666666666667,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,15.074074074074076,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,22.481481481481485,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,29.888888888888893,0)" xlink:href="#Z"/></g><g id="o"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#O"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,9.592592592592593,0)" xlink:href="#J"/></g><path fill="#fff" d="M108 0H70L1-190h34L89-25l56-165h34" id="aa"/><g id="p"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#R"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#aa"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,21.481481481481485,0)" xlink:href="#J"/></g><path fill="#fff" d="M100-194c62-1 85 37 85 99 1 63-27 99-86 99S16-35 15-95c0-66 28-99 85-99zM99-20c44 1 53-31 53-75 0-43-8-75-51-75s-53 32-53 75 10 74 51 75" id="ab"/><g id="q"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,3.703703703703704,0)" xlink:href="#O"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,13.296296296296298,0)" xlink:href="#ab"/></g><path fill="#fff" d="M101-234c-31-9-42 10-38 44h38v23H63V0H32v-167H5v-23h27c-7-52 17-82 69-68v24" id="ac"/><g id="r"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#Q"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,2.9259259259259265,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,10.333333333333334,0)" xlink:href="#ac"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.037037037037038,0)" xlink:href="#T"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,17.740740740740744,0)" xlink:href="#M"/></g><path fill="#fff" d="M143 4C61 4 22-44 18-125c-5-107 100-154 193-111 17 8 29 25 37 43l-32 9c-13-25-37-40-76-40-61 0-88 39-88 99 0 61 29 100 91 101 35 0 62-11 79-27v-45h-74v-28h105v86C228-13 192 4 143 4" id="ad"/><g id="s"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#ad"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,10.370370370370372,0)" xlink:href="#P"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,13.296296296296298,0)" xlink:href="#V"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,20.703703703703706,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,28.111111111111114,0)" xlink:href="#T"/></g><path fill="#fff" d="M63-70H37l-4-178h34zM33 0v-35h34V0H33" id="ae"/><g id="t"><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,0,0)" xlink:href="#ab"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,7.407407407407408,0)" xlink:href="#I"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,14.814814814814817,0)" xlink:href="#J"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,22.222222222222225,0)" xlink:href="#K"/><use transform="matrix(0.03703703703703704,0,0,0.03703703703703704,28.888888888888893,0)" xlink:href="#ae"/></g></defs></g></svg> -------------------------------------------------------------------------------- /notes/keyboard.md: -------------------------------------------------------------------------------- 1 | # Which key was pressed? 2 | 3 | When you're 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-fits-all solution. 4 | 5 | [ke]: https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent 6 | 7 | ## `charCode` vs `keyCode` vs `which` vs `key` vs `code` 8 | 9 | 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. 10 | 11 | [key]: https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/key 12 | 13 | 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). 14 | 15 | 16 | ## Writing a `key` decoder 17 | 18 | The simplest approach is to just decode the string value: 19 | 20 | ```elm 21 | import Json.Decode as Decode 22 | 23 | keyDecoder : Decode.Decoder String 24 | keyDecoder = 25 | Decode.field "key" Decode.string 26 | ``` 27 | 28 | Depending on your scenario, you may want something more elaborate though! 29 | 30 | 31 | ### Decoding for User Input 32 | 33 | 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: 34 | 35 | ```elm 36 | import Json.Decode as Decode 37 | 38 | type Key 39 | = Character Char 40 | | Control String 41 | 42 | keyDecoder : Decode.Decoder Key 43 | keyDecoder = 44 | Decode.map toKey (Decode.field "key" Decode.string) 45 | 46 | toKey : String -> Key 47 | toKey string = 48 | case String.uncons string of 49 | Just (char, "") -> 50 | Character char 51 | 52 | _ -> 53 | Control string 54 | ``` 55 | 56 | > **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! 57 | 58 | 59 | ### Decoding for Games 60 | 61 | Or maybe you want to handle left and right arrows specially for a game or a presentation viewer. You could do something like this: 62 | 63 | ```elm 64 | import Json.Decode as Decode 65 | 66 | type Direction 67 | = Left 68 | | Right 69 | | Other 70 | 71 | keyDecoder : Decode.Decoder Direction 72 | keyDecoder = 73 | Decode.map toDirection (Decode.field "key" Decode.string) 74 | 75 | toDirection : String -> Direction 76 | toDirection string = 77 | case string of 78 | "ArrowLeft" -> 79 | Left 80 | 81 | "ArrowRight" -> 82 | Right 83 | 84 | _ -> 85 | Other 86 | ``` 87 | 88 | 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. 89 | 90 | Hope that helps you write a decoder that works for your scenario! 91 | -------------------------------------------------------------------------------- /notes/navigation-in-elements.md: -------------------------------------------------------------------------------- 1 | # How do I manage URL from a `Browser.element`? 2 | 3 | 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. 4 | 5 | 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. 6 | 7 | What do you do? 8 | 9 | 10 | ## Managing the URL from `Browser.element` 11 | 12 | You would initialize your element like this: 13 | 14 | ```javascript 15 | // Initialize your Elm program 16 | var app = Elm.Main.init({ 17 | flags: location.href, 18 | node: document.getElementById('elm-main') 19 | }); 20 | 21 | // Inform app of browser navigation (the BACK and FORWARD buttons) 22 | window.addEventListener('popstate', function () { 23 | app.ports.onUrlChange.send(location.href); 24 | }); 25 | 26 | // Change the URL upon request, inform app of the change. 27 | app.ports.pushUrl.subscribe(function(url) { 28 | history.pushState({}, '', url); 29 | app.ports.onUrlChange.send(location.href); 30 | }); 31 | ``` 32 | 33 | 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 34 | anything like that. 35 | 36 | From there, your Elm code would look something like this: 37 | 38 | ```elm 39 | import Browser 40 | import Html exposing (..) 41 | import Html.Attributes exposing (..) 42 | import Html.Events exposing (..) 43 | import Json.Decode as D 44 | import Url 45 | import Url.Parser as Url 46 | 47 | 48 | main : Program String Model Msg 49 | main = 50 | Browser.element 51 | { init = init 52 | , view = view 53 | , update = update 54 | , subscriptions = subscriptions 55 | } 56 | 57 | 58 | type Msg = UrlChanged (Maybe Route) | ... 59 | 60 | 61 | -- INIT 62 | 63 | init : String -> ( Model, Cmd Msg ) 64 | init locationHref = 65 | ... 66 | 67 | 68 | -- SUBSCRIPTION 69 | 70 | subscriptions : Model -> Sub Msg 71 | subscriptions model = 72 | onUrlChange (locationHrefToRoute >> UrlChanged) 73 | 74 | 75 | -- NAVIGATION 76 | 77 | port onUrlChange : (String -> msg) -> Sub msg 78 | 79 | port pushUrl : String -> Cmd msg 80 | 81 | link : msg -> List (Attribute msg) -> List (Html msg) -> Html msg 82 | link href attrs children = 83 | a (preventDefaultOn "click" (D.succeed (href, True)) :: attrs) children 84 | 85 | locationHrefToRoute : String -> Maybe Route 86 | locationHrefToRoute locationHref = 87 | case Url.fromString locationHref of 88 | Nothing -> Nothing 89 | Just url -> Url.parse myParser url 90 | 91 | -- myParser : Url.Parser (Route -> Route) Route 92 | ``` 93 | 94 | So in contrast with `Browser.application`, you have to manage the URL yourself in JavaScript. What is up with that?! 95 | 96 | 97 | ## Justification 98 | 99 | 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. 100 | 101 | 102 | ### Reliability 103 | 104 | 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. 105 | 106 | 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. 107 | 108 | 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? 109 | 110 | > **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. 111 | 112 | 113 | ### Lines of Code 114 | 115 | 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? 116 | 117 | Well, the JavaScript code would be something like this: 118 | 119 | ```javascript 120 | var app = Elm.Main.init({ 121 | flags: ... 122 | }); 123 | ``` 124 | 125 | And in Elm: 126 | 127 | ```elm 128 | import Browser 129 | import Browser.Navigation as Nav 130 | import Url 131 | import Url.Parser as Url 132 | 133 | 134 | main : Program Flags Model Msg 135 | main = 136 | Browser.application 137 | { init = init 138 | , view = view 139 | , update = update 140 | , subscriptions = subscriptions 141 | , onUrlChange = UrlChanged 142 | , onUrlRequest = LinkClicked 143 | } 144 | 145 | 146 | type Msg = UrlChanged (Maybe Route) | ... 147 | 148 | 149 | -- INIT 150 | 151 | init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) 152 | init flags url key = 153 | ... 154 | 155 | 156 | -- SUBSCRIPTION 157 | 158 | subscriptions : Model -> Sub Msg 159 | subscriptions model = 160 | Sub.none 161 | 162 | 163 | -- NAVIGATION 164 | 165 | urlToRoute : Url.Url -> Maybe Route 166 | urlToRoute url = 167 | Url.parse myParser url 168 | 169 | -- myParser : Url.Parser (Route -> Route) Route 170 | ``` 171 | 172 | So the main differences are: 173 | 174 | 1. You can delete the ports in JavaScript (seven lines) 175 | 2. `port onUrlChanged` becomes `onUrlChanged` in `main` (zero lines) 176 | 3. `locationHrefToRoute` becomes `urlToRoute` (three lines) 177 | 4. `link` becomes `onUrlRequest` and handling code in `update` (depends) 178 | 179 | 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. 180 | 181 | 182 | ### Summary 183 | 184 | 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? 185 | 186 | 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. 187 | 188 | 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. 189 | -------------------------------------------------------------------------------- /src/Browser.elm: -------------------------------------------------------------------------------- 1 | module Browser exposing 2 | ( sandbox 3 | , element 4 | , document, Document 5 | , application, UrlRequest(..) 6 | ) 7 | 8 | {-| This module helps you set up an Elm `Program` with functions like 9 | [`sandbox`](#sandbox) and [`document`](#document). 10 | 11 | 12 | # Sandboxes 13 | 14 | @docs sandbox 15 | 16 | 17 | # Elements 18 | 19 | @docs element 20 | 21 | 22 | # Documents 23 | 24 | @docs document, Document 25 | 26 | 27 | # Applications 28 | 29 | @docs application, UrlRequest 30 | 31 | -} 32 | 33 | import Browser.Navigation as Navigation 34 | import Debugger.Main 35 | import Dict 36 | import Elm.Kernel.Browser 37 | import Html exposing (Html) 38 | import Url 39 | 40 | 41 | 42 | -- SANDBOX 43 | 44 | 45 | {-| Create a “sandboxed” program that cannot communicate with the outside 46 | world. 47 | 48 | This is great for learning the basics of [The Elm Architecture][tea]. You can 49 | see sandboxes in action in the following examples: 50 | 51 | - [Buttons](https://guide.elm-lang.org/architecture/buttons.html) 52 | - [Text Fields](https://guide.elm-lang.org/architecture/text_fields.html) 53 | - [Forms](https://guide.elm-lang.org/architecture/forms.html) 54 | 55 | Those are nice, but **I very highly recommend reading [this guide][guide] 56 | straight through** to really learn how Elm works. Understanding the 57 | fundamentals actually pays off in this language! 58 | 59 | [tea]: https://guide.elm-lang.org/architecture/ 60 | [guide]: https://guide.elm-lang.org/ 61 | 62 | -} 63 | sandbox : 64 | { init : model 65 | , view : model -> Html msg 66 | , update : msg -> model -> model 67 | } 68 | -> Program () model msg 69 | sandbox impl = 70 | Elm.Kernel.Browser.element 71 | { init = \() -> ( impl.init, Cmd.none ) 72 | , view = impl.view 73 | , update = \msg model -> ( impl.update msg model, Cmd.none ) 74 | , subscriptions = \_ -> Sub.none 75 | } 76 | 77 | 78 | 79 | -- ELEMENT 80 | 81 | 82 | {-| Create an HTML element managed by Elm. The resulting elements are easy to 83 | embed in larger JavaScript projects, and lots of companies that use Elm 84 | started with this approach! Try it out on something small. If it works, great, 85 | do more! If not, revert, no big deal. 86 | 87 | Unlike a [`sandbox`](#sandbox), an `element` can talk to the outside world in 88 | a couple ways: 89 | 90 | - `Cmd` — you can “command” the Elm runtime to do stuff, like HTTP. 91 | - `Sub` — you can “subscribe” to event sources, like clock ticks. 92 | - `flags` — JavaScript can pass in data when starting the Elm program 93 | - `ports` — set up a client-server relationship with JavaScript 94 | 95 | As you read [the guide][guide] you will run into a bunch of examples of `element` 96 | in [this section][fx]. You can learn more about flags and ports in [the interop 97 | section][interop]. 98 | 99 | [guide]: https://guide.elm-lang.org/ 100 | [fx]: https://guide.elm-lang.org/effects/ 101 | [interop]: https://guide.elm-lang.org/interop/ 102 | 103 | -} 104 | element : 105 | { init : flags -> ( model, Cmd msg ) 106 | , view : model -> Html msg 107 | , update : msg -> model -> ( model, Cmd msg ) 108 | , subscriptions : model -> Sub msg 109 | } 110 | -> Program flags model msg 111 | element = 112 | Elm.Kernel.Browser.element 113 | 114 | 115 | 116 | -- DOCUMENT 117 | 118 | 119 | {-| Create an HTML document managed by Elm. This expands upon what `element` 120 | can do in that `view` now gives you control over the `<title>` and `<body>`. 121 | -} 122 | document : 123 | { init : flags -> ( model, Cmd msg ) 124 | , view : model -> Document msg 125 | , update : msg -> model -> ( model, Cmd msg ) 126 | , subscriptions : model -> Sub msg 127 | } 128 | -> Program flags model msg 129 | document = 130 | Elm.Kernel.Browser.document 131 | 132 | 133 | {-| This data specifies the `<title>` and all of the nodes that should go in 134 | the `<body>`. This means you can update the title as your application changes. 135 | Maybe your "single-page app" navigates to a "different page", maybe a calendar 136 | app shows an accurate date in the title, etc. 137 | 138 | > **Note about CSS:** This looks similar to an `<html>` document, but this is 139 | > not the place to manage CSS assets. If you want to work with CSS, there are 140 | > a couple ways: 141 | > 142 | > 1. Packages like [`rtfeldman/elm-css`][elm-css] give all of the features 143 | > of CSS without any CSS files. You can add all the styles you need in your 144 | > `view` function, and there is no need to worry about class names matching. 145 | > 146 | > 2. Compile your Elm code to JavaScript with `elm make --output=elm.js` and 147 | > then make your own HTML file that loads `elm.js` and the CSS file you want. 148 | > With this approach, it does not matter where the CSS comes from. Write it 149 | > by hand. Generate it. Whatever you want to do. 150 | > 151 | > 3. If you need to change `<link>` tags dynamically, you can send messages 152 | > out a port to do it in JavaScript. 153 | > 154 | > The bigger point here is that loading assets involves touching the `<head>` 155 | > as an implementation detail of browsers, but that does not mean it should be 156 | > the responsibility of the `view` function in Elm. So we do it differently! 157 | 158 | [elm-css]: /packages/rtfeldman/elm-css/latest/ 159 | 160 | -} 161 | type alias Document msg = 162 | { title : String 163 | , body : List (Html msg) 164 | } 165 | 166 | 167 | 168 | -- APPLICATION 169 | 170 | 171 | {-| Create an application that manages [`Url`][url] changes. 172 | 173 | **When the application starts**, `init` gets the initial `Url`. You can show 174 | different things depending on the `Url`! 175 | 176 | **When someone clicks a link**, like `<a href="/home">Home</a>`, it always goes 177 | through `onUrlRequest`. The resulting message goes to your `update` function, 178 | giving you a chance to save scroll position or persist data before changing 179 | the URL yourself with [`pushUrl`][bnp] or [`load`][bnl]. More info on this in 180 | the [`UrlRequest`](#UrlRequest) docs! 181 | 182 | **When the URL changes**, the new `Url` goes through `onUrlChange`. The 183 | resulting message goes to `update` where you can decide what to show next. 184 | 185 | Applications always use the [`Browser.Navigation`][bn] module for precise 186 | control over `Url` changes. 187 | 188 | **More Info:** Here are some example usages of `application` programs: 189 | 190 | - [RealWorld example app](https://github.com/rtfeldman/elm-spa-example) 191 | - [Elm’s package website](https://github.com/elm/package.elm-lang.org) 192 | 193 | These are quite advanced Elm programs, so be sure to go through [the guide][g] 194 | first to get a solid conceptual foundation before diving in! If you start 195 | reading a calculus book from page 314, it might seem confusing. Same here! 196 | 197 | **Note:** Can an [`element`](#element) manage the URL too? Read [this]! 198 | 199 | [g]: https://guide.elm-lang.org/ 200 | [bn]: Browser-Navigation 201 | [bnp]: Browser-Navigation#pushUrl 202 | [bnl]: Browser-Navigation#load 203 | [url]: /packages/elm/url/latest/Url#Url 204 | [this]: https://github.com/elm/browser/blob/1.0.2/notes/navigation-in-elements.md 205 | 206 | -} 207 | application : 208 | { init : flags -> Url.Url -> Navigation.Key -> ( model, Cmd msg ) 209 | , view : model -> Document msg 210 | , update : msg -> model -> ( model, Cmd msg ) 211 | , subscriptions : model -> Sub msg 212 | , onUrlRequest : UrlRequest -> msg 213 | , onUrlChange : Url.Url -> msg 214 | } 215 | -> Program flags model msg 216 | application = 217 | Elm.Kernel.Browser.application 218 | 219 | 220 | {-| All links in an [`application`](#application) create a `UrlRequest`. So 221 | when you click `<a href="/home">Home</a>`, it does not just navigate! It 222 | notifies `onUrlRequest` that the user wants to change the `Url`. 223 | 224 | 225 | ### `Internal` vs `External` 226 | 227 | Imagine we are browsing `https://example.com`. An `Internal` link would be 228 | like: 229 | 230 | - `settings#privacy` 231 | - `/home` 232 | - `https://example.com/home` 233 | - `//example.com/home` 234 | 235 | All of these links exist under the `https://example.com` domain. An `External` 236 | link would be like: 237 | 238 | - `https://elm-lang.org/examples` 239 | - `https://other.example.com/home` 240 | - `http://example.com/home` 241 | 242 | Anything that changes the domain. Notice that changing the protocol from 243 | `https` to `http` is considered a different domain! (And vice versa!) 244 | 245 | 246 | ### Purpose 247 | 248 | Having a `UrlRequest` requires a case in your `update` like this: 249 | 250 | import Browser exposing (..) 251 | import Browser.Navigation as Nav 252 | import Url 253 | 254 | type Msg 255 | = ClickedLink UrlRequest 256 | 257 | update : Msg -> Model -> ( Model, Cmd msg ) 258 | update msg model = 259 | case msg of 260 | ClickedLink urlRequest -> 261 | case urlRequest of 262 | Internal url -> 263 | ( model 264 | , Nav.pushUrl model.key (Url.toString url) 265 | ) 266 | 267 | External url -> 268 | ( model 269 | , Nav.load url 270 | ) 271 | 272 | This is useful because it gives you a chance to customize the behavior in each 273 | case. Maybe on some `Internal` links you save the scroll position with 274 | [`Browser.Dom.getViewport`](Browser-Dom#getViewport) so you can restore it 275 | later. Maybe on `External` links you persist parts of the `Model` on your 276 | servers before leaving. Whatever you need to do! 277 | 278 | **Note:** Knowing the scroll position is not enough to restore it! What if the 279 | browser dimensions change? The scroll position will not correlate with 280 | “what was on screen” anymore. So it may be better to remember 281 | “what was on screen” and recreate the position based on that. For 282 | example, in a Wikipedia article, remember the header that they were looking at 283 | most recently. [`Browser.Dom.getElement`](Browser-Dom#getElement) is designed 284 | for figuring that out! 285 | 286 | -} 287 | type UrlRequest 288 | = Internal Url.Url 289 | | External String 290 | -------------------------------------------------------------------------------- /src/Browser/AnimationManager.elm: -------------------------------------------------------------------------------- 1 | effect module Browser.AnimationManager where { subscription = MySub } exposing 2 | ( onAnimationFrame 3 | , onAnimationFrameDelta 4 | ) 5 | 6 | import Elm.Kernel.Browser 7 | import Process 8 | import Task exposing (Task) 9 | import Time 10 | 11 | 12 | 13 | -- PUBLIC STUFF 14 | 15 | 16 | onAnimationFrame : (Time.Posix -> msg) -> Sub msg 17 | onAnimationFrame tagger = 18 | subscription (Time tagger) 19 | 20 | 21 | onAnimationFrameDelta : (Float -> msg) -> Sub msg 22 | onAnimationFrameDelta tagger = 23 | subscription (Delta tagger) 24 | 25 | 26 | 27 | -- SUBSCRIPTIONS 28 | 29 | 30 | type MySub msg 31 | = Time (Time.Posix -> msg) 32 | | Delta (Float -> msg) 33 | 34 | 35 | subMap : (a -> b) -> MySub a -> MySub b 36 | subMap func sub = 37 | case sub of 38 | Time tagger -> 39 | Time (func << tagger) 40 | 41 | Delta tagger -> 42 | Delta (func << tagger) 43 | 44 | 45 | 46 | -- EFFECT MANAGER 47 | 48 | 49 | type alias State msg = 50 | { subs : List (MySub msg) 51 | , request : Maybe Process.Id 52 | , oldTime : Int 53 | } 54 | 55 | 56 | 57 | -- NOTE: used in onEffects 58 | -- 59 | 60 | 61 | init : Task Never (State msg) 62 | init = 63 | Task.succeed (State [] Nothing 0) 64 | 65 | 66 | onEffects : Platform.Router msg Int -> List (MySub msg) -> State msg -> Task Never (State msg) 67 | onEffects router subs { request, oldTime } = 68 | case ( request, subs ) of 69 | ( Nothing, [] ) -> 70 | init 71 | 72 | ( Just pid, [] ) -> 73 | Process.kill pid 74 | |> Task.andThen (\_ -> init) 75 | 76 | ( Nothing, _ ) -> 77 | Process.spawn (Task.andThen (Platform.sendToSelf router) rAF) 78 | |> Task.andThen 79 | (\pid -> 80 | now 81 | |> Task.andThen (\time -> Task.succeed (State subs (Just pid) time)) 82 | ) 83 | 84 | ( Just _, _ ) -> 85 | Task.succeed (State subs request oldTime) 86 | 87 | 88 | onSelfMsg : Platform.Router msg Int -> Int -> State msg -> Task Never (State msg) 89 | onSelfMsg router newTime { subs, oldTime } = 90 | let 91 | send sub = 92 | case sub of 93 | Time tagger -> 94 | Platform.sendToApp router (tagger (Time.millisToPosix newTime)) 95 | 96 | Delta tagger -> 97 | Platform.sendToApp router (tagger (toFloat (newTime - oldTime))) 98 | in 99 | Process.spawn (Task.andThen (Platform.sendToSelf router) rAF) 100 | |> Task.andThen 101 | (\pid -> 102 | Task.sequence (List.map send subs) 103 | |> Task.andThen (\_ -> Task.succeed (State subs (Just pid) newTime)) 104 | ) 105 | 106 | 107 | rAF : Task x Int 108 | rAF = 109 | Elm.Kernel.Browser.rAF () 110 | 111 | 112 | now : Task x Int 113 | now = 114 | Elm.Kernel.Browser.now () 115 | -------------------------------------------------------------------------------- /src/Browser/Dom.elm: -------------------------------------------------------------------------------- 1 | module Browser.Dom exposing 2 | ( focus, blur, Error(..) 3 | , getViewport, Viewport, getViewportOf 4 | , setViewport, setViewportOf 5 | , getElement, Element 6 | ) 7 | 8 | {-| This module allows you to manipulate the DOM in various ways. It covers: 9 | 10 | - Focus and blur input elements. 11 | - Get the `width` and `height` of elements. 12 | - Get the `x` and `y` coordinates of elements. 13 | - Figure out the scroll position. 14 | - Change the scroll position! 15 | 16 | We use different terminology than JavaScript though... 17 | 18 | 19 | # Terminology 20 | 21 | Have you ever thought about how “scrolling” is a metaphor about 22 | scrolls? Like hanging scrolls of caligraphy made during the Han Dynasty 23 | in China? 24 | 25 | This metaphor falls apart almost immediately though. For example, many scrolls 26 | read horizontally! Like a [Sefer Torah][torah] or [Chinese Handscrolls][hand]. 27 | The two sides move independently, sometimes kept in place with stones. What is 28 | a scroll bar in this world? And [hanging scrolls][hang] (which _are_ displayed 29 | vertically) do not “scroll” at all! They hang! 30 | 31 | So in JavaScript, we start with a badly stretched metaphor and add a bunch of 32 | DOM details like padding, borders, and margins. How do those relate to scrolls? 33 | For example, JavaScript has `clientWidth`. Client like a feudal state that pays 34 | tribute to the emperor? And `offsetHeight`. Can an offset even have height? And 35 | what has that got to do with scrolls? 36 | 37 | So instead of inheriting this metaphorical hodge-podge, we use terminology from 38 | 3D graphics. You have a **scene** containing all your elements and a **viewport** 39 | into the scene. I think it ends up being a lot clearer, but you can evaluate 40 | for yourself when you see the diagrams later! 41 | 42 | **Note:** For more scroll facts, I recommend [A Day on the Grand Canal with 43 | the Emperor of China or: Surface Is Illusion But So Is Depth][doc] where David 44 | Hockney explores the history of _perspective_ in art. Really interesting! 45 | 46 | [torah]: https://en.wikipedia.org/wiki/Sefer_Torah 47 | [hand]: https://www.metmuseum.org/toah/hd/chhs/hd_chhs.htm 48 | [hang]: https://en.wikipedia.org/wiki/Hanging_scroll 49 | [doc]: https://www.imdb.com/title/tt0164525/ 50 | 51 | 52 | # Focus 53 | 54 | @docs focus, blur, Error 55 | 56 | 57 | # Get Viewport 58 | 59 | @docs getViewport, Viewport, getViewportOf 60 | 61 | 62 | # Set Viewport 63 | 64 | @docs setViewport, setViewportOf 65 | 66 | 67 | # Position 68 | 69 | @docs getElement, Element 70 | 71 | -} 72 | 73 | import Elm.Kernel.Browser 74 | import Task exposing (Task) 75 | 76 | 77 | 78 | -- FOCUS 79 | 80 | 81 | {-| Find a DOM node by `id` and focus on it. So if you wanted to focus a node 82 | like `<input type="text" id="search-box">` you could say: 83 | 84 | import Browser.Dom as Dom 85 | import Task 86 | 87 | type Msg 88 | = NoOp 89 | 90 | focusSearchBox : Cmd Msg 91 | focusSearchBox = 92 | Task.attempt (\_ -> NoOp) (Dom.focus "search-box") 93 | 94 | Notice that this code ignores the possibility that `search-box` is not used 95 | as an `id` by any node, failing silently in that case. It would be better to 96 | log the failure with whatever error reporting system you use. 97 | 98 | -} 99 | focus : String -> Task Error () 100 | focus = 101 | Elm.Kernel.Browser.call "focus" 102 | 103 | 104 | {-| Find a DOM node by `id` and make it lose focus. So if you wanted a node 105 | like `<input type="text" id="search-box">` to lose focus you could say: 106 | 107 | import Browser.Dom as Dom 108 | import Task 109 | 110 | type Msg 111 | = NoOp 112 | 113 | unfocusSearchBox : Cmd Msg 114 | unfocusSearchBox = 115 | Task.attempt (\_ -> NoOp) (Dom.blur "search-box") 116 | 117 | Notice that this code ignores the possibility that `search-box` is not used 118 | as an `id` by any node, failing silently in that case. It would be better to 119 | log the failure with whatever error reporting system you use. 120 | 121 | -} 122 | blur : String -> Task Error () 123 | blur = 124 | Elm.Kernel.Browser.call "blur" 125 | 126 | 127 | 128 | -- ERROR 129 | 130 | 131 | {-| Many functions in this module look up DOM nodes up by their `id`. If you 132 | ask for an `id` that is not in the DOM, you will get this error. 133 | -} 134 | type Error 135 | = NotFound String 136 | 137 | 138 | 139 | -- VIEWPORT 140 | 141 | 142 | {-| Get information on the current viewport of the browser. 143 | 144 | ![getViewport](https://elm.github.io/browser/v1/getViewport.svg) 145 | 146 | If you want to move the viewport around (i.e. change the scroll position) you 147 | can use [`setViewport`](#setViewport) which change the `x` and `y` of the 148 | viewport. 149 | 150 | -} 151 | getViewport : Task x Viewport 152 | getViewport = 153 | Elm.Kernel.Browser.withWindow Elm.Kernel.Browser.getViewport 154 | 155 | 156 | {-| All the information about the current viewport. 157 | 158 | ![getViewport](https://elm.github.io/browser/v1/getViewport.svg) 159 | 160 | -} 161 | type alias Viewport = 162 | { scene : 163 | { width : Float 164 | , height : Float 165 | } 166 | , viewport : 167 | { x : Float 168 | , y : Float 169 | , width : Float 170 | , height : Float 171 | } 172 | } 173 | 174 | 175 | {-| Just like `getViewport`, but for any scrollable DOM node. Say we have an 176 | application with a chat box in the bottow right corner like this: 177 | 178 | ![chat](https://elm.github.io/browser/v1/chat.svg) 179 | 180 | There are probably a whole bunch of messages that are not being shown. You 181 | could scroll up to see them all. Well, we can think of that chat box is a 182 | viewport into a scene! 183 | 184 | ![getViewportOf](https://elm.github.io/browser/v1/getViewportOf.svg) 185 | 186 | This can be useful with [`setViewportOf`](#setViewportOf) to make sure new 187 | messages always appear on the bottom. 188 | 189 | The viewport size _does not_ include the border or margins. 190 | 191 | **Note:** This data is collected from specific fields in JavaScript, so it 192 | may be helpful to know that: 193 | 194 | - `scene.width` = [`scrollWidth`][sw] 195 | - `scene.height` = [`scrollHeight`][sh] 196 | - `viewport.x` = [`scrollLeft`][sl] 197 | - `viewport.y` = [`scrollTop`][st] 198 | - `viewport.width` = [`clientWidth`][cw] 199 | - `viewport.height` = [`clientHeight`][ch] 200 | 201 | Neither [`offsetWidth`][ow] nor [`offsetHeight`][oh] are available. The theory 202 | is that (1) the information can always be obtained by using `getElement` on a 203 | node without margins, (2) no cases came to mind where you actually care in the 204 | first place, and (3) it is available through ports if it is really needed. 205 | If you have a case that really needs it though, please share your specific 206 | scenario in an issue! Nicely presented case studies are the raw ingredients for 207 | API improvements! 208 | 209 | [sw]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollWidth 210 | [sh]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollHeight 211 | [st]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollTop 212 | [sl]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollLeft 213 | [cw]: https://developer.mozilla.org/en-US/docs/Web/API/Element/clientWidth 214 | [ch]: https://developer.mozilla.org/en-US/docs/Web/API/Element/clientHeight 215 | [ow]: https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/offsetWidth 216 | [oh]: https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/offsetHeight 217 | 218 | -} 219 | getViewportOf : String -> Task Error Viewport 220 | getViewportOf = 221 | Elm.Kernel.Browser.getViewportOf 222 | 223 | 224 | 225 | -- SET VIEWPORT 226 | 227 | 228 | {-| Change the `x` and `y` offset of the browser viewport immediately. For 229 | example, you could make a command to jump to the top of the page: 230 | 231 | import Browser.Dom as Dom 232 | import Task 233 | 234 | type Msg 235 | = NoOp 236 | 237 | resetViewport : Cmd Msg 238 | resetViewport = 239 | Task.perform (\_ -> NoOp) (Dom.setViewport 0 0) 240 | 241 | This sets the viewport offset to zero. 242 | 243 | This could be useful with `Browser.application` where you may want to reset 244 | the viewport when the URL changes. Maybe you go to a “new page” 245 | and want people to start at the top! 246 | 247 | -} 248 | setViewport : Float -> Float -> Task x () 249 | setViewport = 250 | Elm.Kernel.Browser.setViewport 251 | 252 | 253 | {-| Change the `x` and `y` offset of a DOM node’s viewport by ID. This 254 | is common in text messaging and chat rooms, where once the messages fill the 255 | screen, you want to always be at the very bottom of the message chain. This 256 | way the latest message is always on screen! You could do this: 257 | 258 | import Browser.Dom as Dom 259 | import Task 260 | 261 | type Msg 262 | = NoOp 263 | 264 | jumpToBottom : String -> Cmd Msg 265 | jumpToBottom id = 266 | Dom.getViewportOf id 267 | |> Task.andThen (\info -> Dom.setViewportOf id 0 info.scene.height) 268 | |> Task.attempt (\_ -> NoOp) 269 | 270 | So you could call `jumpToBottom "chat-box"` whenever you add a new message. 271 | 272 | **Note 1:** What happens if the viewport is placed out of bounds? Where there 273 | is no `scene` to show? To avoid this question, the `x` and `y` offsets are 274 | clamped such that the viewport is always fully within the `scene`. So when 275 | `jumpToBottom` sets the `y` offset of the viewport to the `height` of the 276 | `scene` (i.e. too far!) it relies on this clamping behavior to put the viewport 277 | back in bounds. 278 | 279 | **Note 2:** The example ignores when the element ID is not found, but it would 280 | be great to log that information. It means there may be a bug or a dead link 281 | somewhere! 282 | 283 | -} 284 | setViewportOf : String -> Float -> Float -> Task Error () 285 | setViewportOf = 286 | Elm.Kernel.Browser.setViewportOf 287 | 288 | 289 | 290 | {--SLIDE VIEWPORT 291 | 292 | 293 | {-| Change the `x` and `y` offset of the viewport with an animation. In JS, 294 | this corresponds to setting [`scroll-behavior`][sb] to `smooth`. 295 | 296 | This can definitely be overused, so try to use it specifically when you want 297 | the user to be spatially situated in a scene. For example, a “back to 298 | top” button might use it: 299 | 300 | import Browser.Dom as Dom 301 | import Task 302 | 303 | type Msg = NoOp 304 | 305 | backToTop : Cmd Msg 306 | backToTop = 307 | Task.perform (\_ -> NoOp) (Dom.slideViewport 0 0) 308 | 309 | Be careful when paring this with `Browser.application`. When the URL changes 310 | and a whole new scene is going to be rendered, using `setViewport` is probably 311 | best. If you are moving within a scene, you may benefit from a mix of 312 | `setViewport` and `slideViewport`. Sliding to the top is nice, but sliding 313 | around everywhere is probably annoying. 314 | 315 | [sb]: https://developer.mozilla.org/en-US/docs/Web/CSS/scroll-behavior 316 | -} 317 | slideViewport : Float -> Float -> Task x () 318 | slideViewport = 319 | Debug.todo "slideViewport" 320 | 321 | 322 | slideViewportOf : String -> Float -> Float -> Task Error () 323 | slideViewportOf = 324 | Debug.todo "slideViewportOf" 325 | 326 | --} 327 | -- ELEMENT 328 | 329 | 330 | {-| Get position information about specific elements. Say we put 331 | `id "jesting-aside"` on the seventh paragraph of the text. When we call 332 | `getElement "jesting-aside"` we would get the following information: 333 | 334 | ![getElement](https://elm.github.io/browser/v1/getElement.svg) 335 | 336 | This can be useful for: 337 | 338 | - **Scrolling** — Pair this information with `setViewport` to scroll 339 | specific elements into view. This gives you a lot of control over where exactly 340 | the element would be after the viewport moved. 341 | 342 | - **Drag and Drop** — As of this writing, `touchmove` events do not tell 343 | you which element you are currently above. To figure out if you have dragged 344 | something over the target, you could see if the `pageX` and `pageY` of the 345 | touch are inside the `x`, `y`, `width`, and `height` of the target element. 346 | 347 | **Note:** This corresponds to JavaScript’s [`getBoundingClientRect`][gbcr], 348 | so **the element’s margins are included in its `width` and `height`**. 349 | With scrolling, maybe you want to include the margins. With drag-and-drop, you 350 | probably do not, so some folks set the margins to zero and put the target 351 | element in a `<div>` that adds the spacing. Just something to be aware of! 352 | 353 | [gbcr]: https://developer.mozilla.org/en-US/docs/Web/API/Element/getBoundingClientRect 354 | 355 | -} 356 | getElement : String -> Task Error Element 357 | getElement = 358 | Elm.Kernel.Browser.getElement 359 | 360 | 361 | {-| A bunch of information about the position and size of an element relative 362 | to the overall scene. 363 | 364 | ![getElement](https://elm.github.io/browser/v1/getElement.svg) 365 | 366 | -} 367 | type alias Element = 368 | { scene : 369 | { width : Float 370 | , height : Float 371 | } 372 | , viewport : 373 | { x : Float 374 | , y : Float 375 | , width : Float 376 | , height : Float 377 | } 378 | , element : 379 | { x : Float 380 | , y : Float 381 | , width : Float 382 | , height : Float 383 | } 384 | } 385 | -------------------------------------------------------------------------------- /src/Browser/Events.elm: -------------------------------------------------------------------------------- 1 | effect module Browser.Events where { subscription = MySub } exposing 2 | ( onAnimationFrame, onAnimationFrameDelta 3 | , onKeyPress, onKeyDown, onKeyUp 4 | , onClick, onMouseMove, onMouseDown, onMouseUp 5 | , onResize, onVisibilityChange, Visibility(..) 6 | ) 7 | 8 | {-| In JavaScript, information about the root of an HTML document is held in 9 | the `document` and `window` objects. This module lets you create event 10 | listeners on those objects for the following topics: [animation](#animation), 11 | [keyboard](#keyboard), [mouse](#mouse), and [window](#window). 12 | 13 | If there is something else you need, use [ports] to do it in JavaScript! 14 | 15 | [ports]: https://guide.elm-lang.org/interop/ports.html 16 | 17 | 18 | # Animation 19 | 20 | @docs onAnimationFrame, onAnimationFrameDelta 21 | 22 | 23 | # Keyboard 24 | 25 | @docs onKeyPress, onKeyDown, onKeyUp 26 | 27 | 28 | # Mouse 29 | 30 | @docs onClick, onMouseMove, onMouseDown, onMouseUp 31 | 32 | 33 | # Window 34 | 35 | @docs onResize, onVisibilityChange, Visibility 36 | 37 | -} 38 | 39 | import Browser.AnimationManager as AM 40 | import Dict 41 | import Elm.Kernel.Browser 42 | import Json.Decode as Decode 43 | import Process 44 | import Task exposing (Task) 45 | import Time 46 | 47 | 48 | 49 | -- ANIMATION 50 | 51 | 52 | {-| An animation frame triggers about 60 times per second. Get the POSIX time 53 | on each frame. (See [`elm/time`](/packages/elm/time/latest) for more info on 54 | POSIX times.) 55 | 56 | **Note:** Browsers have their own render loop, repainting things as fast as 57 | possible. If you want smooth animations in your application, it is helpful to 58 | sync up with the browsers natural refresh rate. This hooks into JavaScript's 59 | `requestAnimationFrame` function. 60 | 61 | -} 62 | onAnimationFrame : (Time.Posix -> msg) -> Sub msg 63 | onAnimationFrame = 64 | AM.onAnimationFrame 65 | 66 | 67 | {-| Just like `onAnimationFrame`, except message is the time in milliseconds 68 | since the previous frame. So you should get a sequence of values all around 69 | `1000 / 60` which is nice for stepping animations by a time delta. 70 | -} 71 | onAnimationFrameDelta : (Float -> msg) -> Sub msg 72 | onAnimationFrameDelta = 73 | AM.onAnimationFrameDelta 74 | 75 | 76 | 77 | -- KEYBOARD 78 | 79 | 80 | {-| Subscribe to key presses that normally produce characters. So you should 81 | not rely on this for arrow keys. 82 | 83 | **Note:** Check out [this advice][note] to learn more about decoding key codes. 84 | It is more complicated than it should be. 85 | 86 | [note]: https://github.com/elm/browser/blob/1.0.2/notes/keyboard.md 87 | 88 | -} 89 | onKeyPress : Decode.Decoder msg -> Sub msg 90 | onKeyPress = 91 | on Document "keypress" 92 | 93 | 94 | {-| Subscribe to get codes whenever a key goes down. This can be useful for 95 | creating games. Maybe you want to know if people are pressing `w`, `a`, `s`, 96 | or `d` at any given time. 97 | 98 | **Note:** Check out [this advice][note] to learn more about decoding key codes. 99 | It is more complicated than it should be. 100 | 101 | [note]: https://github.com/elm/browser/blob/1.0.2/notes/keyboard.md 102 | 103 | -} 104 | onKeyDown : Decode.Decoder msg -> Sub msg 105 | onKeyDown = 106 | on Document "keydown" 107 | 108 | 109 | {-| Subscribe to get codes whenever a key goes up. Often used in combination 110 | with [`onVisibilityChange`](#onVisibilityChange) to be sure keys do not appear 111 | to down and never come back up. 112 | -} 113 | onKeyUp : Decode.Decoder msg -> Sub msg 114 | onKeyUp = 115 | on Document "keyup" 116 | 117 | 118 | 119 | -- MOUSE 120 | 121 | 122 | {-| Subscribe to mouse clicks anywhere on screen. Maybe you need to create a 123 | custom drop down. You could listen for clicks when it is open, letting you know 124 | if someone clicked out of it: 125 | 126 | import Browser.Events as Events 127 | import Json.Decode as D 128 | 129 | type Msg 130 | = ClickOut 131 | 132 | subscriptions : Model -> Sub Msg 133 | subscriptions model = 134 | case model.dropDown of 135 | Closed _ -> 136 | Sub.none 137 | 138 | Open _ -> 139 | Events.onClick (D.succeed ClickOut) 140 | 141 | -} 142 | onClick : Decode.Decoder msg -> Sub msg 143 | onClick = 144 | on Document "click" 145 | 146 | 147 | {-| Subscribe to mouse moves anywhere on screen. 148 | 149 | You could use this to implement resizable panels like in Elm's online code 150 | editor. Check out the example imprementation [here][drag]. 151 | 152 | [drag]: https://github.com/elm/browser/blob/1.0.2/examples/src/Drag.elm 153 | 154 | **Note:** Unsubscribe if you do not need these events! Running code on every 155 | single mouse movement can be very costly, and it is recommended to only 156 | subscribe when absolutely necessary. 157 | 158 | -} 159 | onMouseMove : Decode.Decoder msg -> Sub msg 160 | onMouseMove = 161 | on Document "mousemove" 162 | 163 | 164 | {-| Subscribe to get mouse information whenever the mouse button goes down. 165 | -} 166 | onMouseDown : Decode.Decoder msg -> Sub msg 167 | onMouseDown = 168 | on Document "mousedown" 169 | 170 | 171 | {-| Subscribe to get mouse information whenever the mouse button goes up. 172 | Often used in combination with [`onVisibilityChange`](#onVisibilityChange) 173 | to be sure keys do not appear to down and never come back up. 174 | -} 175 | onMouseUp : Decode.Decoder msg -> Sub msg 176 | onMouseUp = 177 | on Document "mouseup" 178 | 179 | 180 | 181 | -- WINDOW 182 | 183 | 184 | {-| Subscribe to any changes in window size. 185 | 186 | For example, you could track the current width by saying: 187 | 188 | import Browser.Events as E 189 | 190 | type Msg 191 | = GotNewWidth Int 192 | 193 | subscriptions : model -> Cmd Msg 194 | subscriptions _ = 195 | E.onResize (\w h -> GotNewWidth w) 196 | 197 | **Note:** This is equivalent to getting events from [`window.onresize`][resize]. 198 | 199 | [resize]: https://developer.mozilla.org/en-US/docs/Web/API/GlobalEventHandlers/onresize 200 | 201 | -} 202 | onResize : (Int -> Int -> msg) -> Sub msg 203 | onResize func = 204 | on Window "resize" <| 205 | Decode.field "target" <| 206 | Decode.map2 func 207 | (Decode.field "innerWidth" Decode.int) 208 | (Decode.field "innerHeight" Decode.int) 209 | 210 | 211 | {-| Subscribe to any visibility changes, like if the user switches to a 212 | different tab or window. When the user looks away, you may want to: 213 | 214 | - Pause a timer. 215 | - Pause an animation. 216 | - Pause video or audio. 217 | - Pause an image carousel. 218 | - Stop polling a server for new information. 219 | - Stop waiting for an [`onKeyUp`](#onKeyUp) event. 220 | 221 | -} 222 | onVisibilityChange : (Visibility -> msg) -> Sub msg 223 | onVisibilityChange func = 224 | let 225 | info = Elm.Kernel.Browser.visibilityInfo () 226 | in 227 | on Document info.change <| 228 | Decode.map (withHidden func) <| 229 | Decode.field "target" <| 230 | Decode.field info.hidden Decode.bool 231 | 232 | 233 | withHidden : (Visibility -> msg) -> Bool -> msg 234 | withHidden func isHidden = 235 | func (if isHidden then Hidden else Visible) 236 | 237 | 238 | {-| Value describing whether the page is hidden or visible. 239 | -} 240 | type Visibility 241 | = Visible 242 | | Hidden 243 | 244 | 245 | 246 | -- SUBSCRIPTIONS 247 | 248 | 249 | type Node 250 | = Document 251 | | Window 252 | 253 | 254 | on : Node -> String -> Decode.Decoder msg -> Sub msg 255 | on node name decoder = 256 | subscription (MySub node name decoder) 257 | 258 | 259 | type MySub msg 260 | = MySub Node String (Decode.Decoder msg) 261 | 262 | 263 | subMap : (a -> b) -> MySub a -> MySub b 264 | subMap func (MySub node name decoder) = 265 | MySub node name (Decode.map func decoder) 266 | 267 | 268 | 269 | -- EFFECT MANAGER 270 | 271 | 272 | type alias State msg = 273 | { subs : List ( String, MySub msg ) 274 | , pids : Dict.Dict String Process.Id 275 | } 276 | 277 | 278 | init : Task Never (State msg) 279 | init = 280 | Task.succeed (State [] Dict.empty) 281 | 282 | 283 | type alias Event = 284 | { key : String 285 | , event : Decode.Value 286 | } 287 | 288 | 289 | onSelfMsg : Platform.Router msg Event -> Event -> State msg -> Task Never (State msg) 290 | onSelfMsg router { key, event } state = 291 | let 292 | toMessage ( subKey, MySub node name decoder ) = 293 | if subKey == key then 294 | Elm.Kernel.Browser.decodeEvent decoder event 295 | else 296 | Nothing 297 | 298 | messages = List.filterMap toMessage state.subs 299 | in 300 | Task.sequence (List.map (Platform.sendToApp router) messages) 301 | |> Task.andThen (\_ -> Task.succeed state) 302 | 303 | 304 | onEffects : Platform.Router msg Event -> List (MySub msg) -> State msg -> Task Never (State msg) 305 | onEffects router subs state = 306 | let 307 | newSubs = List.map addKey subs 308 | 309 | stepLeft _ pid (deads, lives, news) = 310 | (pid :: deads, lives, news) 311 | 312 | stepBoth key pid _ (deads, lives, news) = 313 | (deads, Dict.insert key pid lives, news) 314 | 315 | stepRight key sub (deads, lives, news) = 316 | (deads, lives, spawn router key sub :: news) 317 | 318 | (deadPids, livePids, makeNewPids) = 319 | Dict.merge stepLeft stepBoth stepRight state.pids (Dict.fromList newSubs) ([], Dict.empty, []) 320 | in 321 | Task.sequence (List.map Process.kill deadPids) 322 | |> Task.andThen (\_ -> Task.sequence makeNewPids) 323 | |> Task.andThen (\pids -> Task.succeed (State newSubs (Dict.union livePids (Dict.fromList pids)))) 324 | 325 | 326 | 327 | -- TO KEY 328 | 329 | 330 | addKey : MySub msg -> ( String, MySub msg ) 331 | addKey ((MySub node name _) as sub) = 332 | (nodeToKey node ++ name, sub) 333 | 334 | 335 | nodeToKey : Node -> String 336 | nodeToKey node = 337 | case node of 338 | Document -> "d_" 339 | Window -> "w_" 340 | 341 | 342 | 343 | -- SPAWN 344 | 345 | 346 | spawn : Platform.Router msg Event -> String -> MySub msg -> Task Never ( String, Process.Id ) 347 | spawn router key (MySub node name _) = 348 | let 349 | actualNode = 350 | case node of 351 | Document -> Elm.Kernel.Browser.doc 352 | Window -> Elm.Kernel.Browser.window 353 | in 354 | Task.map (\value -> ( key, value )) <| 355 | Elm.Kernel.Browser.on actualNode name <| 356 | \event -> Platform.sendToSelf router (Event key event) 357 | -------------------------------------------------------------------------------- /src/Browser/Navigation.elm: -------------------------------------------------------------------------------- 1 | module Browser.Navigation exposing 2 | ( Key, pushUrl, replaceUrl, back, forward 3 | , load, reload, reloadAndSkipCache 4 | ) 5 | 6 | {-| This module helps you manage the browser’s URL yourself. This is the 7 | crucial trick when using [`Browser.application`](Browser#application). 8 | 9 | The most important function is [`pushUrl`](#pushUrl) which changes the 10 | address bar _without_ starting a page load. 11 | 12 | 13 | ## What is a page load? 14 | 15 | 1. Request a new HTML document. The page goes blank. 16 | 2. As the HTML loads, request any `<script>` or `<link>` resources. 17 | 3. A `<script>` may mutate the document, so these tags block rendering. 18 | 4. When _all_ of the assets are loaded, actually render the page. 19 | 20 | That means the page will go blank for at least two round-trips to the servers! 21 | You may have 90% of the data you need and be blocked on a font that is taking 22 | a long time. Still blank! 23 | 24 | 25 | ## How does `pushUrl` help? 26 | 27 | The `pushUrl` function changes the URL, but lets you keep the current HTML. 28 | This means the page _never_ goes blank. Instead of making two round-trips to 29 | the server, you load whatever assets you want from within Elm. Maybe you do 30 | not need any round-trips! Meanwhile, you retain full control over the UI, so 31 | you can show a loading bar, show information as it loads, etc. Whatever you 32 | want! 33 | 34 | 35 | # Navigate within Page 36 | 37 | @docs Key, pushUrl, replaceUrl, back, forward 38 | 39 | 40 | # Navigate to other Pages 41 | 42 | @docs load, reload, reloadAndSkipCache 43 | 44 | -} 45 | 46 | import Elm.Kernel.Browser 47 | import Task exposing (Task) 48 | 49 | 50 | 51 | -- WITHIN PAGE 52 | 53 | 54 | {-| A navigation `Key` is needed to create navigation commands that change the 55 | URL. That includes [`pushUrl`](#pushUrl), [`replaceUrl`](#replaceUrl), 56 | [`back`](#back), and [`forward`](#forward). 57 | 58 | You only get access to a `Key` when you create your program with 59 | [`Browser.application`](Browser#application), guaranteeing that your program is 60 | equipped to detect these URL changes. If `Key` values were available in other 61 | kinds of programs, unsuspecting programmers would be sure to run into some 62 | [annoying bugs][bugs] and learn a bunch of techniques the hard way! 63 | 64 | [bugs]: https://github.com/elm/browser/blob/1.0.2/notes/navigation-in-elements.md 65 | 66 | -} 67 | type Key 68 | = Key 69 | 70 | 71 | {-| Change the URL, but do not trigger a page load. 72 | 73 | This will add a new entry to the browser history. 74 | 75 | Check out the [`elm/url`][url] package for help building URLs. The 76 | [`Url.Builder.absolute`][abs] and [`Url.Builder.relative`][rel] functions can 77 | be particularly handy! 78 | 79 | [url]: /packages/elm/url/latest 80 | [abs]: /packages/elm/url/latest/Url-Builder#absolute 81 | [rel]: /packages/elm/url/latest/Url-Builder#relative 82 | 83 | **Note:** If the user has gone `back` a few pages, there will be “future 84 | pages” that the user can go `forward` to. Adding a new URL in that 85 | scenario will clear out any future pages. It is like going back in time and 86 | making a different choice. 87 | 88 | -} 89 | pushUrl : Key -> String -> Cmd msg 90 | pushUrl = 91 | Elm.Kernel.Browser.pushUrl 92 | 93 | 94 | {-| Change the URL, but do not trigger a page load. 95 | 96 | This _will not_ add a new entry to the browser history. 97 | 98 | This can be useful if you have search box and you want the `?search=hats` in 99 | the URL to match without adding a history entry for every single key stroke. 100 | Imagine how annoying it would be to click `back` thirty times and still be on 101 | the same page! 102 | 103 | **Note:** Browsers may rate-limit this function by throwing an exception. The 104 | discussion [here](https://bugs.webkit.org/show_bug.cgi?id=156115) suggests 105 | that the limit is 100 calls per 30 second interval in Safari in 2016. It also 106 | suggests techniques for people changing the URL based on scroll position. 107 | 108 | -} 109 | replaceUrl : Key -> String -> Cmd msg 110 | replaceUrl = 111 | Elm.Kernel.Browser.replaceUrl 112 | 113 | 114 | {-| Go back some number of pages. So `back 1` goes back one page, and `back 2` 115 | goes back two pages. 116 | 117 | **Note:** You only manage the browser history that _you_ created. Think of this 118 | library as letting you have access to a small part of the overall history. So 119 | if you go back farther than the history you own, you will just go back to some 120 | other website! 121 | 122 | -} 123 | back : Key -> Int -> Cmd msg 124 | back key n = 125 | Elm.Kernel.Browser.go key -n 126 | 127 | 128 | {-| Go forward some number of pages. So `forward 1` goes forward one page, and 129 | `forward 2` goes forward two pages. If there are no more pages in the future, 130 | this will do nothing. 131 | 132 | **Note:** You only manage the browser history that _you_ created. Think of this 133 | library as letting you have access to a small part of the overall history. So 134 | if you go forward farther than the history you own, the user will end up on 135 | whatever website they visited next! 136 | 137 | -} 138 | forward : Key -> Int -> Cmd msg 139 | forward = 140 | Elm.Kernel.Browser.go 141 | 142 | 143 | 144 | -- EXTERNAL PAGES 145 | 146 | 147 | {-| Leave the current page and load the given URL. **This always results in a 148 | page load**, even if the provided URL is the same as the current one. 149 | 150 | gotoElmWebsite : Cmd msg 151 | gotoElmWebsite = 152 | load "https://elm-lang.org" 153 | 154 | Check out the [`elm/url`][url] package for help building URLs. The 155 | [`Url.absolute`][abs] and [`Url.relative`][rel] functions can be particularly 156 | handy! 157 | 158 | [url]: /packages/elm/url/latest 159 | [abs]: /packages/elm/url/latest/Url#absolute 160 | [rel]: /packages/elm/url/latest/Url#relative 161 | 162 | -} 163 | load : String -> Cmd msg 164 | load = 165 | Elm.Kernel.Browser.load 166 | 167 | 168 | {-| Reload the current page. **This always results in a page load!** 169 | This may grab resources from the browser cache, so use 170 | [`reloadAndSkipCache`](#reloadAndSkipCache) 171 | if you want to be sure that you are not loading any cached resources. 172 | -} 173 | reload : Cmd msg 174 | reload = 175 | Elm.Kernel.Browser.reload False 176 | 177 | 178 | {-| Reload the current page without using the browser cache. **This always 179 | results in a page load!** It is more common to want [`reload`](#reload). 180 | -} 181 | reloadAndSkipCache : Cmd msg 182 | reloadAndSkipCache = 183 | Elm.Kernel.Browser.reload True 184 | -------------------------------------------------------------------------------- /src/Debugger/Expando.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Expando exposing 2 | ( Expando 3 | , Msg 4 | , init 5 | , merge 6 | , update 7 | , view 8 | ) 9 | 10 | 11 | import Dict exposing (Dict) 12 | import Elm.Kernel.Debugger 13 | import Html exposing (Html, div, span, text) 14 | import Html.Attributes exposing (class, style) 15 | import Html.Events exposing (onClick) 16 | import Json.Decode as Json 17 | 18 | 19 | 20 | -- MODEL 21 | 22 | 23 | type Expando 24 | = S String 25 | | Primitive String 26 | | Sequence SeqType Bool (List Expando) 27 | | Dictionary Bool (List (Expando, Expando)) 28 | | Record Bool (Dict String Expando) 29 | | Constructor (Maybe String) Bool (List Expando) 30 | 31 | 32 | type SeqType 33 | = ListSeq 34 | | SetSeq 35 | | ArraySeq 36 | 37 | 38 | seqTypeToString : Int -> SeqType -> String 39 | seqTypeToString n seqType = 40 | case seqType of 41 | ListSeq -> 42 | "List(" ++ String.fromInt n ++ ")" 43 | 44 | SetSeq -> 45 | "Set(" ++ String.fromInt n ++ ")" 46 | 47 | ArraySeq -> 48 | "Array(" ++ String.fromInt n ++ ")" 49 | 50 | 51 | 52 | -- INITIALIZE 53 | 54 | 55 | init : a -> Expando 56 | init value = 57 | initHelp True (Elm.Kernel.Debugger.init value) 58 | 59 | 60 | initHelp : Bool -> Expando -> Expando 61 | initHelp isOuter expando = 62 | case expando of 63 | S _ -> 64 | expando 65 | 66 | Primitive _ -> 67 | expando 68 | 69 | Sequence seqType isClosed items -> 70 | if isOuter then 71 | Sequence seqType False (List.map (initHelp False) items) 72 | 73 | else if List.length items <= 8 then 74 | Sequence seqType False items 75 | 76 | else 77 | expando 78 | 79 | Dictionary isClosed keyValuePairs -> 80 | if isOuter then 81 | Dictionary False (List.map (\( k, v ) -> ( k, initHelp False v )) keyValuePairs) 82 | 83 | else if List.length keyValuePairs <= 8 then 84 | Dictionary False keyValuePairs 85 | 86 | else 87 | expando 88 | 89 | Record isClosed entries -> 90 | if isOuter then 91 | Record False (Dict.map (\_ v -> initHelp False v) entries) 92 | 93 | else if Dict.size entries <= 4 then 94 | Record False entries 95 | 96 | else 97 | expando 98 | 99 | Constructor maybeName isClosed args -> 100 | if isOuter then 101 | Constructor maybeName False (List.map (initHelp False) args) 102 | 103 | else if List.length args <= 4 then 104 | Constructor maybeName False args 105 | 106 | else 107 | expando 108 | 109 | 110 | 111 | -- PRESERVE OLD EXPANDO STATE (open/closed) 112 | 113 | 114 | merge : a -> Expando -> Expando 115 | merge value expando = 116 | mergeHelp expando (Elm.Kernel.Debugger.init value) 117 | 118 | 119 | mergeHelp : Expando -> Expando -> Expando 120 | mergeHelp old new = 121 | case (old, new) of 122 | (_, S _) -> 123 | new 124 | 125 | (_, Primitive _) -> 126 | new 127 | 128 | (Sequence _ isClosed oldValues, Sequence seqType _ newValues) -> 129 | Sequence seqType isClosed (mergeListHelp oldValues newValues) 130 | 131 | (Dictionary isClosed _, Dictionary _ keyValuePairs) -> 132 | Dictionary isClosed keyValuePairs 133 | 134 | (Record isClosed oldDict, Record _ newDict) -> 135 | Record isClosed <| Dict.map (mergeDictHelp oldDict) newDict 136 | 137 | (Constructor _ isClosed oldValues, Constructor maybeName _ newValues) -> 138 | Constructor maybeName isClosed (mergeListHelp oldValues newValues) 139 | 140 | _ -> 141 | new 142 | 143 | 144 | mergeListHelp : List Expando -> List Expando -> List Expando 145 | mergeListHelp olds news = 146 | case (olds, news) of 147 | ([], _) -> 148 | news 149 | 150 | (_, []) -> 151 | news 152 | 153 | (x :: xs, y :: ys) -> 154 | mergeHelp x y :: mergeListHelp xs ys 155 | 156 | 157 | mergeDictHelp : Dict String Expando -> String -> Expando -> Expando 158 | mergeDictHelp oldDict key value = 159 | case Dict.get key oldDict of 160 | Nothing -> 161 | value 162 | 163 | Just oldValue -> 164 | mergeHelp oldValue value 165 | 166 | 167 | 168 | -- UPDATE 169 | 170 | 171 | type Msg 172 | = Toggle 173 | | Index Redirect Int Msg 174 | | Field String Msg 175 | 176 | 177 | type Redirect 178 | = None 179 | | Key 180 | | Value 181 | 182 | 183 | update : Msg -> Expando -> Expando 184 | update msg value = 185 | case value of 186 | S _ -> 187 | -- Debug.crash "nothing changes a primitive" 188 | value 189 | 190 | Primitive _ -> 191 | -- Debug.crash "nothing changes a primitive" 192 | value 193 | 194 | Sequence seqType isClosed valueList -> 195 | case msg of 196 | Toggle -> 197 | Sequence seqType (not isClosed) valueList 198 | 199 | Index None index subMsg -> 200 | Sequence seqType isClosed <| updateIndex index (update subMsg) valueList 201 | 202 | Index _ _ _ -> 203 | -- Debug.crash "no redirected indexes on sequences" 204 | value 205 | 206 | Field _ _ -> 207 | -- Debug.crash "no field on sequences" 208 | value 209 | 210 | Dictionary isClosed keyValuePairs -> 211 | case msg of 212 | Toggle -> 213 | Dictionary (not isClosed) keyValuePairs 214 | 215 | Index redirect index subMsg -> 216 | case redirect of 217 | None -> 218 | -- Debug.crash "must have redirect for dictionaries" 219 | value 220 | 221 | Key -> 222 | Dictionary isClosed <| 223 | updateIndex index (\( k, v ) -> ( update subMsg k, v )) keyValuePairs 224 | 225 | Value -> 226 | Dictionary isClosed <| 227 | updateIndex index (\( k, v ) -> ( k, update subMsg v )) keyValuePairs 228 | 229 | Field _ _ -> 230 | -- Debug.crash "no field for dictionaries" 231 | value 232 | 233 | Record isClosed valueDict -> 234 | case msg of 235 | Toggle -> 236 | Record (not isClosed) valueDict 237 | 238 | Index _ _ _ -> 239 | -- Debug.crash "no index for records" 240 | value 241 | 242 | Field field subMsg -> 243 | Record isClosed (Dict.update field (updateField subMsg) valueDict) 244 | 245 | Constructor maybeName isClosed valueList -> 246 | case msg of 247 | Toggle -> 248 | Constructor maybeName (not isClosed) valueList 249 | 250 | Index None index subMsg -> 251 | Constructor maybeName isClosed <| 252 | updateIndex index (update subMsg) valueList 253 | 254 | Index _ _ _ -> 255 | -- Debug.crash "no redirected indexes on sequences" 256 | value 257 | 258 | Field _ _ -> 259 | -- Debug.crash "no field for constructors" 260 | value 261 | 262 | 263 | updateIndex : Int -> (a -> a) -> List a -> List a 264 | updateIndex n func list = 265 | case list of 266 | [] -> 267 | [] 268 | 269 | x :: xs -> 270 | if n <= 0 271 | then func x :: xs 272 | else x :: updateIndex (n - 1) func xs 273 | 274 | 275 | updateField : Msg -> Maybe Expando -> Maybe Expando 276 | updateField msg maybeExpando = 277 | case maybeExpando of 278 | Nothing -> 279 | -- Debug.crash "key does not exist" 280 | maybeExpando 281 | 282 | Just expando -> 283 | Just (update msg expando) 284 | 285 | 286 | 287 | -- VIEW 288 | 289 | 290 | view : Maybe String -> Expando -> Html Msg 291 | view maybeKey expando = 292 | case expando of 293 | S stringRep -> 294 | div (leftPad maybeKey) (lineStarter maybeKey Nothing [ span [ red ] [ text stringRep ] ]) 295 | 296 | Primitive stringRep -> 297 | div (leftPad maybeKey) (lineStarter maybeKey Nothing [ span [ blue ] [ text stringRep ] ]) 298 | 299 | Sequence seqType isClosed valueList -> 300 | viewSequence maybeKey seqType isClosed valueList 301 | 302 | Dictionary isClosed keyValuePairs -> 303 | viewDictionary maybeKey isClosed keyValuePairs 304 | 305 | Record isClosed valueDict -> 306 | viewRecord maybeKey isClosed valueDict 307 | 308 | Constructor maybeName isClosed valueList -> 309 | viewConstructor maybeKey maybeName isClosed valueList 310 | 311 | 312 | 313 | -- VIEW SEQUENCE 314 | 315 | 316 | viewSequence : Maybe String -> SeqType -> Bool -> List Expando -> Html Msg 317 | viewSequence maybeKey seqType isClosed valueList = 318 | let 319 | starter = seqTypeToString (List.length valueList) seqType 320 | in 321 | div (leftPad maybeKey) 322 | [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [ text starter ]) 323 | , if isClosed then text "" else viewSequenceOpen valueList 324 | ] 325 | 326 | 327 | viewSequenceOpen : List Expando -> Html Msg 328 | viewSequenceOpen values = 329 | div [] (List.indexedMap viewConstructorEntry values) 330 | 331 | 332 | 333 | -- VIEW DICTIONARY 334 | 335 | 336 | viewDictionary : Maybe String -> Bool -> List (Expando, Expando) -> Html Msg 337 | viewDictionary maybeKey isClosed keyValuePairs = 338 | let 339 | starter = "Dict(" ++ String.fromInt (List.length keyValuePairs) ++ ")" 340 | in 341 | div (leftPad maybeKey) 342 | [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [ text starter ]) 343 | , if isClosed then text "" else viewDictionaryOpen keyValuePairs 344 | ] 345 | 346 | 347 | viewDictionaryOpen : List (Expando, Expando) -> Html Msg 348 | viewDictionaryOpen keyValuePairs = 349 | div [] (List.indexedMap viewDictionaryEntry keyValuePairs) 350 | 351 | 352 | viewDictionaryEntry : Int -> (Expando, Expando) -> Html Msg 353 | viewDictionaryEntry index ( key, value ) = 354 | case key of 355 | S stringRep -> 356 | Html.map (Index Value index) (view (Just stringRep) value) 357 | 358 | Primitive stringRep -> 359 | Html.map (Index Value index) (view (Just stringRep) value) 360 | 361 | _ -> 362 | div [] 363 | [ Html.map (Index Key index) (view (Just "key") key) 364 | , Html.map (Index Value index) (view (Just "value") value) 365 | ] 366 | 367 | 368 | 369 | -- VIEW RECORD 370 | 371 | 372 | viewRecord : Maybe String -> Bool -> Dict String Expando -> Html Msg 373 | viewRecord maybeKey isClosed record = 374 | let 375 | (start, middle, end) = 376 | if isClosed then 377 | (Tuple.second (viewTinyRecord record), text "", text "") 378 | else 379 | ([ text "{" ], viewRecordOpen record, div (leftPad (Just ())) [ text "}" ]) 380 | in 381 | div (leftPad maybeKey) 382 | [ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) start) 383 | , middle 384 | , end 385 | ] 386 | 387 | 388 | viewRecordOpen : Dict String Expando -> Html Msg 389 | viewRecordOpen record = 390 | div [] (List.map viewRecordEntry (Dict.toList record)) 391 | 392 | 393 | viewRecordEntry : ( String, Expando ) -> Html Msg 394 | viewRecordEntry ( field, value ) = 395 | Html.map (Field field) (view (Just field) value) 396 | 397 | 398 | 399 | -- VIEW CONSTRUCTOR 400 | 401 | 402 | viewConstructor : Maybe String -> Maybe String -> Bool -> List Expando -> Html Msg 403 | viewConstructor maybeKey maybeName isClosed valueList = 404 | let 405 | tinyArgs = List.map (Tuple.second << viewExtraTiny) valueList 406 | 407 | description = 408 | case (maybeName, tinyArgs) of 409 | (Nothing , [] ) -> [ text "()" ] 410 | (Nothing , x :: xs) -> text "( " :: span [] x :: List.foldr (\args rest -> text ", " :: span [] args :: rest) [ text " )" ] xs 411 | (Just name, [] ) -> [ text name ] 412 | (Just name, x :: xs) -> text (name ++ " ") :: span [] x :: List.foldr (\args rest -> text " " :: span [] args :: rest) [] xs 413 | 414 | (maybeIsClosed, openHtml) = 415 | case valueList of 416 | [] -> 417 | (Nothing, div [] []) 418 | 419 | [ entry ] -> 420 | case entry of 421 | S _ -> 422 | (Nothing, div [] []) 423 | 424 | Primitive _ -> 425 | (Nothing, div [] []) 426 | 427 | Sequence _ _ subValueList -> 428 | ( Just isClosed 429 | , if isClosed then div [] [] else 430 | Html.map (Index None 0) (viewSequenceOpen subValueList) 431 | ) 432 | 433 | Dictionary _ keyValuePairs -> 434 | ( Just isClosed 435 | , if isClosed then div [] [] else 436 | Html.map (Index None 0) (viewDictionaryOpen keyValuePairs) 437 | ) 438 | 439 | Record _ record -> 440 | ( Just isClosed 441 | , if isClosed then div [] [] else 442 | Html.map (Index None 0) (viewRecordOpen record) 443 | ) 444 | 445 | Constructor _ _ subValueList -> 446 | ( Just isClosed 447 | , if isClosed then div [] [] else 448 | Html.map (Index None 0) (viewConstructorOpen subValueList) 449 | ) 450 | 451 | _ -> 452 | ( Just isClosed 453 | , if isClosed then div [] [] else viewConstructorOpen valueList 454 | ) 455 | in 456 | div (leftPad maybeKey) 457 | [ div [ onClick Toggle ] (lineStarter maybeKey maybeIsClosed description) 458 | , openHtml 459 | ] 460 | 461 | 462 | viewConstructorOpen : List Expando -> Html Msg 463 | viewConstructorOpen valueList = 464 | div [] (List.indexedMap viewConstructorEntry valueList) 465 | 466 | 467 | viewConstructorEntry : Int -> Expando -> Html Msg 468 | viewConstructorEntry index value = 469 | Html.map (Index None index) (view (Just (String.fromInt index)) value) 470 | 471 | 472 | 473 | -- VIEW TINY 474 | 475 | 476 | viewTiny : Expando -> ( Int, List (Html msg) ) 477 | viewTiny value = 478 | case value of 479 | S stringRep -> 480 | let 481 | str = elideMiddle stringRep 482 | in 483 | ( String.length str 484 | , [ span [ red ] [ text str ] ] 485 | ) 486 | 487 | Primitive stringRep -> 488 | ( String.length stringRep 489 | , [ span [ blue ] [ text stringRep ] ] 490 | ) 491 | 492 | Sequence seqType _ valueList -> 493 | viewTinyHelp <| seqTypeToString (List.length valueList) seqType 494 | 495 | Dictionary _ keyValuePairs -> 496 | viewTinyHelp <| "Dict(" ++ String.fromInt (List.length keyValuePairs) ++ ")" 497 | 498 | Record _ record -> 499 | viewTinyRecord record 500 | 501 | Constructor maybeName _ [] -> 502 | viewTinyHelp <| Maybe.withDefault "Unit" maybeName 503 | 504 | Constructor maybeName _ valueList -> 505 | viewTinyHelp <| 506 | case maybeName of 507 | Nothing -> "Tuple(" ++ String.fromInt (List.length valueList) ++ ")" 508 | Just name -> name ++ " …" 509 | 510 | 511 | viewTinyHelp : String -> ( Int, List (Html msg) ) 512 | viewTinyHelp str = 513 | (String.length str, [ text str ]) 514 | 515 | 516 | elideMiddle : String -> String 517 | elideMiddle str = 518 | if String.length str <= 18 519 | then str 520 | else String.left 8 str ++ "..." ++ String.right 8 str 521 | 522 | 523 | 524 | -- VIEW TINY RECORDS 525 | 526 | 527 | viewTinyRecord : Dict String Expando -> ( Int, List (Html msg) ) 528 | viewTinyRecord record = 529 | if Dict.isEmpty record then 530 | (2, [ text "{}" ]) 531 | else 532 | viewTinyRecordHelp 0 "{ " (Dict.toList record) 533 | 534 | 535 | viewTinyRecordHelp : Int -> String -> List ( String, Expando ) -> ( Int, List (Html msg) ) 536 | viewTinyRecordHelp length starter entries = 537 | case entries of 538 | [] -> 539 | (length + 2, [ text " }" ]) 540 | 541 | (field, value) :: rest -> 542 | let 543 | fieldLen = String.length field 544 | (valueLen, valueHtmls) = viewExtraTiny value 545 | newLength = length + fieldLen + valueLen + 5 546 | in 547 | if newLength > 60 then 548 | (length + 4, [ text ", … }" ]) 549 | else 550 | let 551 | (finalLength, otherHtmls) = viewTinyRecordHelp newLength ", " rest 552 | in 553 | ( finalLength 554 | , text starter 555 | :: span [ purple ] [ text field ] 556 | :: text " = " 557 | :: span [] valueHtmls 558 | :: otherHtmls 559 | ) 560 | 561 | 562 | viewExtraTiny : Expando -> ( Int, List (Html msg) ) 563 | viewExtraTiny value = 564 | case value of 565 | Record _ record -> 566 | viewExtraTinyRecord 0 "{" (Dict.keys record) 567 | 568 | _ -> 569 | viewTiny value 570 | 571 | 572 | viewExtraTinyRecord : Int -> String -> List String -> ( Int, List (Html msg) ) 573 | viewExtraTinyRecord length starter entries = 574 | case entries of 575 | [] -> 576 | (length + 1, [ text "}" ]) 577 | 578 | field :: rest -> 579 | let 580 | nextLength = length + String.length field + 1 581 | in 582 | if nextLength > 18 then 583 | (length + 2, [ text "…}" ]) 584 | 585 | else 586 | let 587 | (finalLength, otherHtmls) = viewExtraTinyRecord nextLength "," rest 588 | in 589 | ( finalLength 590 | , text starter :: span [ purple ] [ text field ] :: otherHtmls 591 | ) 592 | 593 | 594 | 595 | -- VIEW HELPERS 596 | 597 | 598 | lineStarter : Maybe String -> Maybe Bool -> List (Html msg) -> List (Html msg) 599 | lineStarter maybeKey maybeIsClosed description = 600 | let 601 | arrow = 602 | case maybeIsClosed of 603 | Nothing -> makeArrow "" 604 | Just True -> makeArrow "▸" 605 | Just False -> makeArrow "▾" 606 | in 607 | case maybeKey of 608 | Nothing -> 609 | arrow :: description 610 | 611 | Just key -> 612 | arrow :: span [ purple ] [ text key ] :: text " = " :: description 613 | 614 | 615 | makeArrow : String -> Html msg 616 | makeArrow arrow = 617 | span 618 | [ style "color" "#777" 619 | , style "padding-left" "2ch" 620 | , style "width" "2ch" 621 | , style "display" "inline-block" 622 | ] 623 | [ text arrow ] 624 | 625 | 626 | leftPad : Maybe a -> List (Html.Attribute msg) 627 | leftPad maybeKey = 628 | case maybeKey of 629 | Nothing -> [] 630 | Just _ -> [ style "padding-left" "4ch" ] 631 | 632 | 633 | red : Html.Attribute msg 634 | red = 635 | style "color" "rgb(196, 26, 22)" 636 | 637 | 638 | blue : Html.Attribute msg 639 | blue = 640 | style "color" "rgb(28, 0, 207)" 641 | 642 | 643 | purple : Html.Attribute msg 644 | purple = 645 | style "color" "rgb(136, 19, 145)" 646 | -------------------------------------------------------------------------------- /src/Debugger/History.elm: -------------------------------------------------------------------------------- 1 | module Debugger.History exposing 2 | ( History 3 | , add 4 | , decoder 5 | , empty 6 | , encode 7 | , get 8 | , getInitialModel 9 | , getRecentMsg 10 | , idForMessageIndex 11 | , size 12 | , view 13 | ) 14 | 15 | import Array exposing (Array) 16 | import Debugger.Expando as Expando exposing (Expando) 17 | import Debugger.Metadata as Metadata 18 | import Elm.Kernel.Debugger 19 | import Html exposing (..) 20 | import Html.Attributes exposing (..) 21 | import Html.Events exposing (onClick) 22 | import Html.Keyed 23 | import Html.Lazy exposing (..) 24 | import Json.Decode as Decode 25 | import Json.Encode as Encode 26 | import Set exposing (Set) 27 | 28 | 29 | 30 | -- CONSTANTS 31 | 32 | 33 | maxSnapshotSize : Int 34 | maxSnapshotSize = 35 | -- NOTE: While the app is running we display (maxSnapshotSize * 2) messages 36 | -- in the message panel. We want to keep this number relatively low to reduce 37 | -- the number of DOM nodes the browser have to deal with. However, we want 38 | -- this number to be high to retain as few model snapshots as possible to 39 | -- reduce memory usage. 40 | -- 41 | -- 31 is selected because 62 messages fills up the height of a 27 inch monitor, 42 | -- with the current style, while avoiding a tree representation in Elm arrays. 43 | -- 44 | -- Performance and memory use seems good. 45 | 31 46 | 47 | 48 | 49 | -- HISTORY 50 | 51 | 52 | type alias History model msg = 53 | { snapshots : Array (Snapshot model msg) 54 | , recent : RecentHistory model msg 55 | , numMessages : Int 56 | } 57 | 58 | 59 | type alias RecentHistory model msg = 60 | { model : model 61 | , messages : List msg 62 | , numMessages : Int 63 | } 64 | 65 | 66 | type alias Snapshot model msg = 67 | { model : model 68 | , messages : Array msg 69 | } 70 | 71 | 72 | empty : model -> History model msg 73 | empty model = 74 | History Array.empty (RecentHistory model [] 0) 0 75 | 76 | 77 | size : History model msg -> Int 78 | size history = 79 | history.numMessages 80 | 81 | 82 | getInitialModel : History model msg -> model 83 | getInitialModel { snapshots, recent } = 84 | case Array.get 0 snapshots of 85 | Just { model } -> 86 | model 87 | 88 | Nothing -> 89 | recent.model 90 | 91 | 92 | 93 | -- JSON 94 | 95 | 96 | decoder : model -> (msg -> model -> model) -> Decode.Decoder ( model, History model msg ) 97 | decoder initialModel update = 98 | let 99 | addMessage rawMsg ( model, history ) = 100 | let 101 | msg = 102 | jsToElm rawMsg 103 | in 104 | ( update msg model, add msg model history ) 105 | 106 | updateModel rawMsgs = 107 | List.foldl addMessage ( initialModel, empty initialModel ) rawMsgs 108 | in 109 | Decode.map updateModel (Decode.list Decode.value) 110 | 111 | 112 | jsToElm : Encode.Value -> a 113 | jsToElm = 114 | Elm.Kernel.Json.unwrap 115 | >> Elm.Kernel.Debugger.unsafeCoerce 116 | 117 | 118 | encode : History model msg -> Encode.Value 119 | encode { snapshots, recent } = 120 | Encode.list elmToJs <| Array.foldr encodeHelp (List.reverse recent.messages) snapshots 121 | 122 | 123 | encodeHelp : Snapshot model msg -> List msg -> List msg 124 | encodeHelp snapshot allMessages = 125 | Array.foldl (::) allMessages snapshot.messages 126 | 127 | 128 | elmToJs : a -> Encode.Value 129 | elmToJs = 130 | Elm.Kernel.Json.wrap 131 | >> Elm.Kernel.Debugger.unsafeCoerce 132 | 133 | 134 | 135 | -- ADD MESSAGES 136 | 137 | 138 | add : msg -> model -> History model msg -> History model msg 139 | add msg model { snapshots, recent, numMessages } = 140 | case addRecent msg model recent of 141 | ( Just snapshot, newRecent ) -> 142 | History (Array.push snapshot snapshots) newRecent (numMessages + 1) 143 | 144 | ( Nothing, newRecent ) -> 145 | History snapshots newRecent (numMessages + 1) 146 | 147 | 148 | addRecent : 149 | msg 150 | -> model 151 | -> RecentHistory model msg 152 | -> ( Maybe (Snapshot model msg), RecentHistory model msg ) 153 | addRecent msg newModel { model, messages, numMessages } = 154 | if numMessages == maxSnapshotSize then 155 | ( Just (Snapshot model (Array.fromList messages)) 156 | , RecentHistory newModel [ msg ] 1 157 | ) 158 | 159 | else 160 | ( Nothing 161 | , RecentHistory model (msg :: messages) (numMessages + 1) 162 | ) 163 | 164 | 165 | 166 | -- GET SUMMARY 167 | 168 | 169 | get : (msg -> model -> ( model, a )) -> Int -> History model msg -> ( model, msg ) 170 | get update index history = 171 | let 172 | recent = 173 | history.recent 174 | 175 | snapshotMax = 176 | history.numMessages - recent.numMessages 177 | in 178 | if index >= snapshotMax then 179 | undone <| 180 | List.foldr (getHelp update) (Stepping (index - snapshotMax) recent.model) recent.messages 181 | 182 | else 183 | case Array.get (index // maxSnapshotSize) history.snapshots of 184 | Nothing -> 185 | -- Debug.crash "UI should only let you ask for real indexes!" 186 | get update index history 187 | 188 | Just { model, messages } -> 189 | undone <| 190 | Array.foldr (getHelp update) (Stepping (remainderBy maxSnapshotSize index) model) messages 191 | 192 | 193 | getRecentMsg : History model msg -> msg 194 | getRecentMsg history = 195 | case history.recent.messages of 196 | [] -> 197 | -- Debug.crash "Cannot provide most recent message!" 198 | getRecentMsg history 199 | 200 | first :: _ -> 201 | first 202 | 203 | 204 | type GetResult model msg 205 | = Stepping Int model 206 | | Done msg model 207 | 208 | 209 | getHelp : (msg -> model -> ( model, a )) -> msg -> GetResult model msg -> GetResult model msg 210 | getHelp update msg getResult = 211 | case getResult of 212 | Done _ _ -> 213 | getResult 214 | 215 | Stepping n model -> 216 | if n == 0 then 217 | Done msg (Tuple.first (update msg model)) 218 | 219 | else 220 | Stepping (n - 1) (Tuple.first (update msg model)) 221 | 222 | 223 | undone : GetResult model msg -> ( model, msg ) 224 | undone getResult = 225 | case getResult of 226 | Done msg model -> 227 | ( model, msg ) 228 | 229 | Stepping _ _ -> 230 | -- Debug.crash "Bug in History.get" 231 | undone getResult 232 | 233 | 234 | 235 | -- VIEW 236 | 237 | 238 | view : Maybe Int -> History model msg -> Html Int 239 | view maybeIndex { snapshots, recent, numMessages } = 240 | let 241 | index = Maybe.withDefault -1 maybeIndex 242 | 243 | onlyRenderRecentMessages = 244 | index /= -1 || Array.length snapshots < 2 245 | 246 | oldStuff = 247 | if onlyRenderRecentMessages then 248 | lazy3 viewAllSnapshots index 0 snapshots 249 | 250 | else 251 | lazy3 viewRecentSnapshots index recent.numMessages snapshots 252 | 253 | recentMessageStartIndex = 254 | numMessages - recent.numMessages 255 | 256 | newStuff = 257 | recent.messages 258 | |> List.foldr (consMsg index) ( recentMessageStartIndex, [] ) 259 | |> Tuple.second 260 | |> Html.Keyed.node "div" [] 261 | in 262 | div 263 | [ id "elm-debugger-sidebar" 264 | , style "width" "100%" 265 | , style "overflow-y" "auto" 266 | , style "height" "calc(100% - 72px)" 267 | ] 268 | (styles 269 | :: newStuff 270 | :: oldStuff 271 | :: (if onlyRenderRecentMessages then 272 | [] 273 | 274 | else 275 | [ showMoreButton numMessages ] 276 | ) 277 | ) 278 | 279 | 280 | 281 | -- VIEW SNAPSHOTS 282 | 283 | 284 | viewAllSnapshots : Int -> Int -> Array (Snapshot model msg) -> Html Int 285 | viewAllSnapshots selectedIndex startIndex snapshots = 286 | div [] <| 287 | Tuple.second <| 288 | Array.foldl (consSnapshot selectedIndex) ( startIndex, [] ) snapshots 289 | 290 | 291 | viewRecentSnapshots : Int -> Int -> Array (Snapshot model msg) -> Html Int 292 | viewRecentSnapshots selectedIndex recentMessagesNum snapshots = 293 | let 294 | arrayLength = 295 | Array.length snapshots 296 | 297 | messagesToFill = 298 | maxSnapshotSize - recentMessagesNum 299 | 300 | startingIndex = 301 | (arrayLength * maxSnapshotSize) - maxSnapshotSize - messagesToFill 302 | 303 | snapshotsToRender = 304 | case ( Array.get (arrayLength - 2) snapshots, Array.get (arrayLength - 1) snapshots ) of 305 | ( Just fillerSnapshot, Just recentSnapshot ) -> 306 | Array.fromList 307 | [ { model = fillerSnapshot.model 308 | , messages = Array.slice 0 messagesToFill fillerSnapshot.messages 309 | } 310 | , recentSnapshot 311 | ] 312 | 313 | _ -> 314 | snapshots 315 | in 316 | viewAllSnapshots selectedIndex startingIndex snapshotsToRender 317 | 318 | 319 | consSnapshot : Int -> Snapshot model msg -> ( Int, List (Html Int) ) -> ( Int, List (Html Int) ) 320 | consSnapshot selectedIndex snapshot ( index, rest ) = 321 | let 322 | nextIndex = 323 | index + Array.length snapshot.messages 324 | 325 | selectedIndexHelp = 326 | if nextIndex > selectedIndex && selectedIndex >= index then 327 | selectedIndex 328 | 329 | else 330 | -1 331 | in 332 | ( nextIndex 333 | , lazy3 viewSnapshot selectedIndexHelp index snapshot :: rest 334 | ) 335 | 336 | 337 | viewSnapshot : Int -> Int -> Snapshot model msg -> Html Int 338 | viewSnapshot selectedIndex index { messages } = 339 | Html.Keyed.node "div" [] <| 340 | Tuple.second <| 341 | Array.foldr (consMsg selectedIndex) ( index, [] ) messages 342 | 343 | 344 | 345 | -- VIEW MESSAGE 346 | 347 | 348 | consMsg : Int -> msg -> ( Int, List ( String, Html Int ) ) -> ( Int, List ( String, Html Int ) ) 349 | consMsg currentIndex msg ( index, rest ) = 350 | ( index + 1 351 | , ( String.fromInt index, lazy3 viewMessage currentIndex index msg ) :: rest 352 | ) 353 | 354 | 355 | viewMessage : Int -> Int -> msg -> Html Int 356 | viewMessage currentIndex index msg = 357 | let 358 | className = 359 | if currentIndex == index then 360 | "elm-debugger-entry elm-debugger-entry-selected" 361 | 362 | else 363 | "elm-debugger-entry" 364 | 365 | messageName = 366 | Elm.Kernel.Debugger.messageToString msg 367 | in 368 | div 369 | [ id (idForMessageIndex index) 370 | , class className 371 | , onClick index 372 | ] 373 | [ span 374 | [ title messageName 375 | , class "elm-debugger-entry-content" 376 | ] 377 | [ text messageName 378 | ] 379 | , span 380 | [ class "elm-debugger-entry-index" 381 | ] 382 | [ text (String.fromInt index) 383 | ] 384 | ] 385 | 386 | 387 | showMoreButton : Int -> Html Int 388 | showMoreButton numMessages = 389 | let 390 | labelText = 391 | "View more messages" 392 | 393 | nextIndex = 394 | numMessages - 1 - maxSnapshotSize * 2 395 | in 396 | div 397 | [ class "elm-debugger-entry" 398 | , onClick nextIndex 399 | ] 400 | [ span 401 | [ title labelText 402 | , class "elm-debugger-entry-content" 403 | ] 404 | [ text labelText 405 | ] 406 | , span 407 | [ class "elm-debugger-entry-index" 408 | ] 409 | [] 410 | ] 411 | 412 | 413 | idForMessageIndex : Int -> String 414 | idForMessageIndex index = 415 | "msg-" ++ String.fromInt index 416 | 417 | 418 | 419 | -- STYLES 420 | 421 | 422 | styles : Html msg 423 | styles = 424 | Html.node "style" [] [ text """ 425 | 426 | .elm-debugger-entry { 427 | cursor: pointer; 428 | width: 100%; 429 | box-sizing: border-box; 430 | padding: 8px; 431 | } 432 | 433 | .elm-debugger-entry:hover { 434 | background-color: rgb(41, 41, 41); 435 | } 436 | 437 | .elm-debugger-entry-selected, .elm-debugger-entry-selected:hover { 438 | background-color: rgb(10, 10, 10); 439 | } 440 | 441 | .elm-debugger-entry-content { 442 | width: calc(100% - 40px); 443 | padding: 0 5px; 444 | box-sizing: border-box; 445 | text-overflow: ellipsis; 446 | white-space: nowrap; 447 | overflow: hidden; 448 | display: inline-block; 449 | } 450 | 451 | .elm-debugger-entry-index { 452 | color: #666; 453 | width: 40px; 454 | text-align: right; 455 | display: block; 456 | float: right; 457 | } 458 | 459 | """ ] 460 | -------------------------------------------------------------------------------- /src/Debugger/Main.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Main exposing 2 | ( cornerView 3 | , getUserModel 4 | , initialWindowHeight 5 | , initialWindowWidth 6 | , popoutView 7 | , wrapInit 8 | , wrapSubs 9 | , wrapUpdate 10 | ) 11 | 12 | 13 | import Bitwise 14 | import Debugger.Expando as Expando exposing (Expando) 15 | import Debugger.History as History exposing (History) 16 | import Debugger.Metadata as Metadata exposing (Metadata) 17 | import Debugger.Overlay as Overlay 18 | import Debugger.Report as Report 19 | import Dict exposing (Dict) 20 | import Elm.Kernel.Debugger 21 | import Html exposing (..) 22 | import Html.Attributes as A exposing (..) 23 | import Html.Events exposing (on, onClick, onInput, onMouseDown, onMouseUp) 24 | import Html.Lazy exposing (lazy) 25 | import Json.Decode as Decode exposing (Decoder) 26 | import Json.Encode as Encode 27 | import Task exposing (Task) 28 | import VirtualDom as V 29 | 30 | 31 | 32 | -- CONSTANTS 33 | 34 | 35 | minimumPanelSize : Int 36 | minimumPanelSize = 37 | 150 38 | 39 | 40 | initialWindowWidth : Int 41 | initialWindowWidth = 42 | 900 43 | 44 | 45 | initialWindowHeight : Int 46 | initialWindowHeight = 47 | 420 48 | 49 | 50 | 51 | -- SUBSCRIPTIONS 52 | 53 | 54 | wrapSubs : (model -> Sub msg) -> Model model msg -> Sub (Msg msg) 55 | wrapSubs subscriptions model = 56 | Sub.map UserMsg (subscriptions (getLatestModel model.state)) 57 | 58 | 59 | 60 | -- MODEL 61 | 62 | 63 | type alias Model model msg = 64 | { history : History model msg 65 | , state : State model msg 66 | , expandoModel : Expando 67 | , expandoMsg : Expando 68 | , metadata : Result Metadata.Error Metadata 69 | , overlay : Overlay.State 70 | , popout : Popout 71 | , layout : Layout 72 | } 73 | 74 | 75 | type Popout 76 | = Popout Popout 77 | 78 | 79 | type Layout 80 | = Vertical DragStatus Float Float 81 | | Horizontal DragStatus Float Float 82 | 83 | 84 | type DragStatus 85 | = Static 86 | | Moving 87 | 88 | 89 | getUserModel : Model model msg -> model 90 | getUserModel model = 91 | getCurrentModel model.state 92 | 93 | 94 | 95 | -- STATE 96 | 97 | 98 | type State model msg 99 | = Running model 100 | | Paused Int model model msg (History model msg) 101 | 102 | 103 | getLatestModel : State model msg -> model 104 | getLatestModel state = 105 | case state of 106 | Running model -> 107 | model 108 | 109 | Paused _ _ model _ _ -> 110 | model 111 | 112 | 113 | getCurrentModel : State model msg -> model 114 | getCurrentModel state = 115 | case state of 116 | Running model -> 117 | model 118 | 119 | Paused _ model _ _ _ -> 120 | model 121 | 122 | 123 | isPaused : State model msg -> Bool 124 | isPaused state = 125 | case state of 126 | Running _ -> 127 | False 128 | 129 | Paused _ _ _ _ _ -> 130 | True 131 | 132 | 133 | cachedHistory : Model model msg -> History model msg 134 | cachedHistory model = 135 | case model.state of 136 | Running _ -> 137 | model.history 138 | 139 | Paused _ _ _ _ history -> 140 | history 141 | 142 | 143 | 144 | -- INIT 145 | 146 | 147 | wrapInit : Encode.Value -> Popout -> (flags -> ( model, Cmd msg )) -> flags -> ( Model model msg, Cmd (Msg msg) ) 148 | wrapInit metadata popout init flags = 149 | let 150 | (userModel, userCommands) = init flags 151 | in 152 | ( { history = History.empty userModel 153 | , state = Running userModel 154 | , expandoModel = Expando.init userModel 155 | , expandoMsg = Expando.init () 156 | , metadata = Metadata.decode metadata 157 | , overlay = Overlay.none 158 | , popout = popout 159 | , layout = Horizontal Static 0.3 0.5 160 | } 161 | , Cmd.map UserMsg userCommands 162 | ) 163 | 164 | 165 | 166 | -- UPDATE 167 | 168 | 169 | type Msg msg 170 | = NoOp 171 | | UserMsg msg 172 | | TweakExpandoMsg Expando.Msg 173 | | TweakExpandoModel Expando.Msg 174 | | Resume 175 | | Jump Int 176 | | SliderJump Int 177 | | Open 178 | | Up 179 | | Down 180 | | Import 181 | | Export 182 | | Upload String 183 | | OverlayMsg Overlay.Msg 184 | -- 185 | | SwapLayout 186 | | DragStart 187 | | Drag DragInfo 188 | | DragEnd 189 | 190 | 191 | type alias UserUpdate model msg = 192 | msg -> model -> ( model, Cmd msg ) 193 | 194 | 195 | wrapUpdate : UserUpdate model msg -> Msg msg -> Model model msg -> ( Model model msg, Cmd (Msg msg) ) 196 | wrapUpdate update msg model = 197 | case msg of 198 | NoOp -> 199 | ( model, Cmd.none ) 200 | 201 | UserMsg userMsg -> 202 | let 203 | userModel = getLatestModel model.state 204 | newHistory = History.add userMsg userModel model.history 205 | ( newUserModel, userCmds ) = update userMsg userModel 206 | commands = Cmd.map UserMsg userCmds 207 | in 208 | case model.state of 209 | Running _ -> 210 | ( { model 211 | | history = newHistory 212 | , state = Running newUserModel 213 | , expandoModel = Expando.merge newUserModel model.expandoModel 214 | , expandoMsg = Expando.merge userMsg model.expandoMsg 215 | } 216 | , Cmd.batch [ commands, scroll model.popout ] 217 | ) 218 | 219 | Paused index indexModel _ _ history -> 220 | ( { model 221 | | history = newHistory 222 | , state = Paused index indexModel newUserModel userMsg history 223 | } 224 | , commands 225 | ) 226 | 227 | TweakExpandoMsg eMsg -> 228 | ( { model | expandoMsg = Expando.update eMsg model.expandoMsg } 229 | , Cmd.none 230 | ) 231 | 232 | TweakExpandoModel eMsg -> 233 | ( { model | expandoModel = Expando.update eMsg model.expandoModel } 234 | , Cmd.none 235 | ) 236 | 237 | Resume -> 238 | case model.state of 239 | Running _ -> 240 | ( model, Cmd.none ) 241 | 242 | Paused _ _ userModel userMsg _ -> 243 | ( { model 244 | | state = Running userModel 245 | , expandoMsg = Expando.merge userMsg model.expandoMsg 246 | , expandoModel = Expando.merge userModel model.expandoModel 247 | } 248 | , scroll model.popout 249 | ) 250 | 251 | Jump index -> 252 | ( jumpUpdate update index model 253 | , Cmd.none 254 | ) 255 | 256 | SliderJump index -> 257 | ( jumpUpdate update index model 258 | , scrollTo (History.idForMessageIndex index) model.popout 259 | ) 260 | 261 | Open -> 262 | ( model 263 | , Task.perform (always NoOp) (Elm.Kernel.Debugger.open model.popout) 264 | ) 265 | 266 | Up -> 267 | case model.state of 268 | Running _ -> 269 | ( model, Cmd.none ) 270 | 271 | Paused i _ _ _ history -> 272 | let 273 | targetIndex = i + 1 274 | in 275 | if targetIndex < History.size history then 276 | wrapUpdate update (SliderJump targetIndex) model 277 | else 278 | wrapUpdate update Resume model 279 | 280 | Down -> 281 | case model.state of 282 | Running _ -> 283 | wrapUpdate update (Jump (History.size model.history - 1)) model 284 | 285 | Paused index _ _ _ _ -> 286 | if index > 0 then 287 | wrapUpdate update (SliderJump (index - 1)) model 288 | else 289 | ( model, Cmd.none ) 290 | 291 | Import -> 292 | withGoodMetadata model <| 293 | \_ -> ( model, upload model.popout ) 294 | 295 | Export -> 296 | withGoodMetadata model <| 297 | \metadata -> ( model, download metadata model.history ) 298 | 299 | Upload jsonString -> 300 | withGoodMetadata model <| 301 | \metadata -> 302 | case Overlay.assessImport metadata jsonString of 303 | Err newOverlay -> 304 | ( { model | overlay = newOverlay }, Cmd.none ) 305 | 306 | Ok rawHistory -> 307 | loadNewHistory rawHistory update model 308 | 309 | OverlayMsg overlayMsg -> 310 | case Overlay.close overlayMsg model.overlay of 311 | Nothing -> 312 | ( { model | overlay = Overlay.none }, Cmd.none ) 313 | 314 | Just rawHistory -> 315 | loadNewHistory rawHistory update model 316 | 317 | SwapLayout -> 318 | ( { model | layout = swapLayout model.layout }, Cmd.none ) 319 | 320 | DragStart -> 321 | ( { model | layout = setDragStatus Moving model.layout }, Cmd.none ) 322 | 323 | Drag info -> 324 | ( { model | layout = drag info model.layout }, Cmd.none ) 325 | 326 | DragEnd -> 327 | ( { model | layout = setDragStatus Static model.layout }, Cmd.none ) 328 | 329 | 330 | jumpUpdate : UserUpdate model msg -> Int -> Model model msg -> Model model msg 331 | jumpUpdate update index model = 332 | let 333 | history = 334 | cachedHistory model 335 | 336 | currentMsg = 337 | History.getRecentMsg history 338 | 339 | currentModel = 340 | getLatestModel model.state 341 | 342 | ( indexModel, indexMsg ) = 343 | History.get update index history 344 | in 345 | { model 346 | | state = Paused index indexModel currentModel currentMsg history 347 | , expandoModel = Expando.merge indexModel model.expandoModel 348 | , expandoMsg = Expando.merge indexMsg model.expandoMsg 349 | } 350 | 351 | 352 | 353 | -- LAYOUT HELPERS 354 | 355 | 356 | swapLayout : Layout -> Layout 357 | swapLayout layout = 358 | case layout of 359 | Horizontal s x y -> Vertical s x y 360 | Vertical s x y -> Horizontal s x y 361 | 362 | 363 | setDragStatus : DragStatus -> Layout -> Layout 364 | setDragStatus status layout = 365 | case layout of 366 | Horizontal _ x y -> Horizontal status x y 367 | Vertical _ x y -> Vertical status x y 368 | 369 | 370 | drag : DragInfo -> Layout -> Layout 371 | drag info layout = 372 | case layout of 373 | Horizontal status _ y -> 374 | Horizontal status (info.x / info.width) y 375 | 376 | Vertical status x _ -> 377 | Vertical status x (info.y / info.height) 378 | 379 | 380 | 381 | -- COMMANDS 382 | 383 | 384 | scroll : Popout -> Cmd (Msg msg) 385 | scroll popout = 386 | Task.perform (always NoOp) (Elm.Kernel.Debugger.scroll popout) 387 | 388 | 389 | scrollTo : String -> Popout -> Cmd (Msg msg) 390 | scrollTo id popout = 391 | Task.perform (always NoOp) (Elm.Kernel.Debugger.scrollTo id popout) 392 | 393 | 394 | upload : Popout -> Cmd (Msg msg) 395 | upload popout = 396 | Task.perform Upload (Elm.Kernel.Debugger.upload popout) 397 | 398 | 399 | download : Metadata -> History model msg -> Cmd (Msg msg) 400 | download metadata history = 401 | let 402 | historyLength = History.size history 403 | in 404 | Task.perform (\_ -> NoOp) <| Elm.Kernel.Debugger.download historyLength <| 405 | Elm.Kernel.Json.unwrap <| 406 | Encode.object 407 | [ ( "metadata", Metadata.encode metadata ) 408 | , ( "history", History.encode history ) 409 | ] 410 | 411 | 412 | 413 | -- UPDATE OVERLAY 414 | 415 | 416 | withGoodMetadata : 417 | Model model msg 418 | -> (Metadata -> ( Model model msg, Cmd (Msg msg) )) 419 | -> ( Model model msg, Cmd (Msg msg) ) 420 | withGoodMetadata model func = 421 | case model.metadata of 422 | Ok metadata -> 423 | func metadata 424 | 425 | Err error -> 426 | ( { model | overlay = Overlay.badMetadata error } 427 | , Cmd.none 428 | ) 429 | 430 | 431 | loadNewHistory : Encode.Value -> UserUpdate model msg -> Model model msg -> ( Model model msg, Cmd (Msg msg) ) 432 | loadNewHistory rawHistory update model = 433 | let 434 | initialUserModel = 435 | History.getInitialModel model.history 436 | 437 | pureUserUpdate msg userModel = 438 | Tuple.first (update msg userModel) 439 | 440 | decoder = 441 | History.decoder initialUserModel pureUserUpdate 442 | in 443 | case Decode.decodeValue decoder rawHistory of 444 | Err _ -> 445 | ( { model | overlay = Overlay.corruptImport } 446 | , Cmd.none 447 | ) 448 | 449 | Ok ( latestUserModel, newHistory ) -> 450 | ( { model 451 | | history = newHistory 452 | , state = Running latestUserModel 453 | , expandoModel = Expando.init latestUserModel 454 | , expandoMsg = Expando.init (History.getRecentMsg newHistory) 455 | , overlay = Overlay.none 456 | } 457 | , Cmd.none 458 | ) 459 | 460 | 461 | 462 | -- CORNER VIEW 463 | 464 | 465 | cornerView : Model model msg -> Html (Msg msg) 466 | cornerView model = 467 | Overlay.view 468 | { resume = Resume 469 | , open = Open 470 | , importHistory = Import 471 | , exportHistory = Export 472 | , wrap = OverlayMsg 473 | } 474 | (isPaused model.state) 475 | (Elm.Kernel.Debugger.isOpen model.popout) 476 | (History.size model.history) 477 | model.overlay 478 | 479 | 480 | toBlockerType : Model model msg -> Overlay.BlockerType 481 | toBlockerType model = 482 | Overlay.toBlockerType (isPaused model.state) model.overlay 483 | 484 | 485 | 486 | -- BIG DEBUG VIEW 487 | 488 | 489 | popoutView : Model model msg -> Html (Msg msg) 490 | popoutView model = 491 | let 492 | maybeIndex = 493 | case model.state of 494 | Running _ -> Nothing 495 | Paused index _ _ _ _ -> Just index 496 | 497 | historyToRender = cachedHistory model 498 | in 499 | node "body" 500 | ( 501 | toDragListeners model.layout 502 | ++ 503 | [ style "margin" "0" 504 | , style "padding" "0" 505 | , style "width" "100%" 506 | , style "height" "100%" 507 | , style "font-family" "monospace" 508 | , style "display" "flex" 509 | , style "flex-direction" (toFlexDirection model.layout) 510 | ] 511 | ) 512 | [ viewHistory maybeIndex historyToRender model.layout 513 | , viewDragZone model.layout 514 | , viewExpando model.expandoMsg model.expandoModel model.layout 515 | ] 516 | 517 | 518 | toFlexDirection : Layout -> String 519 | toFlexDirection layout = 520 | case layout of 521 | Horizontal _ _ _ -> "row" 522 | Vertical _ _ _ -> "column-reverse" 523 | 524 | 525 | 526 | -- DRAG LISTENERS 527 | 528 | 529 | toDragListeners : Layout -> List (Attribute (Msg msg)) 530 | toDragListeners layout = 531 | case getDragStatus layout of 532 | Static -> [] 533 | Moving -> [ onMouseMove, onMouseUp DragEnd ] 534 | 535 | 536 | getDragStatus : Layout -> DragStatus 537 | getDragStatus layout = 538 | case layout of 539 | Horizontal status _ _ -> status 540 | Vertical status _ _ -> status 541 | 542 | 543 | type alias DragInfo = 544 | { x : Float 545 | , y : Float 546 | , down : Bool 547 | , width : Float 548 | , height : Float 549 | } 550 | 551 | 552 | onMouseMove : Attribute (Msg msg) 553 | onMouseMove = 554 | on "mousemove" <| Decode.map Drag <| 555 | Decode.map5 DragInfo 556 | (Decode.field "pageX" Decode.float) 557 | (Decode.field "pageY" Decode.float) 558 | (Decode.field "buttons" (Decode.map (\v -> v == 1) Decode.int)) 559 | (decodeDimension "innerWidth") 560 | (decodeDimension "innerHeight") 561 | 562 | 563 | decodeDimension : String -> Decoder Float 564 | decodeDimension field = 565 | Decode.at [ "currentTarget", "ownerDocument", "defaultView", field ] Decode.float 566 | 567 | 568 | 569 | -- VIEW DRAG ZONE 570 | 571 | 572 | viewDragZone : Layout -> Html (Msg msg) 573 | viewDragZone layout = 574 | case layout of 575 | Horizontal _ x _ -> 576 | div 577 | [ style "position" "absolute" 578 | , style "top" "0" 579 | , style "left" (toPercent x) 580 | , style "margin-left" "-5px" 581 | , style "width" "10px" 582 | , style "height" "100%" 583 | , style "cursor" "col-resize" 584 | , onMouseDown DragStart 585 | ] 586 | [] 587 | 588 | Vertical _ _ y -> 589 | div 590 | [ style "position" "absolute" 591 | , style "top" (toPercent y) 592 | , style "left" "0" 593 | , style "margin-top" "-5px" 594 | , style "width" "100%" 595 | , style "height" "10px" 596 | , style "cursor" "row-resize" 597 | , onMouseDown DragStart 598 | ] 599 | [] 600 | 601 | 602 | 603 | -- LAYOUT HELPERS 604 | 605 | 606 | toPercent : Float -> String 607 | toPercent fraction = 608 | String.fromFloat (100 * fraction) ++ "%" 609 | 610 | 611 | toMouseBlocker : Layout -> String 612 | toMouseBlocker layout = 613 | case getDragStatus layout of 614 | Static -> "auto" 615 | Moving -> "none" 616 | 617 | 618 | 619 | -- VIEW HISTORY 620 | 621 | 622 | viewHistory : Maybe Int -> History model msg -> Layout -> Html (Msg msg) 623 | viewHistory maybeIndex history layout = 624 | let 625 | (w,h) = toHistoryPercents layout 626 | block = toMouseBlocker layout 627 | in 628 | div 629 | [ style "width" w 630 | , style "height" h 631 | , style "display" "flex" 632 | , style "flex-direction" "column" 633 | , style "color" "#DDDDDD" 634 | , style "background-color" "rgb(61, 61, 61)" 635 | , style "pointer-events" block 636 | , style "user-select" block 637 | ] 638 | [ viewHistorySlider history maybeIndex 639 | , Html.map Jump (History.view maybeIndex history) 640 | , lazy viewHistoryOptions layout 641 | ] 642 | 643 | 644 | toHistoryPercents : Layout -> (String, String) 645 | toHistoryPercents layout = 646 | case layout of 647 | Horizontal _ x _ -> ( toPercent x, "100%" ) 648 | Vertical _ _ y -> ( "100%", toPercent (1 - y) ) 649 | 650 | 651 | viewHistorySlider : History model msg -> Maybe Int -> Html (Msg msg) 652 | viewHistorySlider history maybeIndex = 653 | let 654 | lastIndex = History.size history - 1 655 | selectedIndex = Maybe.withDefault lastIndex maybeIndex 656 | in 657 | div 658 | [ style "display" "flex" 659 | , style "flex-direction" "row" 660 | , style "align-items" "center" 661 | , style "width" "100%" 662 | , style "height" "36px" 663 | , style "background-color" "rgb(50, 50, 50)" 664 | ] 665 | [ lazy viewPlayButton (isPlaying maybeIndex) 666 | , input 667 | [ type_ "range" 668 | , style "width" "calc(100% - 56px)" 669 | , style "height" "36px" 670 | , style "margin" "0 10px" 671 | , A.min "0" 672 | , A.max (String.fromInt lastIndex) 673 | , value (String.fromInt selectedIndex) 674 | , onInput (String.toInt >> Maybe.withDefault lastIndex >> SliderJump) 675 | ] 676 | [] 677 | ] 678 | 679 | 680 | viewPlayButton : Bool -> Html (Msg msg) 681 | viewPlayButton playing = 682 | button 683 | [ style "background" "#1293D8" 684 | , style "border" "none" 685 | , style "color" "white" 686 | , style "cursor" "pointer" 687 | , style "width" "36px" 688 | , style "height" "36px" 689 | , onClick Resume 690 | ] 691 | [ if playing 692 | then icon "M2 2h4v12h-4v-12z M10 2h4v12h-4v-12z" 693 | else icon "M2 2l12 7l-12 7z" 694 | ] 695 | 696 | 697 | isPlaying : Maybe Int -> Bool 698 | isPlaying maybeIndex = 699 | case maybeIndex of 700 | Nothing -> True 701 | Just _ -> False 702 | 703 | 704 | viewHistoryOptions : Layout -> Html (Msg msg) 705 | viewHistoryOptions layout = 706 | div 707 | [ style "width" "100%" 708 | , style "height" "36px" 709 | , style "display" "flex" 710 | , style "flex-direction" "row" 711 | , style "align-items" "center" 712 | , style "justify-content" "space-between" 713 | , style "background-color" "rgb(50, 50, 50)" 714 | ] 715 | [ viewHistoryButton "Swap Layout" SwapLayout (toHistoryIcon layout) 716 | , div 717 | [ style "display" "flex" 718 | , style "flex-direction" "row" 719 | , style "align-items" "center" 720 | , style "justify-content" "space-between" 721 | ] 722 | [ viewHistoryButton "Import" Import "M5 1a1 1 0 0 1 0 2h-2a1 1 0 0 0-1 1v8a1 1 0 0 0 1 1h10a1 1 0 0 0 1-1a1 1 0 0 1 2 0a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3v-8a3 3 0 0 1 3-3z M10 2a1 1 0 0 0 -2 0v6a1 1 0 0 0 1 1h6a1 1 0 0 0 0-2h-3.586l4.293-4.293a1 1 0 0 0-1.414-1.414l-4.293 4.293z" 723 | , viewHistoryButton "Export" Export "M5 1a1 1 0 0 1 0 2h-2a1 1 0 0 0-1 1v8a1 1 0 0 0 1 1h10a1 1 0 0 0 1-1 a1 1 0 0 1 2 0a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3v-8a3 3 0 0 1 3-3z M9 3a1 1 0 1 1 0-2h6a1 1 0 0 1 1 1v6a1 1 0 1 1-2 0v-3.586l-5.293 5.293 a1 1 0 0 1-1.414-1.414l5.293 -5.293z" 724 | ] 725 | ] 726 | 727 | 728 | viewHistoryButton : String -> msg -> String -> Html msg 729 | viewHistoryButton label msg path = 730 | button 731 | [ style "display" "flex" 732 | , style "flex-direction" "row" 733 | , style "align-items" "center" 734 | , style "background" "none" 735 | , style "border" "none" 736 | , style "color" "inherit" 737 | , style "cursor" "pointer" 738 | , onClick msg 739 | ] 740 | [ icon path 741 | , span [ style "padding-left" "6px" ] [ text label ] 742 | ] 743 | 744 | 745 | icon : String -> Html msg 746 | icon path = 747 | V.nodeNS "http://www.w3.org/2000/svg" "svg" 748 | [ V.attribute "viewBox" "0 0 16 16" 749 | , V.attribute "xmlns" "http://www.w3.org/2000/svg" 750 | , V.attribute "fill" "currentColor" 751 | , V.attribute "width" "16px" 752 | , V.attribute "height" "16px" 753 | ] 754 | [ V.nodeNS "http://www.w3.org/2000/svg" "path" 755 | [ V.attribute "d" path ] 756 | [] 757 | ] 758 | 759 | 760 | toHistoryIcon : Layout -> String 761 | toHistoryIcon layout = 762 | case layout of 763 | Horizontal _ _ _ -> "M13 1a3 3 0 0 1 3 3v8a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3v-8a3 3 0 0 1 3-3z M13 3h-10a1 1 0 0 0-1 1v5h12v-5a1 1 0 0 0-1-1z M14 10h-12v2a1 1 0 0 0 1 1h10a1 1 0 0 0 1-1z" 764 | Vertical _ _ _ -> "M0 4a3 3 0 0 1 3-3h10a3 3 0 0 1 3 3v8a3 3 0 0 1-3 3h-10a3 3 0 0 1-3-3z M2 4v8a1 1 0 0 0 1 1h2v-10h-2a1 1 0 0 0-1 1z M6 3v10h7a1 1 0 0 0 1-1v-8a1 1 0 0 0-1-1z" 765 | 766 | 767 | 768 | -- VIEW EXPANDO 769 | 770 | 771 | viewExpando : Expando -> Expando -> Layout -> Html (Msg msg) 772 | viewExpando expandoMsg expandoModel layout = 773 | let 774 | (w,h) = toExpandoPercents layout 775 | block = toMouseBlocker layout 776 | in 777 | div 778 | [ style "display" "block" 779 | , style "width" ("calc(" ++ w ++ " - 4em)") 780 | , style "height" ("calc(" ++ h ++ " - 4em)") 781 | , style "padding" "2em" 782 | , style "margin" "0" 783 | , style "overflow" "auto" 784 | , style "pointer-events" block 785 | , style "-webkit-user-select" block 786 | , style "-moz-user-select" block 787 | , style "-ms-user-select" block 788 | , style "user-select" block 789 | ] 790 | [ div [ style "color" "#ccc", style "padding" "0 0 1em 0" ] [ text "-- MESSAGE" ] 791 | , Html.map TweakExpandoMsg <| Expando.view Nothing expandoMsg 792 | , div [ style "color" "#ccc", style "padding" "1em 0" ] [ text "-- MODEL" ] 793 | , Html.map TweakExpandoModel <| Expando.view Nothing expandoModel 794 | ] 795 | 796 | 797 | toExpandoPercents : Layout -> (String, String) 798 | toExpandoPercents layout = 799 | case layout of 800 | Horizontal _ x _ -> ( toPercent (1 - x), "100%" ) 801 | Vertical _ _ y -> ( "100%", toPercent y ) 802 | 803 | 804 | -- No case/let/if in parentheses. Always new top-level function. 805 | -- No case/let/if within a let. Always new top-level function. 806 | -- Replace "creating variable to use in different branches" with "same function call in different branches" 807 | -------------------------------------------------------------------------------- /src/Debugger/Metadata.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Metadata exposing 2 | ( Error 3 | , Metadata 4 | , Problem(..) 5 | , ProblemType 6 | , check 7 | , decode 8 | , decoder 9 | , encode 10 | ) 11 | 12 | import Array exposing (Array) 13 | import Debugger.Report as Report exposing (Report) 14 | import Dict exposing (Dict) 15 | import Json.Decode as Decode 16 | import Json.Encode as Encode 17 | 18 | 19 | 20 | -- METADATA 21 | 22 | 23 | type alias Metadata = 24 | { versions : Versions 25 | , types : Types 26 | } 27 | 28 | 29 | 30 | -- VERSIONS 31 | 32 | 33 | type alias Versions = 34 | { elm : String 35 | } 36 | 37 | 38 | 39 | -- TYPES 40 | 41 | 42 | type alias Types = 43 | { message : String 44 | , aliases : Dict String Alias 45 | , unions : Dict String Union 46 | } 47 | 48 | 49 | type alias Alias = 50 | { args : List String 51 | , tipe : String 52 | } 53 | 54 | 55 | type alias Union = 56 | { args : List String 57 | , tags : Dict String (List String) 58 | } 59 | 60 | 61 | 62 | -- PORTABILITY 63 | 64 | 65 | isPortable : Metadata -> Maybe Error 66 | isPortable { types } = 67 | let 68 | badAliases = 69 | Dict.foldl collectBadAliases [] types.aliases 70 | in 71 | case Dict.foldl collectBadUnions badAliases types.unions of 72 | [] -> 73 | Nothing 74 | 75 | problems -> 76 | Just (Error types.message problems) 77 | 78 | 79 | type alias Error = 80 | { message : String 81 | , problems : List ProblemType 82 | } 83 | 84 | 85 | type alias ProblemType = 86 | { name : String 87 | , problems : List Problem 88 | } 89 | 90 | 91 | type Problem 92 | = Function 93 | | Decoder 94 | | Task 95 | | Process 96 | | Socket 97 | | Request 98 | | Program 99 | | VirtualDom 100 | 101 | 102 | collectBadAliases : String -> Alias -> List ProblemType -> List ProblemType 103 | collectBadAliases name { tipe } list = 104 | case findProblems tipe of 105 | [] -> 106 | list 107 | 108 | problems -> 109 | ProblemType name problems :: list 110 | 111 | 112 | collectBadUnions : String -> Union -> List ProblemType -> List ProblemType 113 | collectBadUnions name { tags } list = 114 | case List.concatMap findProblems (List.concat (Dict.values tags)) of 115 | [] -> 116 | list 117 | 118 | problems -> 119 | ProblemType name problems :: list 120 | 121 | 122 | findProblems : String -> List Problem 123 | findProblems tipe = 124 | List.filterMap (hasProblem tipe) problemTable 125 | 126 | 127 | hasProblem : String -> ( Problem, String ) -> Maybe Problem 128 | hasProblem tipe ( problem, token ) = 129 | if String.contains token tipe then 130 | Just problem 131 | 132 | else 133 | Nothing 134 | 135 | 136 | problemTable : List ( Problem, String ) 137 | problemTable = 138 | [ ( Function, "->" ) 139 | , ( Decoder, "Json.Decode.Decoder" ) 140 | , ( Task, "Task.Task" ) 141 | , ( Process, "Process.Id" ) 142 | , ( Socket, "WebSocket.LowLevel.WebSocket" ) 143 | , ( Request, "Http.Request" ) 144 | , ( Program, "Platform.Program" ) 145 | , ( VirtualDom, "VirtualDom.Node" ) 146 | , ( VirtualDom, "VirtualDom.Attribute" ) 147 | ] 148 | 149 | 150 | 151 | -- CHECK 152 | 153 | 154 | check : Metadata -> Metadata -> Report 155 | check old new = 156 | if old.versions.elm /= new.versions.elm then 157 | Report.VersionChanged old.versions.elm new.versions.elm 158 | 159 | else 160 | checkTypes old.types new.types 161 | 162 | 163 | checkTypes : Types -> Types -> Report 164 | checkTypes old new = 165 | if old.message /= new.message then 166 | Report.MessageChanged old.message new.message 167 | 168 | else 169 | [] 170 | |> Dict.merge ignore checkAlias ignore old.aliases new.aliases 171 | |> Dict.merge ignore checkUnion ignore old.unions new.unions 172 | |> Report.SomethingChanged 173 | 174 | 175 | ignore : String -> value -> a -> a 176 | ignore key value report = 177 | report 178 | 179 | 180 | 181 | -- CHECK ALIASES 182 | 183 | 184 | checkAlias : String -> Alias -> Alias -> List Report.Change -> List Report.Change 185 | checkAlias name old new changes = 186 | if old.tipe == new.tipe && old.args == new.args then 187 | changes 188 | 189 | else 190 | Report.AliasChange name :: changes 191 | 192 | 193 | 194 | -- CHECK UNIONS 195 | 196 | 197 | checkUnion : String -> Union -> Union -> List Report.Change -> List Report.Change 198 | checkUnion name old new changes = 199 | let 200 | tagChanges = 201 | Dict.merge removeTag checkTag addTag old.tags new.tags <| 202 | Report.emptyTagChanges (old.args == new.args) 203 | in 204 | if Report.hasTagChanges tagChanges then 205 | changes 206 | 207 | else 208 | Report.UnionChange name tagChanges :: changes 209 | 210 | 211 | removeTag : String -> a -> Report.TagChanges -> Report.TagChanges 212 | removeTag tag _ changes = 213 | { changes | removed = tag :: changes.removed } 214 | 215 | 216 | addTag : String -> a -> Report.TagChanges -> Report.TagChanges 217 | addTag tag _ changes = 218 | { changes | added = tag :: changes.added } 219 | 220 | 221 | checkTag : String -> a -> a -> Report.TagChanges -> Report.TagChanges 222 | checkTag tag old new changes = 223 | if old == new then 224 | changes 225 | 226 | else 227 | { changes | changed = tag :: changes.changed } 228 | 229 | 230 | 231 | -- JSON DECODE 232 | 233 | 234 | decode : Encode.Value -> Result Error Metadata 235 | decode value = 236 | case Decode.decodeValue decoder value of 237 | Err _ -> 238 | Err (Error "The compiler is generating bad metadata. This is a compiler bug!" []) 239 | 240 | Ok metadata -> 241 | case isPortable metadata of 242 | Nothing -> 243 | Ok metadata 244 | 245 | Just error -> 246 | Err error 247 | 248 | 249 | decoder : Decode.Decoder Metadata 250 | decoder = 251 | Decode.map2 Metadata 252 | (Decode.field "versions" decodeVersions) 253 | (Decode.field "types" decodeTypes) 254 | 255 | 256 | decodeVersions : Decode.Decoder Versions 257 | decodeVersions = 258 | Decode.map Versions 259 | (Decode.field "elm" Decode.string) 260 | 261 | 262 | decodeTypes : Decode.Decoder Types 263 | decodeTypes = 264 | Decode.map3 Types 265 | (Decode.field "message" Decode.string) 266 | (Decode.field "aliases" (Decode.dict decodeAlias)) 267 | (Decode.field "unions" (Decode.dict decodeUnion)) 268 | 269 | 270 | decodeUnion : Decode.Decoder Union 271 | decodeUnion = 272 | Decode.map2 Union 273 | (Decode.field "args" (Decode.list Decode.string)) 274 | (Decode.field "tags" (Decode.dict (Decode.list Decode.string))) 275 | 276 | 277 | decodeAlias : Decode.Decoder Alias 278 | decodeAlias = 279 | Decode.map2 Alias 280 | (Decode.field "args" (Decode.list Decode.string)) 281 | (Decode.field "type" Decode.string) 282 | 283 | 284 | 285 | -- JSON ENCODE 286 | 287 | 288 | encode : Metadata -> Encode.Value 289 | encode { versions, types } = 290 | Encode.object 291 | [ ( "versions", encodeVersions versions ) 292 | , ( "types", encodeTypes types ) 293 | ] 294 | 295 | 296 | encodeVersions : Versions -> Encode.Value 297 | encodeVersions { elm } = 298 | Encode.object [ ( "elm", Encode.string elm ) ] 299 | 300 | 301 | encodeTypes : Types -> Encode.Value 302 | encodeTypes { message, unions, aliases } = 303 | Encode.object 304 | [ ( "message", Encode.string message ) 305 | , ( "aliases", encodeDict encodeAlias aliases ) 306 | , ( "unions", encodeDict encodeUnion unions ) 307 | ] 308 | 309 | 310 | encodeAlias : Alias -> Encode.Value 311 | encodeAlias { args, tipe } = 312 | Encode.object 313 | [ ( "args", Encode.list Encode.string args ) 314 | , ( "type", Encode.string tipe ) 315 | ] 316 | 317 | 318 | encodeUnion : Union -> Encode.Value 319 | encodeUnion { args, tags } = 320 | Encode.object 321 | [ ( "args", Encode.list Encode.string args ) 322 | , ( "tags", encodeDict (Encode.list Encode.string) tags ) 323 | ] 324 | 325 | 326 | encodeDict : (a -> Encode.Value) -> Dict String a -> Encode.Value 327 | encodeDict f dict = 328 | dict 329 | |> Dict.map (\key value -> f value) 330 | |> Dict.toList 331 | |> Encode.object 332 | -------------------------------------------------------------------------------- /src/Debugger/Overlay.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Overlay exposing 2 | ( BlockerType(..) 3 | , Config 4 | , Msg 5 | , State 6 | , assessImport 7 | , badMetadata 8 | , close 9 | , corruptImport 10 | , none 11 | , toBlockerType 12 | , view 13 | ) 14 | 15 | import Debugger.Metadata as Metadata exposing (Metadata) 16 | import Debugger.Report as Report exposing (Report) 17 | import Html exposing (..) 18 | import Html.Attributes exposing (..) 19 | import Html.Events exposing (onClick) 20 | import Json.Decode as Decode 21 | import Json.Encode as Encode 22 | import VirtualDom as V 23 | 24 | 25 | 26 | type State 27 | = None 28 | | BadMetadata Metadata.Error 29 | | BadImport Report 30 | | RiskyImport Report Encode.Value 31 | 32 | 33 | none : State 34 | none = 35 | None 36 | 37 | 38 | corruptImport : State 39 | corruptImport = 40 | BadImport Report.CorruptHistory 41 | 42 | 43 | badMetadata : Metadata.Error -> State 44 | badMetadata = 45 | BadMetadata 46 | 47 | 48 | 49 | -- UPDATE 50 | 51 | 52 | type Msg 53 | = Cancel 54 | | Proceed 55 | 56 | 57 | close : Msg -> State -> Maybe Encode.Value 58 | close msg state = 59 | case state of 60 | None -> 61 | Nothing 62 | 63 | BadMetadata _ -> 64 | Nothing 65 | 66 | BadImport _ -> 67 | Nothing 68 | 69 | RiskyImport _ rawHistory -> 70 | case msg of 71 | Cancel -> 72 | Nothing 73 | 74 | Proceed -> 75 | Just rawHistory 76 | 77 | 78 | assessImport : Metadata -> String -> Result State Encode.Value 79 | assessImport metadata jsonString = 80 | case Decode.decodeString uploadDecoder jsonString of 81 | Err _ -> 82 | Err corruptImport 83 | 84 | Ok ( foreignMetadata, rawHistory ) -> 85 | let 86 | report = 87 | Metadata.check foreignMetadata metadata 88 | in 89 | case Report.evaluate report of 90 | Report.Impossible -> 91 | Err (BadImport report) 92 | 93 | Report.Risky -> 94 | Err (RiskyImport report rawHistory) 95 | 96 | Report.Fine -> 97 | Ok rawHistory 98 | 99 | 100 | uploadDecoder : Decode.Decoder ( Metadata, Encode.Value ) 101 | uploadDecoder = 102 | Decode.map2 (\x y -> ( x, y )) 103 | (Decode.field "metadata" Metadata.decoder) 104 | (Decode.field "history" Decode.value) 105 | 106 | 107 | 108 | -- BLOCKERS 109 | 110 | 111 | type BlockerType 112 | = BlockNone 113 | | BlockMost 114 | | BlockAll 115 | 116 | 117 | toBlockerType : Bool -> State -> BlockerType 118 | toBlockerType isPaused state = 119 | case state of 120 | None -> 121 | if isPaused then 122 | BlockAll 123 | 124 | else 125 | BlockNone 126 | 127 | BadMetadata _ -> 128 | BlockMost 129 | 130 | BadImport _ -> 131 | BlockMost 132 | 133 | RiskyImport _ _ -> 134 | BlockMost 135 | 136 | 137 | 138 | -- VIEW 139 | 140 | 141 | type alias Config msg = 142 | { resume : msg 143 | , open : msg 144 | , importHistory : msg 145 | , exportHistory : msg 146 | , wrap : Msg -> msg 147 | } 148 | 149 | 150 | view : Config msg -> Bool -> Bool -> Int -> State -> Html msg 151 | view config isPaused isOpen numMsgs state = 152 | case state of 153 | None -> 154 | if isOpen then 155 | text "" 156 | 157 | else if isPaused then 158 | div 159 | [ id "elm-debugger-overlay" 160 | , style "position" "fixed" 161 | , style "top" "0" 162 | , style "left" "0" 163 | , style "width" "100vw" 164 | , style "height" "100vh" 165 | , style "cursor" "pointer" 166 | , style "display" "flex" 167 | , style "align-items" "center" 168 | , style "justify-content" "center" 169 | , style "pointer-events" "auto" 170 | , style "background-color" "rgba(200, 200, 200, 0.7)" 171 | , style "color" "white" 172 | , style "font-family" "'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif" 173 | , style "z-index" "2147483646" 174 | , onClick config.resume 175 | ] 176 | [ span [ style "font-size" "80px" ] [ text "Click to Resume" ] 177 | , viewMiniControls config numMsgs 178 | ] 179 | 180 | else 181 | viewMiniControls config numMsgs 182 | 183 | BadMetadata badMetadata_ -> 184 | viewMessage config 185 | "Cannot use Import or Export" 186 | (viewBadMetadata badMetadata_) 187 | (Accept "Ok") 188 | 189 | BadImport report -> 190 | viewMessage config 191 | "Cannot Import History" 192 | (viewReport True report) 193 | (Accept "Ok") 194 | 195 | RiskyImport report _ -> 196 | viewMessage config 197 | "Warning" 198 | (viewReport False report) 199 | (Choose "Cancel" "Import Anyway") 200 | 201 | 202 | 203 | -- VIEW MESSAGE 204 | 205 | 206 | viewMessage : Config msg -> String -> List (Html msg) -> Buttons -> Html msg 207 | viewMessage config title details buttons = 208 | div 209 | [ id "elm-debugger-overlay" 210 | , style "position" "fixed" 211 | , style "top" "0" 212 | , style "left" "0" 213 | , style "width" "100vw" 214 | , style "height" "100vh" 215 | , style "color" "white" 216 | , style "pointer-events" "none" 217 | , style "font-family" "'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif" 218 | , style "z-index" "2147483647" 219 | ] 220 | [ div 221 | [ style "position" "absolute" 222 | , style "width" "600px" 223 | , style "height" "100vh" 224 | , style "padding-left" "calc(50% - 300px)" 225 | , style "padding-right" "calc(50% - 300px)" 226 | , style "background-color" "rgba(200, 200, 200, 0.7)" 227 | , style "pointer-events" "auto" 228 | ] 229 | [ div 230 | [ style "font-size" "36px" 231 | , style "height" "80px" 232 | , style "background-color" "rgb(50, 50, 50)" 233 | , style "padding-left" "22px" 234 | , style "vertical-align" "middle" 235 | , style "line-height" "80px" 236 | ] 237 | [ text title ] 238 | , div 239 | [ id "elm-debugger-details" 240 | , style "padding" " 8px 20px" 241 | , style "overflow-y" "auto" 242 | , style "max-height" "calc(100vh - 156px)" 243 | , style "background-color" "rgb(61, 61, 61)" 244 | ] 245 | details 246 | , Html.map config.wrap (viewButtons buttons) 247 | ] 248 | ] 249 | 250 | 251 | viewReport : Bool -> Report -> List (Html msg) 252 | viewReport isBad report = 253 | case report of 254 | Report.CorruptHistory -> 255 | [ text "Looks like this history file is corrupt. I cannot understand it." 256 | ] 257 | 258 | Report.VersionChanged old new -> 259 | [ text <| 260 | "This history was created with Elm " 261 | ++ old 262 | ++ ", but you are using Elm " 263 | ++ new 264 | ++ " right now." 265 | ] 266 | 267 | Report.MessageChanged old new -> 268 | [ text <| 269 | "To import some other history, the overall message type must" 270 | ++ " be the same. The old history has " 271 | , viewCode old 272 | , text " messages, but the new program works with " 273 | , viewCode new 274 | , text " messages." 275 | ] 276 | 277 | Report.SomethingChanged changes -> 278 | [ p [] 279 | [ text 280 | (if isBad then 281 | explanationBad 282 | 283 | else 284 | explanationRisky 285 | ) 286 | ] 287 | , ul 288 | [ style "list-style-type" "none" 289 | , style "padding-left" "20px" 290 | ] 291 | (List.map viewChange changes) 292 | ] 293 | 294 | 295 | explanationBad : String 296 | explanationBad = 297 | """ 298 | The messages in this history do not match the messages handled by your 299 | program. I noticed changes in the following types: 300 | """ 301 | 302 | 303 | explanationRisky : String 304 | explanationRisky = 305 | """ 306 | This history seems old. It will work with this program, but some 307 | messages have been added since the history was created: 308 | """ 309 | 310 | 311 | viewCode : String -> Html msg 312 | viewCode name = 313 | code [] [ text name ] 314 | 315 | 316 | viewChange : Report.Change -> Html msg 317 | viewChange change = 318 | li [ style "margin" "8px 0" ] <| 319 | case change of 320 | Report.AliasChange name -> 321 | [ span [ style "font-size" "1.5em" ] [ viewCode name ] 322 | ] 323 | 324 | Report.UnionChange name { removed, changed, added, argsMatch } -> 325 | [ span [ style "font-size" "1.5em" ] [ viewCode name ] 326 | , ul 327 | [ style "list-style-type" "disc" 328 | , style "padding-left" "2em" 329 | ] 330 | [ viewMention removed "Removed " 331 | , viewMention changed "Changed " 332 | , viewMention added "Added " 333 | ] 334 | , if argsMatch then 335 | text "" 336 | 337 | else 338 | text "This may be due to the fact that the type variable names changed." 339 | ] 340 | 341 | 342 | viewMention : List String -> String -> Html msg 343 | viewMention tags verbed = 344 | case List.map viewCode (List.reverse tags) of 345 | [] -> 346 | text "" 347 | 348 | [ tag ] -> 349 | li [] 350 | [ text verbed, tag, text "." ] 351 | 352 | [ tag2, tag1 ] -> 353 | li [] 354 | [ text verbed, tag1, text " and ", tag2, text "." ] 355 | 356 | lastTag :: otherTags -> 357 | li [] <| 358 | text verbed 359 | :: List.intersperse (text ", ") (List.reverse otherTags) 360 | ++ [ text ", and ", lastTag, text "." ] 361 | 362 | 363 | viewBadMetadata : Metadata.Error -> List (Html msg) 364 | viewBadMetadata {message, problems} = 365 | [ p [] 366 | [ text "The " 367 | , viewCode message 368 | , text " type of your program cannot be reliably serialized for history files." 369 | ] 370 | , p [] [ text "Functions cannot be serialized, nor can values that contain functions. This is a problem in these places:" ] 371 | , ul [] (List.map viewProblemType problems) 372 | , p [] 373 | [ text goodNews1 374 | , a [ href "https://guide.elm-lang.org/types/custom_types.html" ] [ text "custom types" ] 375 | , text ", in your messages. From there, your " 376 | , viewCode "update" 377 | , text goodNews2 378 | ] 379 | ] 380 | 381 | 382 | goodNews1 = """ 383 | The good news is that having values like this in your message type is not 384 | so great in the long run. You are better off using simpler data, like 385 | """ 386 | 387 | 388 | goodNews2 = """ 389 | function can pattern match on that data and call whatever functions, JSON 390 | decoders, etc. you need. This makes the code much more explicit and easy to 391 | follow for other readers (or you in a few months!) 392 | """ 393 | 394 | 395 | viewProblemType : Metadata.ProblemType -> Html msg 396 | viewProblemType { name, problems } = 397 | li [] 398 | [ viewCode name 399 | , text (" can contain " ++ addCommas (List.map problemToString problems) ++ ".") 400 | ] 401 | 402 | 403 | problemToString : Metadata.Problem -> String 404 | problemToString problem = 405 | case problem of 406 | Metadata.Function -> "functions" 407 | Metadata.Decoder -> "JSON decoders" 408 | Metadata.Task -> "tasks" 409 | Metadata.Process -> "processes" 410 | Metadata.Socket -> "web sockets" 411 | Metadata.Request -> "HTTP requests" 412 | Metadata.Program -> "programs" 413 | Metadata.VirtualDom -> "virtual DOM values" 414 | 415 | 416 | addCommas : List String -> String 417 | addCommas items = 418 | case items of 419 | [] -> 420 | "" 421 | 422 | [item] -> 423 | item 424 | 425 | [item1,item2] -> 426 | item1 ++ " and " ++ item2 427 | 428 | lastItem :: otherItems -> 429 | String.join ", " (otherItems ++ [ " and " ++ lastItem ]) 430 | 431 | 432 | 433 | -- VIEW MESSAGE BUTTONS 434 | 435 | 436 | type Buttons 437 | = Accept String 438 | | Choose String String 439 | 440 | 441 | viewButtons : Buttons -> Html Msg 442 | viewButtons buttons = 443 | let 444 | btn msg string = 445 | Html.button [ style "margin-right" "20px", onClick msg ] [ text string ] 446 | 447 | buttonNodes = 448 | case buttons of 449 | Accept proceed -> 450 | [ btn Proceed proceed 451 | ] 452 | 453 | Choose cancel proceed -> 454 | [ btn Cancel cancel 455 | , btn Proceed proceed 456 | ] 457 | in 458 | div 459 | [ style "height" "60px" 460 | , style "line-height" "60px" 461 | , style "text-align" "right" 462 | , style "background-color" "rgb(50, 50, 50)" 463 | ] 464 | buttonNodes 465 | 466 | 467 | 468 | -- VIEW MINI CONTROLS 469 | 470 | 471 | viewMiniControls : Config msg -> Int -> Html msg 472 | viewMiniControls config numMsgs = 473 | let 474 | string = String.fromInt numMsgs 475 | width = String.fromInt (2 + String.length string) 476 | in 477 | div 478 | [ style "position" "fixed" 479 | , style "bottom" "2em" 480 | , style "right" "2em" 481 | , style "width" ("calc(42px + " ++ width ++ "ch)") 482 | , style "height" "36px" 483 | , style "background-color" "#1293D8" 484 | , style "color" "white" 485 | , style "font-family" "monospace" 486 | , style "pointer-events" "auto" 487 | , style "z-index" "2147483647" 488 | , style "display" "flex" 489 | , style "justify-content" "center" 490 | , style "align-items" "center" 491 | , style "cursor" "pointer" 492 | , onClick config.open 493 | ] 494 | [ elmLogo 495 | , span 496 | [ style "padding-left" "calc(1ch + 6px)" 497 | , style "padding-right" "1ch" 498 | ] 499 | [ text string ] 500 | ] 501 | 502 | 503 | elmLogo : Html msg 504 | elmLogo = 505 | V.nodeNS "http://www.w3.org/2000/svg" "svg" 506 | [ V.attribute "viewBox" "-300 -300 600 600" 507 | , V.attribute "xmlns" "http://www.w3.org/2000/svg" 508 | , V.attribute "fill" "currentColor" 509 | , V.attribute "width" "24px" 510 | , V.attribute "height" "24px" 511 | ] 512 | [ V.nodeNS "http://www.w3.org/2000/svg" "g" 513 | [ V.attribute "transform" "scale(1 -1)" 514 | ] 515 | [ viewShape 0 -210 0 "-280,-90 0,190 280,-90" 516 | , viewShape -210 0 90 "-280,-90 0,190 280,-90" 517 | , viewShape 207 207 45 "-198,-66 0,132 198,-66" 518 | , viewShape 150 0 0 "-130,0 0,-130 130,0 0,130" 519 | , viewShape -89 239 0 "-191,61 69,61 191,-61 -69,-61" 520 | , viewShape 0 106 180 "-130,-44 0,86 130,-44" 521 | , viewShape 256 -150 270 "-130,-44 0,86 130,-44" 522 | ] 523 | ] 524 | 525 | 526 | viewShape : Float -> Float -> Float -> String -> Html msg 527 | viewShape x y angle coordinates = 528 | V.nodeNS "http://www.w3.org/2000/svg" "polygon" 529 | [ V.attribute "points" coordinates 530 | , V.attribute "transform" <| 531 | "translate(" ++ String.fromFloat x ++ " " ++ String.fromFloat y 532 | ++ ") rotate(" ++ String.fromFloat -angle ++ ")" 533 | ] 534 | [] 535 | -------------------------------------------------------------------------------- /src/Debugger/Report.elm: -------------------------------------------------------------------------------- 1 | module Debugger.Report exposing 2 | ( Change(..) 3 | , Report(..) 4 | , Status(..) 5 | , TagChanges 6 | , emptyTagChanges 7 | , evaluate 8 | , hasTagChanges 9 | ) 10 | 11 | -- REPORTS 12 | 13 | 14 | type Report 15 | = CorruptHistory 16 | | VersionChanged String String 17 | | MessageChanged String String 18 | | SomethingChanged (List Change) 19 | 20 | 21 | type Change 22 | = AliasChange String 23 | | UnionChange String TagChanges 24 | 25 | 26 | type alias TagChanges = 27 | { removed : List String 28 | , changed : List String 29 | , added : List String 30 | , argsMatch : Bool 31 | } 32 | 33 | 34 | emptyTagChanges : Bool -> TagChanges 35 | emptyTagChanges argsMatch = 36 | TagChanges [] [] [] argsMatch 37 | 38 | 39 | hasTagChanges : TagChanges -> Bool 40 | hasTagChanges tagChanges = 41 | tagChanges == TagChanges [] [] [] True 42 | 43 | 44 | type Status 45 | = Impossible 46 | | Risky 47 | | Fine 48 | 49 | 50 | evaluate : Report -> Status 51 | evaluate report = 52 | case report of 53 | CorruptHistory -> 54 | Impossible 55 | 56 | VersionChanged _ _ -> 57 | Impossible 58 | 59 | MessageChanged _ _ -> 60 | Impossible 61 | 62 | SomethingChanged changes -> 63 | worstCase Fine (List.map evaluateChange changes) 64 | 65 | 66 | worstCase : Status -> List Status -> Status 67 | worstCase status statusList = 68 | case statusList of 69 | [] -> 70 | status 71 | 72 | Impossible :: _ -> 73 | Impossible 74 | 75 | Risky :: rest -> 76 | worstCase Risky rest 77 | 78 | Fine :: rest -> 79 | worstCase status rest 80 | 81 | 82 | evaluateChange : Change -> Status 83 | evaluateChange change = 84 | case change of 85 | AliasChange _ -> 86 | Impossible 87 | 88 | UnionChange _ { removed, changed, added, argsMatch } -> 89 | if not argsMatch || some changed || some removed then 90 | Impossible 91 | 92 | else if some added then 93 | Risky 94 | 95 | else 96 | Fine 97 | 98 | 99 | some : List a -> Bool 100 | some list = 101 | not (List.isEmpty list) 102 | -------------------------------------------------------------------------------- /src/Elm/Kernel/Browser.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Basics exposing (never) 4 | import Browser exposing (Internal, External) 5 | import Browser.Dom as Dom exposing (NotFound) 6 | import Elm.Kernel.Debug exposing (crash) 7 | import Elm.Kernel.Debugger exposing (element, document) 8 | import Elm.Kernel.Json exposing (runHelp) 9 | import Elm.Kernel.List exposing (Nil) 10 | import Elm.Kernel.Platform exposing (initialize) 11 | import Elm.Kernel.Scheduler exposing (binding, fail, rawSpawn, succeed, spawn) 12 | import Elm.Kernel.Utils exposing (Tuple0, Tuple2) 13 | import Elm.Kernel.VirtualDom exposing (appendChild, applyPatches, diff, doc, node, passiveSupported, render, divertHrefToApp) 14 | import Json.Decode as Json exposing (map) 15 | import Maybe exposing (Just, Nothing) 16 | import Result exposing (isOk) 17 | import Task exposing (perform) 18 | import Url exposing (fromString) 19 | 20 | */ 21 | 22 | 23 | 24 | // ELEMENT 25 | 26 | 27 | var __Debugger_element; 28 | 29 | var _Browser_element = __Debugger_element || F4(function(impl, flagDecoder, debugMetadata, args) 30 | { 31 | return __Platform_initialize( 32 | flagDecoder, 33 | args, 34 | impl.__$init, 35 | impl.__$update, 36 | impl.__$subscriptions, 37 | function(sendToApp, initialModel) { 38 | var view = impl.__$view; 39 | /**__PROD/ 40 | var domNode = args['node']; 41 | //*/ 42 | /**__DEBUG/ 43 | var domNode = args && args['node'] ? args['node'] : __Debug_crash(0); 44 | //*/ 45 | var currNode = _VirtualDom_virtualize(domNode); 46 | 47 | return _Browser_makeAnimator(initialModel, function(model) 48 | { 49 | var nextNode = view(model); 50 | var patches = __VirtualDom_diff(currNode, nextNode); 51 | domNode = __VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); 52 | currNode = nextNode; 53 | }); 54 | } 55 | ); 56 | }); 57 | 58 | 59 | 60 | // DOCUMENT 61 | 62 | 63 | var __Debugger_document; 64 | 65 | var _Browser_document = __Debugger_document || F4(function(impl, flagDecoder, debugMetadata, args) 66 | { 67 | return __Platform_initialize( 68 | flagDecoder, 69 | args, 70 | impl.__$init, 71 | impl.__$update, 72 | impl.__$subscriptions, 73 | function(sendToApp, initialModel) { 74 | var divertHrefToApp = impl.__$setup && impl.__$setup(sendToApp) 75 | var view = impl.__$view; 76 | var title = __VirtualDom_doc.title; 77 | var bodyNode = __VirtualDom_doc.body; 78 | var currNode = _VirtualDom_virtualize(bodyNode); 79 | return _Browser_makeAnimator(initialModel, function(model) 80 | { 81 | __VirtualDom_divertHrefToApp = divertHrefToApp; 82 | var doc = view(model); 83 | var nextNode = __VirtualDom_node('body')(__List_Nil)(doc.__$body); 84 | var patches = __VirtualDom_diff(currNode, nextNode); 85 | bodyNode = __VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); 86 | currNode = nextNode; 87 | __VirtualDom_divertHrefToApp = 0; 88 | (title !== doc.__$title) && (__VirtualDom_doc.title = title = doc.__$title); 89 | }); 90 | } 91 | ); 92 | }); 93 | 94 | 95 | 96 | // ANIMATION 97 | 98 | 99 | var _Browser_cancelAnimationFrame = 100 | typeof cancelAnimationFrame !== 'undefined' 101 | ? cancelAnimationFrame 102 | : function(id) { clearTimeout(id); }; 103 | 104 | var _Browser_requestAnimationFrame = 105 | typeof requestAnimationFrame !== 'undefined' 106 | ? requestAnimationFrame 107 | : function(callback) { return setTimeout(callback, 1000 / 60); }; 108 | 109 | 110 | function _Browser_makeAnimator(model, draw) 111 | { 112 | draw(model); 113 | 114 | var state = __4_NO_REQUEST; 115 | 116 | function updateIfNeeded() 117 | { 118 | state = state === __4_EXTRA_REQUEST 119 | ? __4_NO_REQUEST 120 | : ( _Browser_requestAnimationFrame(updateIfNeeded), draw(model), __4_EXTRA_REQUEST ); 121 | } 122 | 123 | return function(nextModel, isSync) 124 | { 125 | model = nextModel; 126 | 127 | isSync 128 | ? ( draw(model), 129 | state === __4_PENDING_REQUEST && (state = __4_EXTRA_REQUEST) 130 | ) 131 | : ( state === __4_NO_REQUEST && _Browser_requestAnimationFrame(updateIfNeeded), 132 | state = __4_PENDING_REQUEST 133 | ); 134 | }; 135 | } 136 | 137 | 138 | 139 | // APPLICATION 140 | 141 | 142 | function _Browser_application(impl) 143 | { 144 | var onUrlChange = impl.__$onUrlChange; 145 | var onUrlRequest = impl.__$onUrlRequest; 146 | var key = function() { key.__sendToApp(onUrlChange(_Browser_getUrl())); }; 147 | 148 | return _Browser_document({ 149 | __$setup: function(sendToApp) 150 | { 151 | key.__sendToApp = sendToApp; 152 | _Browser_window.addEventListener('popstate', key); 153 | _Browser_window.navigator.userAgent.indexOf('Trident') < 0 || _Browser_window.addEventListener('hashchange', key); 154 | 155 | return F2(function(domNode, event) 156 | { 157 | if (!event.ctrlKey && !event.metaKey && !event.shiftKey && event.button < 1 && !domNode.target && !domNode.hasAttribute('download')) 158 | { 159 | event.preventDefault(); 160 | var href = domNode.href; 161 | var curr = _Browser_getUrl(); 162 | var next = __Url_fromString(href).a; 163 | sendToApp(onUrlRequest( 164 | (next 165 | && curr.__$protocol === next.__$protocol 166 | && curr.__$host === next.__$host 167 | && curr.__$port_.a === next.__$port_.a 168 | ) 169 | ? __Browser_Internal(next) 170 | : __Browser_External(href) 171 | )); 172 | } 173 | }); 174 | }, 175 | __$init: function(flags) 176 | { 177 | return A3(impl.__$init, flags, _Browser_getUrl(), key); 178 | }, 179 | __$view: impl.__$view, 180 | __$update: impl.__$update, 181 | __$subscriptions: impl.__$subscriptions 182 | }); 183 | } 184 | 185 | function _Browser_getUrl() 186 | { 187 | return __Url_fromString(__VirtualDom_doc.location.href).a || __Debug_crash(1); 188 | } 189 | 190 | var _Browser_go = F2(function(key, n) 191 | { 192 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { 193 | n && history.go(n); 194 | key(); 195 | })); 196 | }); 197 | 198 | var _Browser_pushUrl = F2(function(key, url) 199 | { 200 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { 201 | history.pushState({}, '', url); 202 | key(); 203 | })); 204 | }); 205 | 206 | var _Browser_replaceUrl = F2(function(key, url) 207 | { 208 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function() { 209 | history.replaceState({}, '', url); 210 | key(); 211 | })); 212 | }); 213 | 214 | 215 | 216 | // GLOBAL EVENTS 217 | 218 | 219 | var _Browser_fakeNode = { addEventListener: function() {}, removeEventListener: function() {} }; 220 | var _Browser_doc = typeof document !== 'undefined' ? document : _Browser_fakeNode; 221 | var _Browser_window = typeof window !== 'undefined' ? window : _Browser_fakeNode; 222 | 223 | var _Browser_on = F3(function(node, eventName, sendToSelf) 224 | { 225 | return __Scheduler_spawn(__Scheduler_binding(function(callback) 226 | { 227 | function handler(event) { __Scheduler_rawSpawn(sendToSelf(event)); } 228 | node.addEventListener(eventName, handler, __VirtualDom_passiveSupported && { passive: true }); 229 | return function() { node.removeEventListener(eventName, handler); }; 230 | })); 231 | }); 232 | 233 | var _Browser_decodeEvent = F2(function(decoder, event) 234 | { 235 | var result = __Json_runHelp(decoder, event); 236 | return __Result_isOk(result) ? __Maybe_Just(result.a) : __Maybe_Nothing; 237 | }); 238 | 239 | 240 | 241 | // PAGE VISIBILITY 242 | 243 | 244 | function _Browser_visibilityInfo() 245 | { 246 | return (typeof __VirtualDom_doc.hidden !== 'undefined') 247 | ? { __$hidden: 'hidden', __$change: 'visibilitychange' } 248 | : 249 | (typeof __VirtualDom_doc.mozHidden !== 'undefined') 250 | ? { __$hidden: 'mozHidden', __$change: 'mozvisibilitychange' } 251 | : 252 | (typeof __VirtualDom_doc.msHidden !== 'undefined') 253 | ? { __$hidden: 'msHidden', __$change: 'msvisibilitychange' } 254 | : 255 | (typeof __VirtualDom_doc.webkitHidden !== 'undefined') 256 | ? { __$hidden: 'webkitHidden', __$change: 'webkitvisibilitychange' } 257 | : { __$hidden: 'hidden', __$change: 'visibilitychange' }; 258 | } 259 | 260 | 261 | 262 | // ANIMATION FRAMES 263 | 264 | 265 | function _Browser_rAF() 266 | { 267 | return __Scheduler_binding(function(callback) 268 | { 269 | var id = _Browser_requestAnimationFrame(function() { 270 | callback(__Scheduler_succeed(Date.now())); 271 | }); 272 | 273 | return function() { 274 | _Browser_cancelAnimationFrame(id); 275 | }; 276 | }); 277 | } 278 | 279 | 280 | function _Browser_now() 281 | { 282 | return __Scheduler_binding(function(callback) 283 | { 284 | callback(__Scheduler_succeed(Date.now())); 285 | }); 286 | } 287 | 288 | 289 | 290 | // DOM STUFF 291 | 292 | 293 | function _Browser_withNode(id, doStuff) 294 | { 295 | return __Scheduler_binding(function(callback) 296 | { 297 | _Browser_requestAnimationFrame(function() { 298 | var node = document.getElementById(id); 299 | callback(node 300 | ? __Scheduler_succeed(doStuff(node)) 301 | : __Scheduler_fail(__Dom_NotFound(id)) 302 | ); 303 | }); 304 | }); 305 | } 306 | 307 | 308 | function _Browser_withWindow(doStuff) 309 | { 310 | return __Scheduler_binding(function(callback) 311 | { 312 | _Browser_requestAnimationFrame(function() { 313 | callback(__Scheduler_succeed(doStuff())); 314 | }); 315 | }); 316 | } 317 | 318 | 319 | // FOCUS and BLUR 320 | 321 | 322 | var _Browser_call = F2(function(functionName, id) 323 | { 324 | return _Browser_withNode(id, function(node) { 325 | node[functionName](); 326 | return __Utils_Tuple0; 327 | }); 328 | }); 329 | 330 | 331 | 332 | // WINDOW VIEWPORT 333 | 334 | 335 | function _Browser_getViewport() 336 | { 337 | return { 338 | __$scene: _Browser_getScene(), 339 | __$viewport: { 340 | __$x: _Browser_window.pageXOffset, 341 | __$y: _Browser_window.pageYOffset, 342 | __$width: _Browser_doc.documentElement.clientWidth, 343 | __$height: _Browser_doc.documentElement.clientHeight 344 | } 345 | }; 346 | } 347 | 348 | function _Browser_getScene() 349 | { 350 | var body = _Browser_doc.body; 351 | var elem = _Browser_doc.documentElement; 352 | return { 353 | __$width: Math.max(body.scrollWidth, body.offsetWidth, elem.scrollWidth, elem.offsetWidth, elem.clientWidth), 354 | __$height: Math.max(body.scrollHeight, body.offsetHeight, elem.scrollHeight, elem.offsetHeight, elem.clientHeight) 355 | }; 356 | } 357 | 358 | var _Browser_setViewport = F2(function(x, y) 359 | { 360 | return _Browser_withWindow(function() 361 | { 362 | _Browser_window.scroll(x, y); 363 | return __Utils_Tuple0; 364 | }); 365 | }); 366 | 367 | 368 | 369 | // ELEMENT VIEWPORT 370 | 371 | 372 | function _Browser_getViewportOf(id) 373 | { 374 | return _Browser_withNode(id, function(node) 375 | { 376 | return { 377 | __$scene: { 378 | __$width: node.scrollWidth, 379 | __$height: node.scrollHeight 380 | }, 381 | __$viewport: { 382 | __$x: node.scrollLeft, 383 | __$y: node.scrollTop, 384 | __$width: node.clientWidth, 385 | __$height: node.clientHeight 386 | } 387 | }; 388 | }); 389 | } 390 | 391 | 392 | var _Browser_setViewportOf = F3(function(id, x, y) 393 | { 394 | return _Browser_withNode(id, function(node) 395 | { 396 | node.scrollLeft = x; 397 | node.scrollTop = y; 398 | return __Utils_Tuple0; 399 | }); 400 | }); 401 | 402 | 403 | 404 | // ELEMENT 405 | 406 | 407 | function _Browser_getElement(id) 408 | { 409 | return _Browser_withNode(id, function(node) 410 | { 411 | var rect = node.getBoundingClientRect(); 412 | var x = _Browser_window.pageXOffset; 413 | var y = _Browser_window.pageYOffset; 414 | return { 415 | __$scene: _Browser_getScene(), 416 | __$viewport: { 417 | __$x: x, 418 | __$y: y, 419 | __$width: _Browser_doc.documentElement.clientWidth, 420 | __$height: _Browser_doc.documentElement.clientHeight 421 | }, 422 | __$element: { 423 | __$x: x + rect.left, 424 | __$y: y + rect.top, 425 | __$width: rect.width, 426 | __$height: rect.height 427 | } 428 | }; 429 | }); 430 | } 431 | 432 | 433 | 434 | // LOAD and RELOAD 435 | 436 | 437 | function _Browser_reload(skipCache) 438 | { 439 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function(callback) 440 | { 441 | __VirtualDom_doc.location.reload(skipCache); 442 | })); 443 | } 444 | 445 | function _Browser_load(url) 446 | { 447 | return A2(__Task_perform, __Basics_never, __Scheduler_binding(function(callback) 448 | { 449 | try 450 | { 451 | _Browser_window.location = url; 452 | } 453 | catch(err) 454 | { 455 | // Only Firefox can throw a NS_ERROR_MALFORMED_URI exception here. 456 | // Other browsers reload the page, so let's be consistent about that. 457 | __VirtualDom_doc.location.reload(false); 458 | } 459 | })); 460 | } 461 | -------------------------------------------------------------------------------- /src/Elm/Kernel/Browser.server.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Elm.Kernel.Debug exposing (crash) 4 | import Elm.Kernel.Json exposing (run, wrap) 5 | import Elm.Kernel.Platform exposing (preload) 6 | import Elm.Kernel.Scheduler exposing (binding, succeed, spawn) 7 | import Elm.Kernel.Utils exposing (Tuple0) 8 | import Elm.Kernel.VirtualDom exposing (body) 9 | import Json.Decode as Json exposing (map) 10 | import Platform.Sub as Sub exposing (none) 11 | import Result exposing (isOk) 12 | 13 | */ 14 | 15 | 16 | 17 | // DUMMY STUFF 18 | 19 | 20 | function _Browser_invalidUrl(url) { __Debug_crash(1, url); } 21 | function _Browser_makeUnitTask() { return _Browser_unitTask; } 22 | function _Browser_makeNeverResolve() { return __Scheduler_binding(function(){}); } 23 | var _Browser_unitTask = __Scheduler_succeed(__Utils_Tuple0); 24 | var _Browser_go = _Browser_makeUnitTask; 25 | var _Browser_pushState = _Browser_makeNeverResolve 26 | var _Browser_replaceState = _Browser_makeNeverResolve; 27 | var _Browser_reload = _Browser_makeUnitTask; 28 | var _Browser_load = _Browser_makeUnitTask; 29 | var _Browser_call = F2(_Browser_makeUnitTask); 30 | var _Browser_setPositiveScroll = F3(_Browser_makeUnitTask); 31 | var _Browser_setNegativeScroll = F4(_Browser_makeUnitTask); 32 | var _Browser_getScroll = _Browser_makeNeverResolve; 33 | var _Browser_on = F4(function() { return __Scheduler_spawn(_Browser_unitTask); }); 34 | 35 | 36 | 37 | // PROGRAMS 38 | 39 | 40 | var _Browser_element = F4(function(impl, flagDecoder, object, debugMetadata) 41 | { 42 | object['prerender'] = function(flags) 43 | { 44 | return _Browser_prerender(flagDecoder, flags, impl); 45 | }; 46 | 47 | object['render'] = function(flags) 48 | { 49 | return _Browser_render(flagDecoder, flags, impl, function(html, preload) { 50 | return { 51 | html: html, 52 | preload: preload 53 | }; 54 | }); 55 | }; 56 | }); 57 | 58 | 59 | var _Browser_document = F4(function(impl, flagDecoder, object, debugMetadata) 60 | { 61 | object['prerender'] = function(url, flags) 62 | { 63 | return _Browser_prerender(_Browser_addEnv(url, flagDecoder), flags, impl); 64 | }; 65 | 66 | object['render'] = function(url, flags) 67 | { 68 | return _Browser_render(_Browser_addEnv(url, flagDecoder), flags, impl, function(ui, preload) { 69 | return { 70 | title: ui.__$title, 71 | body: __VirtualDom_body(ui.__$body), 72 | preload: preload 73 | }; 74 | }); 75 | }; 76 | }); 77 | 78 | 79 | 80 | // PROGRAM HELPERS 81 | 82 | 83 | function _Browser_prerender(flagDecoder, flags, impl) 84 | { 85 | __Platform_preload = new Set(); 86 | _Browser_dispatchCommands(_Browser_init(flagDecoder, flags, impl.__$init).b); 87 | var preload = __Platform_preload; 88 | __Platform_preload = null; 89 | return preload; 90 | } 91 | 92 | 93 | function _Browser_render(flagDecoder, flags, impl, toOutput) 94 | { 95 | __Platform_preload = new Set(); 96 | var pair = _Browser_init(flagDecoder, flags, impl.__$init); 97 | _Browser_dispatchCommands(pair.b); 98 | var view = impl.__$view(pair.a); 99 | var preload = __Platform_preload; 100 | __Platform_preload = null; 101 | return toOutput(view, preload); 102 | } 103 | 104 | 105 | function _Browser_init(flagDecoder, flags, init) 106 | { 107 | var result = A2(__Json_run, flagDecoder, __Json_wrap(flags)); 108 | return __Result_isOk(result) ? init(result.a) : __Debug_crash(2, result.a); 109 | } 110 | 111 | 112 | function _Browser_dispatchCommands(commands) 113 | { 114 | var managers = {}; 115 | _Platform_setupEffects(managers, function() {}); 116 | _Platform_dispatchEffects(managers, commands, __Sub_none); 117 | } 118 | 119 | 120 | 121 | // FULLSCREEN ENV 122 | 123 | 124 | function _Browser_addEnv(url, flagDecoder) 125 | { 126 | return A2(__Json_map, function(flags) { 127 | return { 128 | __$flags: flags, 129 | __$url: url 130 | }; 131 | }, flagDecoder); 132 | } 133 | -------------------------------------------------------------------------------- /src/Elm/Kernel/Debugger.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | import Debugger.Expando as Expando exposing (S, Primitive, Sequence, Dictionary, Record, Constructor, ListSeq, SetSeq, ArraySeq) 4 | import Debugger.Main as Main exposing (getUserModel, wrapInit, wrapUpdate, wrapSubs, cornerView, popoutView, NoOp, UserMsg, Up, Down, toBlockerType, initialWindowWidth, initialWindowHeight) 5 | import Debugger.Overlay as Overlay exposing (BlockNone, BlockMost) 6 | import Elm.Kernel.Browser exposing (makeAnimator) 7 | import Elm.Kernel.Debug exposing (crash) 8 | import Elm.Kernel.Json exposing (wrap) 9 | import Elm.Kernel.List exposing (Cons, Nil) 10 | import Elm.Kernel.Platform exposing (initialize) 11 | import Elm.Kernel.Scheduler exposing (binding, succeed) 12 | import Elm.Kernel.Utils exposing (Tuple0, Tuple2, ap) 13 | import Elm.Kernel.VirtualDom exposing (node, applyPatches, diff, doc, makeStepper, map, render, virtualize, divertHrefToApp) 14 | import Json.Decode as Json exposing (map) 15 | import List exposing (map, reverse) 16 | import Maybe exposing (Just, Nothing) 17 | import Set exposing (foldr) 18 | import Dict exposing (foldr, empty, insert) 19 | import Array exposing (foldr) 20 | 21 | */ 22 | 23 | 24 | 25 | // HELPERS 26 | 27 | 28 | function _Debugger_unsafeCoerce(value) 29 | { 30 | return value; 31 | } 32 | 33 | 34 | 35 | // PROGRAMS 36 | 37 | 38 | var _Debugger_element = F4(function(impl, flagDecoder, debugMetadata, args) 39 | { 40 | return __Platform_initialize( 41 | flagDecoder, 42 | args, 43 | A3(__Main_wrapInit, __Json_wrap(debugMetadata), _Debugger_popout(), impl.__$init), 44 | __Main_wrapUpdate(impl.__$update), 45 | __Main_wrapSubs(impl.__$subscriptions), 46 | function(sendToApp, initialModel) 47 | { 48 | var view = impl.__$view; 49 | var title = __VirtualDom_doc.title; 50 | var domNode = args && args['node'] ? args['node'] : __Debug_crash(0); 51 | var currNode = __VirtualDom_virtualize(domNode); 52 | var currBlocker = __Main_toBlockerType(initialModel); 53 | var currPopout; 54 | 55 | var cornerNode = __VirtualDom_doc.createElement('div'); 56 | domNode.parentNode.insertBefore(cornerNode, domNode.nextSibling); 57 | var cornerCurr = __VirtualDom_virtualize(cornerNode); 58 | 59 | initialModel.__$popout.__sendToApp = sendToApp; 60 | 61 | return _Browser_makeAnimator(initialModel, function(model) 62 | { 63 | var nextNode = A2(__VirtualDom_map, __Main_UserMsg, view(__Main_getUserModel(model))); 64 | var patches = __VirtualDom_diff(currNode, nextNode); 65 | domNode = __VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); 66 | currNode = nextNode; 67 | 68 | // update blocker 69 | 70 | var nextBlocker = __Main_toBlockerType(model); 71 | _Debugger_updateBlocker(currBlocker, nextBlocker); 72 | currBlocker = nextBlocker; 73 | 74 | // view corner 75 | 76 | var cornerNext = __Main_cornerView(model); 77 | var cornerPatches = __VirtualDom_diff(cornerCurr, cornerNext); 78 | cornerNode = __VirtualDom_applyPatches(cornerNode, cornerCurr, cornerPatches, sendToApp); 79 | cornerCurr = cornerNext; 80 | 81 | if (!model.__$popout.__doc) 82 | { 83 | currPopout = undefined; 84 | return; 85 | } 86 | 87 | // view popout 88 | 89 | __VirtualDom_doc = model.__$popout.__doc; // SWITCH TO POPOUT DOC 90 | currPopout || (currPopout = __VirtualDom_virtualize(model.__$popout.__doc)); 91 | var nextPopout = __Main_popoutView(model); 92 | var popoutPatches = __VirtualDom_diff(currPopout, nextPopout); 93 | __VirtualDom_applyPatches(model.__$popout.__doc.body, currPopout, popoutPatches, sendToApp); 94 | currPopout = nextPopout; 95 | __VirtualDom_doc = document; // SWITCH BACK TO NORMAL DOC 96 | }); 97 | } 98 | ); 99 | }); 100 | 101 | 102 | var _Debugger_document = F4(function(impl, flagDecoder, debugMetadata, args) 103 | { 104 | return __Platform_initialize( 105 | flagDecoder, 106 | args, 107 | A3(__Main_wrapInit, __Json_wrap(debugMetadata), _Debugger_popout(), impl.__$init), 108 | __Main_wrapUpdate(impl.__$update), 109 | __Main_wrapSubs(impl.__$subscriptions), 110 | function(sendToApp, initialModel) 111 | { 112 | var divertHrefToApp = impl.__$setup && impl.__$setup(function(x) { return sendToApp(__Main_UserMsg(x)); }); 113 | var view = impl.__$view; 114 | var title = __VirtualDom_doc.title; 115 | var bodyNode = __VirtualDom_doc.body; 116 | var currNode = __VirtualDom_virtualize(bodyNode); 117 | var currBlocker = __Main_toBlockerType(initialModel); 118 | var currPopout; 119 | 120 | initialModel.__$popout.__sendToApp = sendToApp; 121 | 122 | return _Browser_makeAnimator(initialModel, function(model) 123 | { 124 | __VirtualDom_divertHrefToApp = divertHrefToApp; 125 | var doc = view(__Main_getUserModel(model)); 126 | var nextNode = __VirtualDom_node('body')(__List_Nil)( 127 | __Utils_ap( 128 | A2(__List_map, __VirtualDom_map(__Main_UserMsg), doc.__$body), 129 | __List_Cons(__Main_cornerView(model), __List_Nil) 130 | ) 131 | ); 132 | var patches = __VirtualDom_diff(currNode, nextNode); 133 | bodyNode = __VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); 134 | currNode = nextNode; 135 | __VirtualDom_divertHrefToApp = 0; 136 | (title !== doc.__$title) && (__VirtualDom_doc.title = title = doc.__$title); 137 | 138 | // update blocker 139 | 140 | var nextBlocker = __Main_toBlockerType(model); 141 | _Debugger_updateBlocker(currBlocker, nextBlocker); 142 | currBlocker = nextBlocker; 143 | 144 | // view popout 145 | 146 | if (!model.__$popout.__doc) { currPopout = undefined; return; } 147 | 148 | __VirtualDom_doc = model.__$popout.__doc; // SWITCH TO POPOUT DOC 149 | currPopout || (currPopout = __VirtualDom_virtualize(model.__$popout.__doc)); 150 | var nextPopout = __Main_popoutView(model); 151 | var popoutPatches = __VirtualDom_diff(currPopout, nextPopout); 152 | __VirtualDom_applyPatches(model.__$popout.__doc.body, currPopout, popoutPatches, sendToApp); 153 | currPopout = nextPopout; 154 | __VirtualDom_doc = document; // SWITCH BACK TO NORMAL DOC 155 | }); 156 | } 157 | ); 158 | }); 159 | 160 | 161 | function _Debugger_popout() 162 | { 163 | return { 164 | __doc: undefined, 165 | __sendToApp: undefined 166 | }; 167 | } 168 | 169 | function _Debugger_isOpen(popout) 170 | { 171 | return !!popout.__doc; 172 | } 173 | 174 | function _Debugger_open(popout) 175 | { 176 | return __Scheduler_binding(function(callback) 177 | { 178 | _Debugger_openWindow(popout); 179 | callback(__Scheduler_succeed(__Utils_Tuple0)); 180 | }); 181 | } 182 | 183 | function _Debugger_openWindow(popout) 184 | { 185 | var w = __Main_initialWindowWidth, 186 | h = __Main_initialWindowHeight, 187 | x = screen.width - w, 188 | y = screen.height - h; 189 | 190 | var debuggerWindow = window.open('', '', 'width=' + w + ',height=' + h + ',left=' + x + ',top=' + y); 191 | var doc = debuggerWindow.document; 192 | doc.title = 'Elm Debugger'; 193 | 194 | // handle arrow keys 195 | doc.addEventListener('keydown', function(event) { 196 | event.metaKey && event.which === 82 && window.location.reload(); 197 | event.key === 'ArrowUp' && (popout.__sendToApp(__Main_Up ), event.preventDefault()); 198 | event.key === 'ArrowDown' && (popout.__sendToApp(__Main_Down), event.preventDefault()); 199 | }); 200 | 201 | // handle window close 202 | window.addEventListener('unload', close); 203 | debuggerWindow.addEventListener('unload', function() { 204 | popout.__doc = undefined; 205 | popout.__sendToApp(__Main_NoOp); 206 | window.removeEventListener('unload', close); 207 | }); 208 | 209 | function close() { 210 | popout.__doc = undefined; 211 | popout.__sendToApp(__Main_NoOp); 212 | debuggerWindow.close(); 213 | } 214 | 215 | // register new window 216 | popout.__doc = doc; 217 | } 218 | 219 | 220 | 221 | // SCROLL 222 | 223 | 224 | function _Debugger_scroll(popout) 225 | { 226 | return __Scheduler_binding(function(callback) 227 | { 228 | if (popout.__doc) 229 | { 230 | var msgs = popout.__doc.getElementById('elm-debugger-sidebar'); 231 | if (msgs && msgs.scrollTop !== 0) 232 | { 233 | msgs.scrollTop = 0; 234 | } 235 | } 236 | callback(__Scheduler_succeed(__Utils_Tuple0)); 237 | }); 238 | } 239 | 240 | 241 | var _Debugger_scrollTo = F2(function(id, popout) 242 | { 243 | return __Scheduler_binding(function(callback) 244 | { 245 | if (popout.__doc) 246 | { 247 | var msg = popout.__doc.getElementById(id); 248 | if (msg) 249 | { 250 | msg.scrollIntoView(false); 251 | } 252 | } 253 | callback(__Scheduler_succeed(__Utils_Tuple0)); 254 | }); 255 | }); 256 | 257 | 258 | 259 | // UPLOAD 260 | 261 | 262 | function _Debugger_upload(popout) 263 | { 264 | return __Scheduler_binding(function(callback) 265 | { 266 | var doc = popout.__doc || document; 267 | var element = doc.createElement('input'); 268 | element.setAttribute('type', 'file'); 269 | element.setAttribute('accept', 'text/json'); 270 | element.style.display = 'none'; 271 | element.addEventListener('change', function(event) 272 | { 273 | var fileReader = new FileReader(); 274 | fileReader.onload = function(e) 275 | { 276 | callback(__Scheduler_succeed(e.target.result)); 277 | }; 278 | fileReader.readAsText(event.target.files[0]); 279 | doc.body.removeChild(element); 280 | }); 281 | doc.body.appendChild(element); 282 | element.click(); 283 | }); 284 | } 285 | 286 | 287 | 288 | // DOWNLOAD 289 | 290 | 291 | var _Debugger_download = F2(function(historyLength, json) 292 | { 293 | return __Scheduler_binding(function(callback) 294 | { 295 | var fileName = 'history-' + historyLength + '.txt'; 296 | var jsonString = JSON.stringify(json); 297 | var mime = 'text/plain;charset=utf-8'; 298 | var done = __Scheduler_succeed(__Utils_Tuple0); 299 | 300 | // for IE10+ 301 | if (navigator.msSaveBlob) 302 | { 303 | navigator.msSaveBlob(new Blob([jsonString], {type: mime}), fileName); 304 | return callback(done); 305 | } 306 | 307 | // for HTML5 308 | var element = document.createElement('a'); 309 | element.setAttribute('href', 'data:' + mime + ',' + encodeURIComponent(jsonString)); 310 | element.setAttribute('download', fileName); 311 | element.style.display = 'none'; 312 | document.body.appendChild(element); 313 | element.click(); 314 | document.body.removeChild(element); 315 | callback(done); 316 | }); 317 | }); 318 | 319 | 320 | 321 | // POPOUT CONTENT 322 | 323 | 324 | function _Debugger_messageToString(value) 325 | { 326 | if (typeof value === 'boolean') 327 | { 328 | return value ? 'True' : 'False'; 329 | } 330 | 331 | if (typeof value === 'number') 332 | { 333 | return value + ''; 334 | } 335 | 336 | if (typeof value === 'string') 337 | { 338 | return '"' + _Debugger_addSlashes(value, false) + '"'; 339 | } 340 | 341 | if (value instanceof String) 342 | { 343 | return "'" + _Debugger_addSlashes(value, true) + "'"; 344 | } 345 | 346 | if (typeof value !== 'object' || value === null || !('$' in value)) 347 | { 348 | return '…'; 349 | } 350 | 351 | if (typeof value.$ === 'number') 352 | { 353 | return '…'; 354 | } 355 | 356 | var code = value.$.charCodeAt(0); 357 | if (code === 0x23 /* # */ || /* a */ 0x61 <= code && code <= 0x7A /* z */) 358 | { 359 | return '…'; 360 | } 361 | 362 | if (['Array_elm_builtin', 'Set_elm_builtin', 'RBNode_elm_builtin', 'RBEmpty_elm_builtin'].indexOf(value.$) >= 0) 363 | { 364 | return '…'; 365 | } 366 | 367 | var keys = Object.keys(value); 368 | switch (keys.length) 369 | { 370 | case 1: 371 | return value.$; 372 | case 2: 373 | return value.$ + ' ' + _Debugger_messageToString(value.a); 374 | default: 375 | return value.$ + ' … ' + _Debugger_messageToString(value[keys[keys.length - 1]]); 376 | } 377 | } 378 | 379 | 380 | function _Debugger_init(value) 381 | { 382 | if (typeof value === 'boolean') 383 | { 384 | return A3(__Expando_Constructor, __Maybe_Just(value ? 'True' : 'False'), true, __List_Nil); 385 | } 386 | 387 | if (typeof value === 'number') 388 | { 389 | return __Expando_Primitive(value + ''); 390 | } 391 | 392 | if (typeof value === 'string') 393 | { 394 | return __Expando_S('"' + _Debugger_addSlashes(value, false) + '"'); 395 | } 396 | 397 | if (value instanceof String) 398 | { 399 | return __Expando_S("'" + _Debugger_addSlashes(value, true) + "'"); 400 | } 401 | 402 | if (typeof value === 'object' && '$' in value) 403 | { 404 | var tag = value.$; 405 | 406 | if (tag === '::' || tag === '[]') 407 | { 408 | return A3(__Expando_Sequence, __Expando_ListSeq, true, 409 | A2(__List_map, _Debugger_init, value) 410 | ); 411 | } 412 | 413 | if (tag === 'Set_elm_builtin') 414 | { 415 | return A3(__Expando_Sequence, __Expando_SetSeq, true, 416 | A3(__Set_foldr, _Debugger_initCons, __List_Nil, value) 417 | ); 418 | } 419 | 420 | if (tag === 'RBNode_elm_builtin' || tag == 'RBEmpty_elm_builtin') 421 | { 422 | return A2(__Expando_Dictionary, true, 423 | A3(__Dict_foldr, _Debugger_initKeyValueCons, __List_Nil, value) 424 | ); 425 | } 426 | 427 | if (tag === 'Array_elm_builtin') 428 | { 429 | return A3(__Expando_Sequence, __Expando_ArraySeq, true, 430 | A3(__Array_foldr, _Debugger_initCons, __List_Nil, value) 431 | ); 432 | } 433 | 434 | if (typeof tag === 'number') 435 | { 436 | return __Expando_Primitive('<internals>'); 437 | } 438 | 439 | var char = tag.charCodeAt(0); 440 | if (char === 35 || 65 <= char && char <= 90) 441 | { 442 | var list = __List_Nil; 443 | for (var i in value) 444 | { 445 | if (i === '$') continue; 446 | list = __List_Cons(_Debugger_init(value[i]), list); 447 | } 448 | return A3(__Expando_Constructor, char === 35 ? __Maybe_Nothing : __Maybe_Just(tag), true, __List_reverse(list)); 449 | } 450 | 451 | return __Expando_Primitive('<internals>'); 452 | } 453 | 454 | if (typeof value === 'object') 455 | { 456 | var dict = __Dict_empty; 457 | for (var i in value) 458 | { 459 | dict = A3(__Dict_insert, i, _Debugger_init(value[i]), dict); 460 | } 461 | return A2(__Expando_Record, true, dict); 462 | } 463 | 464 | return __Expando_Primitive('<internals>'); 465 | } 466 | 467 | var _Debugger_initCons = F2(function initConsHelp(value, list) 468 | { 469 | return __List_Cons(_Debugger_init(value), list); 470 | }); 471 | 472 | var _Debugger_initKeyValueCons = F3(function(key, value, list) 473 | { 474 | return __List_Cons( 475 | __Utils_Tuple2(_Debugger_init(key), _Debugger_init(value)), 476 | list 477 | ); 478 | }); 479 | 480 | function _Debugger_addSlashes(str, isChar) 481 | { 482 | var s = str 483 | .replace(/\\/g, '\\\\') 484 | .replace(/\n/g, '\\n') 485 | .replace(/\t/g, '\\t') 486 | .replace(/\r/g, '\\r') 487 | .replace(/\v/g, '\\v') 488 | .replace(/\0/g, '\\0'); 489 | if (isChar) 490 | { 491 | return s.replace(/\'/g, '\\\''); 492 | } 493 | else 494 | { 495 | return s.replace(/\"/g, '\\"'); 496 | } 497 | } 498 | 499 | 500 | 501 | // BLOCK EVENTS 502 | 503 | 504 | function _Debugger_updateBlocker(oldBlocker, newBlocker) 505 | { 506 | if (oldBlocker === newBlocker) return; 507 | 508 | var oldEvents = _Debugger_blockerToEvents(oldBlocker); 509 | var newEvents = _Debugger_blockerToEvents(newBlocker); 510 | 511 | // remove old blockers 512 | for (var i = 0; i < oldEvents.length; i++) 513 | { 514 | document.removeEventListener(oldEvents[i], _Debugger_blocker, true); 515 | } 516 | 517 | // add new blockers 518 | for (var i = 0; i < newEvents.length; i++) 519 | { 520 | document.addEventListener(newEvents[i], _Debugger_blocker, true); 521 | } 522 | } 523 | 524 | 525 | function _Debugger_blocker(event) 526 | { 527 | if (event.type === 'keydown' && event.metaKey && event.which === 82) 528 | { 529 | return; 530 | } 531 | 532 | var isScroll = event.type === 'scroll' || event.type === 'wheel'; 533 | for (var node = event.target; node; node = node.parentNode) 534 | { 535 | if (isScroll ? node.id === 'elm-debugger-details' : node.id === 'elm-debugger-overlay') 536 | { 537 | return; 538 | } 539 | } 540 | 541 | event.stopPropagation(); 542 | event.preventDefault(); 543 | } 544 | 545 | function _Debugger_blockerToEvents(blocker) 546 | { 547 | return blocker === __Overlay_BlockNone 548 | ? [] 549 | : blocker === __Overlay_BlockMost 550 | ? _Debugger_mostEvents 551 | : _Debugger_allEvents; 552 | } 553 | 554 | var _Debugger_mostEvents = [ 555 | 'click', 'dblclick', 'mousemove', 556 | 'mouseup', 'mousedown', 'mouseenter', 'mouseleave', 557 | 'touchstart', 'touchend', 'touchcancel', 'touchmove', 558 | 'pointerdown', 'pointerup', 'pointerover', 'pointerout', 559 | 'pointerenter', 'pointerleave', 'pointermove', 'pointercancel', 560 | 'dragstart', 'drag', 'dragend', 'dragenter', 'dragover', 'dragleave', 'drop', 561 | 'keyup', 'keydown', 'keypress', 562 | 'input', 'change', 563 | 'focus', 'blur' 564 | ]; 565 | 566 | var _Debugger_allEvents = _Debugger_mostEvents.concat('wheel', 'scroll'); 567 | --------------------------------------------------------------------------------