elm-rails 0.1.2 → 0.2.0

data/test/rails5.0/elm-stuff/packages/elm-lang/virtual-dom/2.0.3/src/VirtualDom/Debug.elm

@@ -0,0 +1,567 @@
+module VirtualDom.Debug exposing (wrap, wrapWithFlags)
+
+import Json.Decode as Decode
+import Json.Encode as Encode
+import Task exposing (Task)
+import Native.Debug
+import Native.VirtualDom
+import VirtualDom.Expando as Expando exposing (Expando)
+import VirtualDom.Helpers as VDom exposing (Node)
+import VirtualDom.History as History exposing (History)
+import VirtualDom.Metadata as Metadata exposing (Metadata)
+import VirtualDom.Overlay as Overlay
+import VirtualDom.Report as Report
+
+
+
+-- WRAP PROGRAMS
+
+
+wrap metadata { init, update, subscriptions, view } =
+  { init = wrapInit metadata init
+  , view = wrapView view
+  , update = wrapUpdate update
+  , viewIn = viewIn
+  , viewOut = viewOut
+  , subscriptions = wrapSubs subscriptions
+  }
+
+
+wrapWithFlags metadata { init, update, subscriptions, view } =
+  { init = \flags -> wrapInit metadata (init flags)
+  , view = wrapView view
+  , update = wrapUpdate update
+  , viewIn = viewIn
+  , viewOut = viewOut
+  , subscriptions = wrapSubs subscriptions
+  }
+
+
+
+-- MODEL
+
+
+type alias Model model msg =
+  { history : History model msg
+  , state : State model
+  , expando : Expando
+  , metadata : Result Metadata.Error Metadata
+  , overlay : Overlay.State
+  , isDebuggerOpen : Bool
+  }
+
+
+type State model
+  = Running model
+  | Paused Int model model
+
+
+wrapInit : Encode.Value -> ( model, Cmd msg ) -> ( Model model msg, Cmd (Msg msg) )
+wrapInit metadata ( userModel, userCommands ) =
+  { history = History.empty userModel
+  , state = Running userModel
+  , expando = Expando.init userModel
+  , metadata = Metadata.decode metadata
+  , overlay = Overlay.none
+  , isDebuggerOpen = False
+  }
+    ! [ Cmd.map UserMsg userCommands ]
+
+
+
+-- UPDATE
+
+
+type Msg msg
+  = NoOp
+  | UserMsg msg
+  | ExpandoMsg Expando.Msg
+  | Resume
+  | Jump Int
+  | Open
+  | Close
+  | Up
+  | Down
+  | Import
+  | Export
+  | Upload String
+  | OverlayMsg Overlay.Msg
+
+
+type alias UserUpdate model msg =
+  msg -> model -> ( model, Cmd msg )
+
+
+wrapUpdate
+  : UserUpdate model msg
+  -> Task Never ()
+  -> Msg msg
+  -> Model model msg
+  -> (Model model msg, Cmd (Msg msg))
+wrapUpdate userUpdate scrollTask msg model =
+  case msg of
+    NoOp ->
+      model ! []
+
+    UserMsg userMsg ->
+      updateUserMsg userUpdate scrollTask userMsg model
+
+    ExpandoMsg eMsg ->
+      { model
+          | expando = Expando.update eMsg model.expando
+      }
+        ! []
+
+    Resume ->
+      case model.state of
+        Running _ ->
+          model ! []
+
+        Paused _ _ userModel ->
+          { model
+              | state = Running userModel
+              , expando = Expando.merge userModel model.expando
+          }
+            ! [ runIf model.isDebuggerOpen scrollTask ]
+
+    Jump index ->
+      let
+        (indexModel, indexMsg) =
+          History.get userUpdate index model.history
+      in
+        { model
+            | state = Paused index indexModel (getLatestModel model.state)
+            , expando = Expando.merge indexModel model.expando
+        }
+          ! []
+
+    Open ->
+      { model | isDebuggerOpen = True } ! []
+
+    Close ->
+      { model | isDebuggerOpen = False } ! []
+
+    Up ->
+      let
+        index =
+          case model.state of
+            Paused index _ _ ->
+              index
+
+            Running _ ->
+              History.size model.history
+      in
+        if index > 0 then
+          wrapUpdate userUpdate scrollTask (Jump (index - 1)) model
+        else
+          model ! []
+
+    Down ->
+      case model.state of
+        Running _ ->
+          model ! []
+
+        Paused index _ userModel ->
+          if index == History.size model.history - 1 then
+            wrapUpdate userUpdate scrollTask Resume model
+          else
+            wrapUpdate userUpdate scrollTask (Jump (index + 1)) model
+
+    Import ->
+      withGoodMetadata model <| \_ ->
+        model ! [ upload ]
+
+    Export ->
+      withGoodMetadata model <| \metadata ->
+        model ! [ download metadata model.history ]
+
+    Upload jsonString ->
+      withGoodMetadata model <| \metadata ->
+        case Overlay.assessImport metadata jsonString of
+          Err newOverlay ->
+            { model | overlay = newOverlay } ! []
+
+          Ok rawHistory ->
+            loadNewHistory rawHistory userUpdate model
+
+    OverlayMsg overlayMsg ->
+      case Overlay.close overlayMsg model.overlay of
+        Nothing ->
+          { model | overlay = Overlay.none } ! []
+
+        Just rawHistory ->
+          loadNewHistory rawHistory userUpdate model
+
+
+
+-- COMMANDS
+
+
+upload : Cmd (Msg msg)
+upload =
+  Task.perform Upload Native.Debug.upload
+
+
+download : Metadata -> History model msg -> Cmd (Msg msg)
+download metadata history =
+  let
+    historyLength =
+      History.size history
+
+    json =
+      Encode.object
+        [ ("metadata", Metadata.encode metadata)
+        , ("history", History.encode history)
+        ]
+  in
+    Task.perform (\_ -> NoOp) (Native.Debug.download historyLength json)
+
+
+
+-- UPDATE OVERLAY
+
+
+withGoodMetadata
+  : Model model msg
+  -> (Metadata -> (Model model msg, Cmd (Msg msg)))
+  -> (Model model msg, Cmd (Msg msg))
+withGoodMetadata model func =
+  case model.metadata of
+    Ok metadata ->
+      func metadata
+
+    Err error ->
+      { model | overlay = Overlay.badMetadata error } ! []
+
+
+loadNewHistory
+  : Encode.Value
+  -> UserUpdate model msg
+  -> Model model msg
+  -> ( Model model msg, Cmd (Msg msg) )
+loadNewHistory rawHistory userUpdate model =
+  let
+    initialUserModel =
+      History.initialModel model.history
+
+    pureUserUpdate msg userModel =
+      Tuple.first (userUpdate msg userModel)
+
+    decoder =
+      History.decoder initialUserModel pureUserUpdate
+  in
+    case Decode.decodeValue decoder rawHistory of
+      Err _ ->
+        { model | overlay = Overlay.corruptImport } ! []
+
+      Ok (latestUserModel, newHistory) ->
+        { model
+            | history = newHistory
+            , state = Running latestUserModel
+            , expando = Expando.init latestUserModel
+            , overlay = Overlay.none
+        }
+          ! []
+
+
+
+-- UPDATE - USER MESSAGES
+
+
+updateUserMsg
+  : UserUpdate model msg
+  -> Task Never ()
+  -> msg
+  -> Model model msg
+  -> (Model model msg, Cmd (Msg msg))
+updateUserMsg userUpdate scrollTask userMsg ({ history, state, expando } as model) =
+  let
+    userModel =
+      getLatestModel state
+
+    newHistory =
+      History.add userMsg userModel history
+
+    (newUserModel, userCmds) =
+      userUpdate userMsg userModel
+
+    commands =
+      Cmd.map UserMsg userCmds
+  in
+    case state of
+      Running _ ->
+        { model
+            | history = newHistory
+            , state = Running newUserModel
+            , expando = Expando.merge newUserModel expando
+        }
+          ! [ commands, runIf model.isDebuggerOpen scrollTask ]
+
+      Paused index indexModel _ ->
+        { model
+            | history = newHistory
+            , state = Paused index indexModel newUserModel
+        }
+          ! [ commands ]
+
+
+runIf : Bool -> Task Never () -> Cmd (Msg msg)
+runIf bool task =
+  if bool then
+    Task.perform (always NoOp) task
+  else
+    Cmd.none
+
+
+getLatestModel : State model -> model
+getLatestModel state =
+  case state of
+    Running model ->
+      model
+
+    Paused _ _ model ->
+      model
+
+
+
+-- SUBSCRIPTIONS
+
+
+wrapSubs : (model -> Sub msg) -> Model model msg -> Sub (Msg msg)
+wrapSubs userSubscriptions {state} =
+  getLatestModel state
+    |> userSubscriptions
+    |> Sub.map UserMsg
+
+
+
+-- VIEW
+
+
+wrapView : (model -> Node msg) -> Model model msg -> Node (Msg msg)
+wrapView userView { state } =
+  let
+    currentModel =
+      case state of
+        Running model ->
+          model
+
+        Paused _ oldModel _ ->
+          oldModel
+  in
+    VDom.map UserMsg (userView currentModel)
+
+
+
+-- SMALL DEBUG VIEW
+
+
+viewIn : Model model msg -> ( Overlay.Block, Node (Msg msg) )
+viewIn { history, state, overlay, isDebuggerOpen } =
+  let
+    isPaused =
+      case state of
+        Running _ ->
+          False
+
+        Paused _ _ _ ->
+          True
+  in
+    Overlay.view overlayConfig isPaused isDebuggerOpen (History.size history) overlay
+
+
+overlayConfig : Overlay.Config (Msg msg)
+overlayConfig =
+  { resume = Resume
+  , open = Open
+  , importHistory = Import
+  , exportHistory = Export
+  , wrap = OverlayMsg
+  }
+
+
+
+-- BIG DEBUG VIEW
+
+
+viewOut : Model model msg -> Node (Msg msg)
+viewOut { history, state, expando } =
+  VDom.div
+    [ VDom.id "debugger" ]
+    [ styles
+    , viewSidebar state history
+    , VDom.map ExpandoMsg <|
+        VDom.div [ VDom.id "values" ] [ Expando.view Nothing expando ]
+    ]
+
+
+viewSidebar : State model -> History model msg -> Node (Msg msg)
+viewSidebar state history =
+  let
+    maybeIndex =
+      case state of
+        Running _ ->
+          Nothing
+
+        Paused index _ _ ->
+          Just index
+  in
+    VDom.div [ VDom.class "debugger-sidebar" ]
+      [ VDom.map Jump (History.view maybeIndex history)
+      , playButton maybeIndex
+      ]
+
+
+playButton : Maybe Int -> Node (Msg msg)
+playButton maybeIndex =
+  VDom.div [ VDom.class "debugger-sidebar-controls" ]
+    [ viewResumeButton maybeIndex
+    , VDom.div [ VDom.class "debugger-sidebar-controls-import-export" ]
+        [ button Import "Import"
+        , VDom.text " / "
+        , button Export "Export"
+        ]
+    ]
+
+
+button msg label =
+  VDom.span
+    [ VDom.onClick msg
+    , VDom.style [("cursor","pointer")]
+    ]
+    [ VDom.text label ]
+
+
+viewResumeButton maybeIndex =
+  case maybeIndex of
+    Nothing ->
+      VDom.text ""
+
+    Just _ ->
+      resumeButton
+
+
+resumeButton =
+  VDom.div
+    [ VDom.onClick Resume
+    , VDom.class "debugger-sidebar-controls-resume"
+    ]
+    [ VDom.text "Resume"
+    ]
+
+
+
+-- STYLE
+
+
+styles : Node msg
+styles =
+  VDom.node "style" [] [ VDom.text """
+
+html {
+    overflow: hidden;
+    height: 100%;
+}
+
+body {
+    height: 100%;
+    overflow: auto;
+}
+
+#debugger {
+  width: 100%
+  height: 100%;
+  font-family: monospace;
+}
+
+#values {
+  display: block;
+  float: left;
+  height: 100%;
+  width: calc(100% - 30ch);
+  margin: 0;
+  overflow: auto;
+  cursor: default;
+}
+
+.debugger-sidebar {
+  display: block;
+  float: left;
+  width: 30ch;
+  height: 100%;
+  color: white;
+  background-color: rgb(61, 61, 61);
+}
+
+.debugger-sidebar-controls {
+  width: 100%;
+  text-align: center;
+  background-color: rgb(50, 50, 50);
+}
+
+.debugger-sidebar-controls-import-export {
+  width: 100%;
+  height: 24px;
+  line-height: 24px;
+  font-size: 12px;
+}
+
+.debugger-sidebar-controls-resume {
+  width: 100%;
+  height: 30px;
+  line-height: 30px;
+  cursor: pointer;
+}
+
+.debugger-sidebar-controls-resume:hover {
+  background-color: rgb(41, 41, 41);
+}
+
+.debugger-sidebar-messages {
+  width: 100%;
+  overflow-y: auto;
+  height: calc(100% - 24px);
+}
+
+.debugger-sidebar-messages-paused {
+  width: 100%;
+  overflow-y: auto;
+  height: calc(100% - 54px);
+}
+
+.messages-entry {
+  cursor: pointer;
+  width: 100%;
+}
+
+.messages-entry:hover {
+  background-color: rgb(41, 41, 41);
+}
+
+.messages-entry-selected, .messages-entry-selected:hover {
+  background-color: rgb(10, 10, 10);
+}
+
+.messages-entry-content {
+  width: calc(100% - 7ch);
+  padding-top: 4px;
+  padding-bottom: 4px;
+  padding-left: 1ch;
+  text-overflow: ellipsis;
+  white-space: nowrap;
+  overflow: hidden;
+  display: inline-block;
+}
+
+.messages-entry-index {
+  color: #666;
+  width: 5ch;
+  padding-top: 4px;
+  padding-bottom: 4px;
+  padding-right: 1ch;
+  text-align: right;
+  display: block;
+  float: right;
+}
+
+""" ]