1module Debugger.Main exposing 2 ( wrapInit 3 , wrapUpdate 4 , wrapSubs 5 , getUserModel 6 , cornerView 7 , popoutView 8 ) 9 10 11import Elm.Kernel.Debugger 12import Json.Decode as Decode 13import Json.Encode as Encode 14import Html exposing (..) 15import Html.Attributes exposing (..) 16import Html.Events exposing (onClick) 17import Task exposing (Task) 18import Debugger.Expando as Expando exposing (Expando) 19import Debugger.History as History exposing (History) 20import Debugger.Metadata as Metadata exposing (Metadata) 21import Debugger.Overlay as Overlay 22import Debugger.Report as Report 23 24 25 26-- VIEW 27 28 29getUserModel : Model model msg -> model 30getUserModel model = 31 getCurrentModel model.state 32 33 34 35-- SUBSCRIPTIONS 36 37 38wrapSubs : (model -> Sub msg) -> Model model msg -> Sub (Msg msg) 39wrapSubs subscriptions model = 40 Sub.map UserMsg (subscriptions (getLatestModel model.state)) 41 42 43 44-- MODEL 45 46 47type alias Model model msg = 48 { history : History model msg 49 , state : State model 50 , expando : Expando 51 , metadata : Result Metadata.Error Metadata 52 , overlay : Overlay.State 53 , popout : Popout 54 } 55 56 57type Popout = Popout Popout 58 59 60 61-- STATE 62 63 64type State model 65 = Running model 66 | Paused Int model model 67 68 69getLatestModel : State model -> model 70getLatestModel state = 71 case state of 72 Running model -> 73 model 74 75 Paused _ _ model -> 76 model 77 78 79getCurrentModel : State model -> model 80getCurrentModel state = 81 case state of 82 Running model -> 83 model 84 85 Paused _ model _ -> 86 model 87 88 89isPaused : State model -> Bool 90isPaused state = 91 case state of 92 Running _ -> 93 False 94 95 Paused _ _ _ -> 96 True 97 98 99 100-- INIT 101 102 103wrapInit : Encode.Value -> Popout -> (flags -> (model, Cmd msg)) -> flags -> (Model model msg, Cmd (Msg msg)) 104wrapInit metadata popout init flags = 105 let 106 (userModel, userCommands) = 107 init flags 108 in 109 ( { history = History.empty userModel 110 , state = Running userModel 111 , expando = Expando.init userModel 112 , metadata = Metadata.decode metadata 113 , overlay = Overlay.none 114 , popout = popout 115 } 116 , Cmd.map UserMsg userCommands 117 ) 118 119 120 121-- UPDATE 122 123 124type Msg msg 125 = NoOp 126 | UserMsg msg 127 | ExpandoMsg Expando.Msg 128 | Resume 129 | Jump Int 130 | Open 131 | Up 132 | Down 133 | Import 134 | Export 135 | Upload String 136 | OverlayMsg Overlay.Msg 137 138 139type alias UserUpdate model msg = 140 msg -> model -> ( model, Cmd msg ) 141 142 143wrapUpdate : UserUpdate model msg -> Msg msg -> Model model msg -> (Model model msg, Cmd (Msg msg)) 144wrapUpdate update msg model = 145 case msg of 146 NoOp -> 147 ( model, Cmd.none ) 148 149 UserMsg userMsg -> 150 let 151 userModel = getLatestModel model.state 152 newHistory = History.add userMsg userModel model.history 153 (newUserModel, userCmds) = update userMsg userModel 154 commands = Cmd.map UserMsg userCmds 155 in 156 case model.state of 157 Running _ -> 158 ( { model 159 | history = newHistory 160 , state = Running newUserModel 161 , expando = Expando.merge newUserModel model.expando 162 } 163 , Cmd.batch [ commands, scroll model.popout ] 164 ) 165 166 Paused index indexModel _ -> 167 ( { model 168 | history = newHistory 169 , state = Paused index indexModel newUserModel 170 } 171 , commands 172 ) 173 174 ExpandoMsg eMsg -> 175 ( { model | expando = Expando.update eMsg model.expando } 176 , Cmd.none 177 ) 178 179 Resume -> 180 case model.state of 181 Running _ -> 182 ( model, Cmd.none ) 183 184 Paused _ _ userModel -> 185 ( { model 186 | state = Running userModel 187 , expando = Expando.merge userModel model.expando 188 } 189 , scroll model.popout 190 ) 191 192 Jump index -> 193 let 194 (indexModel, indexMsg) = 195 History.get update index model.history 196 in 197 ( { model 198 | state = Paused index indexModel (getLatestModel model.state) 199 , expando = Expando.merge indexModel model.expando 200 } 201 , Cmd.none 202 ) 203 204 Open -> 205 ( model 206 , Task.perform (\_ -> NoOp) (Elm.Kernel.Debugger.open model.popout) 207 ) 208 209 Up -> 210 let 211 index = 212 case model.state of 213 Paused i _ _ -> 214 i 215 216 Running _ -> 217 History.size model.history 218 in 219 if index > 0 then 220 wrapUpdate update (Jump (index - 1)) model 221 else 222 ( model, Cmd.none ) 223 224 Down -> 225 case model.state of 226 Running _ -> 227 ( model, Cmd.none ) 228 229 Paused index _ userModel -> 230 if index == History.size model.history - 1 then 231 wrapUpdate update Resume model 232 else 233 wrapUpdate update (Jump (index + 1)) model 234 235 Import -> 236 withGoodMetadata model <| \_ -> 237 ( model, upload ) 238 239 Export -> 240 withGoodMetadata model <| \metadata -> 241 ( model, download metadata model.history ) 242 243 Upload jsonString -> 244 withGoodMetadata model <| \metadata -> 245 case Overlay.assessImport metadata jsonString of 246 Err newOverlay -> 247 ( { model | overlay = newOverlay }, Cmd.none ) 248 249 Ok rawHistory -> 250 loadNewHistory rawHistory update model 251 252 OverlayMsg overlayMsg -> 253 case Overlay.close overlayMsg model.overlay of 254 Nothing -> 255 ( { model | overlay = Overlay.none }, Cmd.none ) 256 257 Just rawHistory -> 258 loadNewHistory rawHistory update model 259 260 261 262-- COMMANDS 263 264 265scroll : Popout -> Cmd (Msg msg) 266scroll popout = 267 Task.perform (always NoOp) (Elm.Kernel.Debugger.scroll popout) 268 269 270upload : Cmd (Msg msg) 271upload = 272 Task.perform Upload (Elm.Kernel.Debugger.upload ()) 273 274 275download : Metadata -> History model msg -> Cmd (Msg msg) 276download metadata history = 277 let 278 historyLength = 279 History.size history 280 281 json = 282 Encode.object 283 [ ("metadata", Metadata.encode metadata) 284 , ("history", History.encode history) 285 ] 286 in 287 Task.perform (\_ -> NoOp) (Elm.Kernel.Debugger.download historyLength json) 288 289 290 291-- UPDATE OVERLAY 292 293 294withGoodMetadata 295 : Model model msg 296 -> (Metadata -> (Model model msg, Cmd (Msg msg))) 297 -> (Model model msg, Cmd (Msg msg)) 298withGoodMetadata model func = 299 case model.metadata of 300 Ok metadata -> 301 func metadata 302 303 Err error -> 304 ( { model | overlay = Overlay.badMetadata error } 305 , Cmd.none 306 ) 307 308 309loadNewHistory 310 : Encode.Value 311 -> UserUpdate model msg 312 -> Model model msg 313 -> ( Model model msg, Cmd (Msg msg) ) 314loadNewHistory rawHistory update model = 315 let 316 initialUserModel = 317 History.getInitialModel model.history 318 319 pureUserUpdate msg userModel = 320 Tuple.first (update msg userModel) 321 322 decoder = 323 History.decoder initialUserModel pureUserUpdate 324 in 325 case Decode.decodeValue decoder rawHistory of 326 Err _ -> 327 ( { model | overlay = Overlay.corruptImport } 328 , Cmd.none 329 ) 330 331 Ok (latestUserModel, newHistory) -> 332 ( { model 333 | history = newHistory 334 , state = Running latestUserModel 335 , expando = Expando.init latestUserModel 336 , overlay = Overlay.none 337 } 338 , Cmd.none 339 ) 340 341 342 343-- CORNER VIEW 344 345 346cornerView : Model model msg -> Html (Msg msg) 347cornerView model = 348 Overlay.view 349 { resume = Resume 350 , open = Open 351 , importHistory = Import 352 , exportHistory = Export 353 , wrap = OverlayMsg 354 } 355 (isPaused model.state) 356 (Elm.Kernel.Debugger.isOpen model.popout) 357 (History.size model.history) 358 model.overlay 359 360 361toBlockerType : Model model msg -> Overlay.BlockerType 362toBlockerType model = 363 Overlay.toBlockerType (isPaused model.state) model.overlay 364 365 366 367-- BIG DEBUG VIEW 368 369 370popoutView : Model model msg -> Html (Msg msg) 371popoutView { history, state, expando } = 372 node "body" 373 [ style "margin" "0" 374 , style "padding" "0" 375 , style "width" "100%" 376 , style "height" "100%" 377 , style "font-family" "monospace" 378 , style "overflow" "auto" 379 ] 380 [ viewSidebar state history 381 , Html.map ExpandoMsg <| 382 div 383 [ style "display" "block" 384 , style "float" "left" 385 , style "height" "100%" 386 , style "width" "calc(100% - 30ch)" 387 , style "margin" "0" 388 , style "overflow" "auto" 389 , style "cursor" "default" 390 ] 391 [ Expando.view Nothing expando 392 ] 393 ] 394 395 396viewSidebar : State model -> History model msg -> Html (Msg msg) 397viewSidebar state history = 398 let 399 maybeIndex = 400 case state of 401 Running _ -> 402 Nothing 403 404 Paused index _ _ -> 405 Just index 406 in 407 div 408 [ style "display" "block" 409 , style "float" "left" 410 , style "width" "30ch" 411 , style "height" "100%" 412 , style "color" "white" 413 , style "background-color" "rgb(61, 61, 61)" 414 ] 415 [ Html.map Jump (History.view maybeIndex history) 416 , playButton maybeIndex 417 ] 418 419 420playButton : Maybe Int -> Html (Msg msg) 421playButton maybeIndex = 422 div 423 [ style "width" "100%" 424 , style "text-align" "center" 425 , style "background-color" "rgb(50, 50, 50)" 426 ] 427 [ viewResumeButton maybeIndex 428 , div 429 [ style "width" "100%" 430 , style "height" "24px" 431 , style "line-height" "24px" 432 , style "font-size" "12px" 433 ] 434 [ viewTextButton Import "Import" 435 , text " / " 436 , viewTextButton Export "Export" 437 ] 438 ] 439 440 441viewTextButton : msg -> String -> Html msg 442viewTextButton msg label = 443 span 444 [ onClick msg 445 , style "cursor" "pointer" 446 ] 447 [ text label ] 448 449 450viewResumeButton : Maybe Int -> Html (Msg msg) 451viewResumeButton maybeIndex = 452 case maybeIndex of 453 Nothing -> 454 text "" 455 456 Just _ -> 457 div 458 [ onClick Resume 459 , class "elm-debugger-resume" 460 ] 461 [ text "Resume" 462 , Html.node "style" [] [ text resumeStyle ] 463 ] 464 465 466resumeStyle : String 467resumeStyle = """ 468 469.elm-debugger-resume { 470 width: 100%; 471 height: 30px; 472 line-height: 30px; 473 cursor: pointer; 474} 475 476.elm-debugger-resume:hover { 477 background-color: rgb(41, 41, 41); 478} 479 480""" 481