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