diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..fac6576 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "elm-components"] + path = elm-components + url = git@github.com:evancz/elm-components.git diff --git a/elm-components b/elm-components new file mode 160000 index 0000000..7bf4137 --- /dev/null +++ b/elm-components @@ -0,0 +1 @@ +Subproject commit 7bf4137223574227ad849f89f99ec94cf50c99f7 diff --git a/elm-package.json b/elm-package.json index 5836c01..d6eaee2 100644 --- a/elm-package.json +++ b/elm-package.json @@ -11,7 +11,6 @@ "dependencies": { "elm-lang/core": "2.0.0 <= v < 3.0.0", "evancz/elm-html": "4.0.0 <= v < 5.0.0", - "vilterp/fancy-start-app": "1.0.0 <= v < 2.0.0", "imeckler/empty": "1.0.0 <= v < 2.0.0", "evancz/elm-markdown": "1.1.4 <= v < 2.0.0", "jystic/elm-font-awesome": "1.0.0 <= v < 2.0.0" diff --git a/frontend/Button.elm b/frontend/Button.elm index 8d22fd6..32a08e1 100644 --- a/frontend/Button.elm +++ b/frontend/Button.elm @@ -1,5 +1,7 @@ module Button where +import Components exposing (..) + import Signal import Html exposing (..) import Html.Attributes exposing (..) @@ -8,34 +10,37 @@ import Html.Lazy exposing (..) type Model - = Up - | Down - | Hover + = Up + | Down + | Hover -type Action - = MouseUpdate Model +type Message a + = MouseUpdate Model + | Click a -update : Action -> Model -> Model -update action state = - case action of +update : Message a -> Model -> Transaction (Message a) (Model, Maybe a) +update msg state = + case msg of MouseUpdate newState -> - newState + done (newState, Nothing) + + Click clickMsg -> + done (state, Just clickMsg) -view : Signal.Address Action - -> Signal.Address a +view : Signal.Address (Message a) -> a -> Model -> (Model -> Html) -> Html -view buttonStateAddr actionAddr action state render = +view addr clickMsg state render = div - [ onMouseOver buttonStateAddr (MouseUpdate Hover) - , onMouseDown buttonStateAddr (MouseUpdate Down) - , onMouseUp buttonStateAddr (MouseUpdate Hover) - , onMouseLeave buttonStateAddr (MouseUpdate Up) - , onClick actionAddr action + [ onMouseOver addr (MouseUpdate Hover) + , onMouseDown addr (MouseUpdate Down) + , onMouseUp addr (MouseUpdate Hover) + , onMouseLeave addr (MouseUpdate Up) + , onClick addr (Click clickMsg) ] [ lazy render state ] diff --git a/frontend/Debugger.elm b/frontend/Debugger.elm index ae3def8..3d2d454 100644 --- a/frontend/Debugger.elm +++ b/frontend/Debugger.elm @@ -10,7 +10,7 @@ import String import Color import Debug -import FancyStartApp +import Components exposing (..) import Empty exposing (..) import WebSocket @@ -18,44 +18,42 @@ import Model exposing (..) import Styles exposing (..) import Button import Debugger.RuntimeApi as API -import Debugger.Model as DM import Debugger.Service as Service import SideBar.Controls as Controls import SideBar.Logs as Logs import DataUtils exposing (..) -(html, uiTasks) = - FancyStartApp.start - { initialState = initModel - , initialTasks = (\loopback -> - [Signal.send (Service.commandsMailbox ()).address (DM.Initialize initMod)]) - , externalActions = - Signal.mergeMany - [ Signal.map NewServiceState Service.state - , socketEventsMailbox.signal - ] +output = + start + { init = + request (task connectSocket) initModel , view = view , update = update } main = - html + output.html + + +port tasks : Signal (Task Never ()) +port tasks = + output.tasks (=>) = (,) -view : Signal.Address Action -> Model -> Html +view : Signal.Address Message -> Model -> Html view addr state = let (mainVal, isPlaying) = case state.serviceState of - DM.Active activeAttrs -> + Just activeAttrs -> (activeAttrs.mainVal, DM.isPlaying activeAttrs) - _ -> + Nothing -> (div [] [], False) in @@ -136,7 +134,10 @@ viewSidebar addr state = body = case state.serviceState of DM.Active activeAttrs -> - [ Controls.view addr state activeAttrs + [ Controls.view + addr + state + activeAttrs , dividerBar , Logs.view (Signal.forwardTo addr LogsAction) @@ -160,6 +161,13 @@ viewSidebar addr state = ([toggleTab addr state] ++ body) +update : Message -> Model -> Transaction Message Model +update msg model = + case msg of + _ -> + done model + +{- update : FancyStartApp.UpdateFun Model Empty Action update loopback now action state = case Debug.log "MAIN ACTION" action of @@ -219,7 +227,7 @@ update loopback now action state = CompilationErrors errors -> Debug.crash errors - +-} -- Socket stuff @@ -238,8 +246,9 @@ port windowLocationHost : String -- TASK PORTS -port connectSocket : Task x () -port connectSocket = +-- TODO: external events in Elm Components so we can add this in +connectSocket : Task Never Message +connectSocket = (WebSocket.create ("ws://" ++ windowLocationHost ++ "/socket?file=" ++ fileName) (Signal.forwardTo @@ -257,8 +266,7 @@ port connectSocket = ) ) ) - `Task.andThen` (\socket -> - Signal.send socketEventsMailbox.address (ConnectSocket <| Just socket)) + |> Task.map (ConnectSocket << Just) port uiTasksPort : Signal (Task Empty ()) @@ -266,6 +274,6 @@ port uiTasksPort = uiTasks -port debugServiceTasks : Signal (Task Empty ()) -port debugServiceTasks = - Service.tasks +--port debugServiceTasks : Signal (Task Empty ()) +--port debugServiceTasks = +-- Service.tasks diff --git a/frontend/Debugger/Model.elm b/frontend/Debugger/Model.elm deleted file mode 100644 index e9de075..0000000 --- a/frontend/Debugger/Model.elm +++ /dev/null @@ -1,165 +0,0 @@ -module Debugger.Model where - -import Dict -import Set -import Html exposing (Html) -import Debug -import Debugger.Reflect as Reflect - -import Debugger.RuntimeApi as API -import DataUtils exposing (..) - - -type Model - = Uninitialized - | Initializing - | Active ActiveAttrs - - --- TODO: rename? -type alias ActiveAttrs = - { session : API.DebugSession - , runningState : RunningState - , swapState : SwapState - , mainVal : Html - , exprLogs : Dict.Dict API.ExprTag API.ValueLog - -- vv TODO: get inputs for each frame as well - , nodeLogs : Dict.Dict API.NodeId API.ValueLog - , subscribedNodes : Set.Set API.NodeId - } - - -initialActiveAttrs : API.DebugSession -> Html -> ActiveAttrs -initialActiveAttrs session mainVal = - { session = session - , runningState = Paused - , swapState = NotSwapping - , mainVal = mainVal - , exprLogs = Dict.empty - , nodeLogs = Dict.empty - , subscribedNodes = Set.empty - } - - -type SwapState - = Swapping - | NotSwapping - | SwapFailed SwapError - - -type RunningState - = Playing - | Paused Int - - -type alias SwapError = - String - - -type Notification - = NewFrame API.NewFrameNotification - -- TODO: task update - | NoOpNot - - -type Action - = Notification Notification - | Command Command - | Response Response - - - -getMainValFromLogs : API.DebugSession -> List (Int, API.ValueLog) -> Html -getMainValFromLogs session logs = - let - mainId = - (API.sgShape session).mainId - - in - logs - |> List.filter (\(id, val) -> id == mainId) - |> List.head - |> getMaybe "no log with main id" - |> snd -- value log - |> List.head - |> getMaybe "log empty" - |> snd -- js elm value - |> Reflect.getHtml - - -getMainVal : API.DebugSession -> API.ValueSet -> Html -getMainVal session values = - let - mainId = - (API.sgShape session).mainId - - in - values - |> List.filter (\(id, val) -> id == mainId) - |> List.head - |> getMaybe "no value with main id" - |> snd - |> Reflect.getHtml - - -appendToLog : API.FrameIndex -> API.JsElmValue -> Maybe API.ValueLog -> Maybe API.ValueLog -appendToLog curFrame value maybeLog = - let - pair = - (curFrame, value) - - newLog = - case maybeLog of - Just log -> - log ++ [pair] - - Nothing -> - [pair] - in - Just newLog - - -updateLogs : API.FrameIndex - -> Dict.Dict comparable API.ValueLog - -> List (comparable, API.JsElmValue) - -> (comparable -> Bool) - -> Dict.Dict comparable API.ValueLog -updateLogs curFrame logs updates idPred = - List.foldl - (\(tag, value) logs -> - Dict.update tag (appendToLog curFrame value) logs) - logs - (List.filter (fst >> idPred) updates) - - -isPlaying : ActiveAttrs -> Bool -isPlaying activeAttrs = - case activeAttrs.sessionState of - Playing _ -> - True - - Pausing -> - True - - _ -> - False - - -mainId : ActiveAttrs -> API.NodeId -mainId activeAttrs = - (API.sgShape activeAttrs.session).mainId - - -numFrames : ActiveAttrs -> Int -numFrames activeAttrs = - API.numFrames activeAttrs.session - - -curFrameIdx : ActiveAttrs -> Int -curFrameIdx activeAttrs = - case activeAttrs.sessionState of - Paused idx _ -> - idx - - _ -> - numFrames activeAttrs - 1 diff --git a/frontend/Debugger/RuntimeApi.elm b/frontend/Debugger/RuntimeApi.elm index df0a81b..d04ba11 100644 --- a/frontend/Debugger/RuntimeApi.elm +++ b/frontend/Debugger/RuntimeApi.elm @@ -51,6 +51,11 @@ sgShape = Native.Debugger.RuntimeApi.sgShape +justMain : SGShape -> List NodeId +justMain shape = + [shape.mainId] + + getModule : DebugSession -> ElmModule getModule = Native.Debugger.RuntimeApi.getModule @@ -145,7 +150,7 @@ type alias ValueSet = -- COMMANDS -{-| Swap in new module. Starts off paused. +{-| Swap in new module. Starts off playing. Subscribes to the list of nodes returned by the given function (3rd arg), and returns their initial values. -} initializeFullscreen : ElmModule diff --git a/frontend/Debugger/Service.elm b/frontend/Debugger/Service.elm index aae9132..5275cdb 100644 --- a/frontend/Debugger/Service.elm +++ b/frontend/Debugger/Service.elm @@ -1,398 +1,67 @@ module Debugger.Service where -import Signal exposing (Signal) -import Task exposing (Task) -import Dict -import Set -import Html -import Debug - -import FancyStartApp +import Signal +import Task import Empty exposing (Empty) +import Components exposing (..) +import Debug import Debugger.RuntimeApi as API -import Debugger.Model exposing (..) -import Debugger.Reflect as Reflect - - -state : Signal Model -state = - fst stateAndTasks - - -tasks : Signal (Task Empty ()) -tasks = - snd stateAndTasks - - -justMain : API.SGShape -> List API.NodeId -justMain shape = - [shape.mainId] - - -stateAndTasks = - FancyStartApp.start - { initialState = Uninitialized - -- w/b swapping? - -- initialization happens later (?) - , initialTasks = always [] - , externalActions = - Signal.mergeMany - [ Signal.map Notification notificationsMailbox.signal - , Signal.map Command (commandsMailbox ()).signal - ] - , view = always identity - , update = update - } - - --- why do I have to do this? -commandsMailbox : () -> Signal.Mailbox Command -commandsMailbox _ = - mailbox - +import Debugger.Active as Active -mailbox = - Signal.mailbox NoOpCommand +type alias Model = + Maybe Active.Model -notificationsMailbox : Signal.Mailbox Notification -notificationsMailbox = - Signal.mailbox NoOpNot +type Message + = Initialized API.DebugSession API.ValueSet + | ActiveMessage Active.Message -{-| so what happens if you subscribe to something -while playing? Pause => --} - -update : FancyStartApp.UpdateFun Model Empty Action -update loopback now action state = - case state of - Uninitialized -> - case action of - Command (Initialize mod) -> - ( Initializing - , [ API.initializeFullscreen - mod - API.emptyInputHistory - (Signal.forwardTo notificationsMailbox.address NewFrame) - justMain - |> Task.map (\(session, values) -> Response <| IsActive session values) - |> Task.mapError (\swapErr -> Debug.crash swapErr) - |> loopback - ] - ) - - _ -> - Debug.crash "..." - - Initializing -> - case action of - Response (IsActive session values) -> - ( Active <| initialActiveAttrs session (getMainVal session values) - , [ API.setPlaying session True - |> Task.mapError (\_ -> Debug.crash "already in that state") - |> Task.map (always (Response <| IsPlaying)) - |> loopback - ] - ) - - _ -> - Debug.crash "..." - - Active activeAttrs -> +app : API.ElmModule -> App Message Model Model +app initMod = + { init = let - (newAAs, tasks) = updateActive loopback now action activeAttrs + effect = + API.initializeFullscreen + initMod + API.emptyInputHistory + (Signal.forwardTo (Active.notificationsMailbox ()).address Active.NewFrame) + API.justMain + |> Task.map (\(session, values) -> Initialized session values) + |> task in - (Active newAAs, tasks) - -updateActive : FancyStartApp.UpdateFun ActiveAttrs Empty Action -updateActive loopback now action state = - let d = Debug.log "(act, state)" (action, state.sessionState) - in case state.sessionState of - Playing maybeCommand -> - case maybeCommand of - Just cmdOut -> - case cmdOut of - Swapping -> - case action of - Response (SwapResult res) -> - Debug.crash "swapping while playing not yet implemented" - - _ -> - Debug.crash "..." - - Subscribing bool -> - case action of - -- TODO: factor out SUB - Response (IsSubscribed maybeVals) -> - (state, []) - - _ -> - Debug.crash "..." - - _ -> - Debug.crash "..." - - Nothing -> - case action of - Notification not -> - case not of - NewFrame newFrame -> - let - curFrame = - curFrameIdx state - - newExprLogs = - updateLogs - curFrame - state.exprLogs - newFrame.flaggedExprValues - (always True) - - newNodeLogs = - updateLogs - curFrame - state.nodeLogs - newFrame.subscribedNodeValues - (\id -> id /= mainId state) - - mainValue = - newFrame.subscribedNodeValues - |> List.filter (\(id, val) -> id == mainId state) - |> List.head - |> Maybe.map (snd >> Reflect.getHtml) - |> Maybe.withDefault state.mainVal - in - ( { state - | exprLogs <- newExprLogs - , nodeLogs <- newNodeLogs - , mainVal <- mainValue - } - , [] - ) - - NoOpNot -> - (state, []) - - Command Pause -> - ( { state | sessionState <- Pausing } - , [ API.setPlaying state.session False - |> Task.mapError (\_ -> Debug.crash "already in that state") - |> Task.map (always (Response <| IsPaused Nothing)) - |> loopback - ] - ) - - Command (ForkFrom idx playingAfter) -> - ( { state | - sessionState <- Forking idx True - }, - [ API.forkFrom state.session 0 - |> Task.mapError (\_ -> Debug.crash "...") - |> Task.map (Response << HasForked) - |> loopback - ] - ) - - Command (GetNodeState interval nodeIds) -> - ( { state | - sessionState <- Pausing - } - , [ (API.setPlaying state.session False - |> Task.mapError (\_ -> Debug.crash "already in that state") - |> Task.map (always <| Response <| IsPaused <| Just interval) - |> loopback) - `Task.andThen` (\_ -> - -- TODO: factor this out - API.getNodeState state.session interval nodeIds - |> Task.mapError (\_ -> Debug.crash "...") - |> Task.map (Response << GotNodeState) - |> loopback - ) - ] - ) - - Command (Swap mod) -> - Debug.crash "swapping while playing not yet implemented" - - _ -> - Debug.crash "unexpected action in playing state" - - Paused pausedIdx maybeCommand -> - case maybeCommand of - Just cmdOut -> - case cmdOut of - Swapping -> - case action of - Response (SwapResult res) -> - case res of - Ok (newSession, values) -> - ( { state | session <- newSession - , mainVal <- getMainVal newSession values - , sessionState <- Paused pausedIdx Nothing - } - , [] - ) - - Err swapErr -> - ( { state | sessionState <- SwapError swapErr } - , [] - ) - - _ -> - Debug.crash "..." - - GettingNodeState interval -> - case action of - Response (GotNodeState values) -> - ( { state - | mainVal <- - getMainValFromLogs state.session values - , sessionState <- - Paused interval.start Nothing - } - , [] - ) - - Command (GetNodeState interval nodes) -> - ( { state | - sessionState <- - Paused pausedIdx (Just <| GettingNodeState interval) - } - , [ API.getNodeState state.session interval nodes - |> Task.mapError (\_ -> Debug.crash "...") - |> Task.map (Response << GotNodeState) - |> loopback - ] - ) - - _ -> - Debug.crash <| "unexpected: " ++ (toString (action)) - - Subscribing subbing -> - -- TODO: factor out SUB - case action of - Response (IsSubscribed maybeLog) -> - case (subbing, maybeLog) of - (True, Just valLog) -> - (state, []) - - (False, Nothing) -> - (state, []) - - _ -> - Debug.crash "..." - - _ -> - Debug.crash "..." + -- would be nice to pipeline this + request effect Nothing + , view = always identity + , update = update + , externalMessages = Nothing + } + + +update : Message -> Model -> Transaction Message Model +update msg model = + case msg of + Initialized session initValues -> + case model of + Just _ -> + Debug.crash "already initialized" Nothing -> - case action of - Command (Subscribe nodeId sub) -> - (state, []) - - Command (Swap mod) -> - ( { state | sessionState <- Playing (Just Swapping) } - , [ API.swap - state.session - mod - (Signal.forwardTo notificationsMailbox.address NewFrame) - justMain - (curFrameIdx state) - |> Task.toResult - |> Task.map (Response << SwapResult) - |> loopback - ] - ) - - Command (GetNodeState interval nodes) -> - ( { state | - sessionState <- - Paused pausedIdx (Just <| GettingNodeState interval) - } - , [ API.getNodeState state.session interval nodes - |> Task.mapError (\_ -> Debug.crash "...") - |> Task.map (Response << GotNodeState) - |> loopback - ] - ) - - Response (GotNodeState values) -> - ( { state - | mainVal <- - getMainValFromLogs state.session values - , sessionState <- - Paused pausedIdx Nothing - } - , [] - ) - - Command (ForkFrom frameIdx playingAfter) -> - -- TODO: need to know whether this is from Reset or Play button. - -- revamp these commands, this is ridiculous. - ( {state | sessionState <- Forking frameIdx playingAfter } - , [ API.forkFrom state.session frameIdx - |> Task.mapError (\msg -> Debug.crash msg) - |> Task.map (\vals -> Response (HasForked vals)) - |> loopback - ] - ) - - _ -> - Debug.crash "..." - - Forking idx playingAfter -> - case action of - Response (HasForked values) -> - -- TODO: get main, etc... - ( { state - | sessionState <- - if playingAfter then - AlmostPlaying - else - Paused idx Nothing - , mainVal <- getMainVal state.session values - } - , if playingAfter then - [ API.setPlaying state.session True - |> Task.mapError (\_ -> Debug.crash "already playing") - |> Task.map (always <| Response IsPlaying) - |> loopback - ] - else - [] - ) - - _ -> - Debug.crash "unexpected action in Forking state" - - Pausing -> - case action of - Response (IsPaused maybeInt) -> let - cmdOut = - maybeInt |> Maybe.map GettingNodeState + initMain = + Active.getMainVal session initValues in - ( { state | sessionState <- Paused (curFrameIdx state) cmdOut } - , [] - ) + Active.initModel session initMain + |> Just + |> done - _ -> - Debug.crash "..." + ActiveMessage actMsg -> + case model of + Just activeModel -> + with + (tag ActiveMessage <| Active.update actMsg activeModel) + (done << Just) - AlmostPlaying -> - case action of - Response IsPlaying -> - ( { state | sessionState <- Playing Nothing } - , [] - ) - - _ -> - Debug.crash "unexpected action in playing state" - - SwapError _ -> - case action of - _ -> - -- TODO: you can reset... - Debug.crash "action in SwapError state" + Nothing -> + Debug.crash "not yet initialized" diff --git a/frontend/Model.elm b/frontend/Model.elm index c779330..c602511 100644 --- a/frontend/Model.elm +++ b/frontend/Model.elm @@ -3,13 +3,13 @@ module Model where import Json.Decode exposing (..) import WebSocket -import Debugger.Model as DM +import Debugger.Service as DS import SideBar.Logs as Logs import Button import Debugger.RuntimeApi as API type alias Model = - { serviceState : DM.Model + { serviceState : DS.Model , sidebarVisible : Bool , permitSwaps : Bool , restartButtonState : Button.Model @@ -21,7 +21,7 @@ type alias Model = initModel : Model initModel = - { serviceState = DM.Uninitialized + { serviceState = Nothing , sidebarVisible = True , permitSwaps = True , restartButtonState = Button.Up @@ -31,16 +31,17 @@ initModel = } -type Action +type Message = SidebarVisible Bool | PermitSwaps Bool - | NewServiceState DM.Model + | NewServiceState DS.Model -- TODO: vv get rid of these with new component arch ...? vv - | PlayPauseButtonAction Button.Action - | RestartButtonAction Button.Action - | LogsAction Logs.Action + | PlayPauseButtonAction Button.Message + | RestartButtonAction Button.Message + | LogsAction Logs.Message | ConnectSocket (Maybe WebSocket.WebSocket) | SwapEvent SwapEvent + | ServiceMessage Service.Message | NoOp diff --git a/frontend/Native/Debugger/RuntimeApi.js b/frontend/Native/Debugger/RuntimeApi.js index 307ee77..84955f6 100644 --- a/frontend/Native/Debugger/RuntimeApi.js +++ b/frontend/Native/Debugger/RuntimeApi.js @@ -138,7 +138,7 @@ Elm.Native.Debugger.RuntimeApi.make = function(localRuntime) { shape: sgShape, notificationAddress: notificationAddress, disposed: false, - playing: false, + playing: true, subscribedNodeIds: List.toArray(initialNodesFun(sgShape)) }; diff --git a/frontend/SideBar/Controls.elm b/frontend/SideBar/Controls.elm index 429d11d..ee17cf3 100644 --- a/frontend/SideBar/Controls.elm +++ b/frontend/SideBar/Controls.elm @@ -9,8 +9,8 @@ import String import FontAwesome import Model -import Debugger.Model as DM import Debugger.Service as Service +import Debugger.Active as Active import Styles exposing (..) import Button @@ -77,8 +77,8 @@ darkGrey = Color.rgb 74 74 74 -- VIEW -playPauseButton : Signal.Address Model.Action -> Bool -> Button.Model -> DM.ActiveAttrs -> Html -playPauseButton addr isPlay state activeAttrs = +playPauseButton : Signal.Address Model.Message -> Bool -> Button.Model -> Active.Model -> Html +playPauseButton addr isPlay state activeState = let icon = if isPlay then @@ -91,7 +91,7 @@ playPauseButton addr isPlay state activeAttrs = -- TODO: we shouldn't have to know this here curFrame = - DM.curFrameIdx activeAttrs + Active.curFrameIdx activeState in Button.view (Signal.forwardTo addr Model.PlayPauseButtonAction) @@ -101,8 +101,8 @@ playPauseButton addr isPlay state activeAttrs = render -restartButton : Signal.Address Model.Action -> Button.Model -> DM.ActiveAttrs -> Html -restartButton addr state activeAttrs = +restartButton : Signal.Address Active.Message -> Button.Model -> Active.Model -> Html +restartButton addr state activeState = let render st = iconButton @@ -113,12 +113,12 @@ restartButton addr state activeAttrs = (Signal.forwardTo addr Model.RestartButtonAction) commandsAddr -- TODO: this should just be a Reset action - (DM.ForkFrom 0 <| DM.isPlaying activeAttrs) + (DM.ForkFrom 0 <| Active.isPlaying activeState) state render -swapButton : Signal.Address Model.Action -> Bool -> Html +swapButton : Signal.Address Active.Message -> Bool -> Html swapButton addr permitSwap = input [ type' "checkbox" @@ -130,14 +130,14 @@ swapButton addr permitSwap = [] -scrubSlider : Int -> Model.Model -> DM.ActiveAttrs -> Html -scrubSlider width state activeAttrs = +scrubSlider : Int -> Model.Model -> Active.Model -> Html +scrubSlider width state activeState = let numFrames = - DM.numFrames activeAttrs + Active.numFrames activeState curFrame = - DM.curFrameIdx activeAttrs + Active.curFrameIdx activeState in input [ type' "range" @@ -154,19 +154,20 @@ scrubSlider width state activeAttrs = (\idx -> Signal.message commandsAddr - (DM.GetNodeState {start=idx, end=idx} [DM.mainId activeAttrs])) + (DM.GetNodeState {start=idx, end=idx} [Active.mainId activeState])) ] [] -sliderEventText : Int -> DM.ActiveAttrs -> Html -sliderEventText width activeAttrs = +-- TODO: de-dupe this code w/ sliderMinMaxText +sliderEventText : Int -> Active.Model -> Html +sliderEventText width activeState = let numFrames = - DM.numFrames activeAttrs + Active.numFrames activeState curFrame = - DM.curFrameIdx activeAttrs + Active.curFrameIdx activeState in div [ style @@ -177,14 +178,14 @@ sliderEventText width activeAttrs = [ positionedText width curFrame numFrames False ] -sliderMinMaxText : Int -> DM.ActiveAttrs -> Html -sliderMinMaxText width activeAttrs = +sliderMinMaxText : Int -> Active.Model -> Html +sliderMinMaxText width activeState = let numFrames = - DM.numFrames activeAttrs + Active.numFrames activeState curFrame = - DM.curFrameIdx activeAttrs + Active.curFrameIdx activeState in div [ style @@ -241,8 +242,8 @@ positionedText width frameIdx numFrames alwaysRight = [ text (toString frameIdx) ] -view : Signal.Address Model.Action -> Model.Model -> DM.ActiveAttrs -> Html -view addr state activeAttrs = +view : Signal.Address Active.Message -> Model.Model -> Active.Model -> Html +view addr state activeState = let midWidth = sidebarWidth - margin * 2 @@ -263,9 +264,9 @@ view addr state activeAttrs = , "-webkit-align-items" => "center" ] ] - [ restartButton addr state.restartButtonState activeAttrs + [ restartButton addr state.restartButtonState activeState , swapWithLabel - , playPauseButton addr (not <| DM.isPlaying activeAttrs) state.playPauseButtonState activeAttrs + , playPauseButton addr (not <| Active.isPlaying activeState) state.playPauseButtonState activeState ] sliderContainer = @@ -273,9 +274,9 @@ view addr state activeAttrs = [ style [ "padding-top" => intToPx sliderPadding ] ] - [ sliderEventText midWidth activeAttrs - , scrubSlider midWidth state activeAttrs - , sliderMinMaxText midWidth activeAttrs + [ sliderEventText midWidth activeState + , scrubSlider midWidth state activeState + , sliderMinMaxText midWidth activeState ] in div @@ -286,64 +287,6 @@ view addr state activeAttrs = , sliderContainer ] --- TODO: pass this as an argument from main? --- it never changes... -commandsAddr : Signal.Address DM.Command -commandsAddr = - (Service.commandsMailbox ()).address - - - - ---view : Signal.Address Action -> DM.ActiveAttrs -> Html ---view addr activeAttrs = --- let --- .... --- in --- div [] --- [ div [] --- [ button --- [ onClick --- commandsAddr --- (if DM.isPlaying activeAttrs then --- DM.Pause --- else --- DM.ForkFrom curFrame True) --- ] --- [ text --- (if DM.isPlaying activeAttrs then "Pause" else "Play") --- ] --- , button --- [ onClick commandsAddr <| --- DM.ForkFrom 0 (DM.isPlaying activeAttrs) --- ] --- [ text "Reset" ] --- ] --- , div [] --- [ div [] --- [ text <| --- "frame idx: " --- ++ (toString <| curFrame) --- ++ "; numFrames: " ++ toString numFrames --- , input --- [ type' "range" --- , Attr.min "0" --- , Attr.max <| toString <| numFrames - 1 --- , Attr.value <| toString <| curFrame --- , on --- "input" --- (JsDec.at ["target","value"] --- (JsDec.customDecoder JsDec.string String.toInt)) --- (\idx -> --- Signal.message --- commandsAddr --- (DM.GetNodeState {start=idx, end=idx} [DM.mainId activeAttrs])) --- ] --- [] --- ] --- ] --- ] - -- UTILITIES diff --git a/frontend/SideBar/Logs.elm b/frontend/SideBar/Logs.elm index 071cfaf..9f6062b 100644 --- a/frontend/SideBar/Logs.elm +++ b/frontend/SideBar/Logs.elm @@ -11,7 +11,8 @@ import Html.Attributes as Attr exposing (..) import Html.Events exposing (..) import Styles exposing (..) -import Debugger.Model as DM +import Debugger.Service as DS +import Debugger.Active as Active import Debugger.RuntimeApi as API import DataUtils exposing (..) @@ -29,9 +30,9 @@ initModel = } -type Action +type Message = CollapseLog LogId Bool - | UpdateLogs DM.Model + | UpdateLogs DS.Model type LogId @@ -39,9 +40,9 @@ type LogId | ExprLog API.ExprTag -update : Action -> Model -> Model -update action state = - case action of +update : Message -> Model -> Model +update msg state = + case msg of CollapseLog logId collapsed -> case logId of NodeLog nodeId -> @@ -56,20 +57,20 @@ update action state = UpdateLogs serviceState -> case serviceState of - DM.Active activeAttrs -> + Just activeModel -> { state | exprExpansion <- - updateExpansion state.exprExpansion activeAttrs.exprLogs + updateExpansion state.exprExpansion activeModel.exprLogs , nodeExpansion <- - updateExpansion state.nodeExpansion activeAttrs.nodeLogs + updateExpansion state.nodeExpansion activeModel.nodeLogs } _ -> state -view : Signal.Address Action -> Int -> Model -> DM.ActiveAttrs -> Html -view addr controlsHeight state activeAttrs = +view : Signal.Address Message -> Int -> Model -> Active.Model -> Html +view addr controlsHeight state activeState = div [ style [ "overflow-y" => "auto" @@ -81,7 +82,7 @@ view addr controlsHeight state activeAttrs = , "width" => intToPx (sidebarWidth - 2*sidePadding) ] ] - ( if Dict.isEmpty activeAttrs.exprLogs then + ( if Dict.isEmpty activeState.exprLogs then [noLogs] else [ ul @@ -91,7 +92,7 @@ view addr controlsHeight state activeAttrs = , "color" => "white" ] ] - (activeAttrs.exprLogs + (activeState.exprLogs |> Dict.toList |> List.map (\(tag, log) -> viewExprLog @@ -107,7 +108,7 @@ sidePadding = 20 -viewExprLog : Signal.Address Action -> Bool -> LogId -> API.ValueLog -> Html +viewExprLog : Signal.Address Message -> Bool -> LogId -> API.ValueLog -> Html viewExprLog addr collapsed logId log = let colButton =