├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── demo ├── .gitignore ├── Clock.elm ├── Counter.elm ├── DragAndDrop.elm ├── LargeModel.elm ├── MsgTree.elm ├── Nav.elm ├── build.sh ├── elm-package.json └── msg-tree.html ├── elm-package.json ├── src └── TimeTravel │ ├── Html.elm │ ├── Internal │ ├── DiffView.elm │ ├── Icons.elm │ ├── Model.elm │ ├── MsgLike.elm │ ├── MsgTreeView.elm │ ├── Parser │ │ ├── AST.elm │ │ ├── Formatter.elm │ │ ├── Parser.elm │ │ └── Util.elm │ ├── Styles.elm │ ├── Update.elm │ ├── Util │ │ ├── Nel.elm │ │ └── RTree.elm │ └── View.elm │ └── Navigation.elm └── tests ├── .gitignore ├── Main.elm ├── Tests.elm └── elm-package.json /.gitignore: -------------------------------------------------------------------------------- 1 | # elm-package generated files 2 | elm-stuff/ 3 | # elm-repl generated files 4 | repl-temp-* 5 | 6 | index.html 7 | 8 | dep-check.html 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | node_js: 3 | - "4.2" 4 | before_script: 5 | - npm install -g elm 6 | - npm install -g elm-test 7 | - elm-package install -y 8 | script: elm-test --seed 345779894 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Yosuke Torii 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | * Neither the name of the author nor the names of its 16 | contributors may be used to endorse or promote products derived from 17 | this software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 20 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # elm-time-travel 2 | 3 | [![Build Status](https://travis-ci.org/jinjor/elm-time-travel.svg)](https://travis-ci.org/jinjor/elm-time-travel) 4 | 5 | An experimental debugger for Elm. See [DEMO](http://jinjor.github.io/elm-time-travel/) 6 | 7 | ## How to use 8 | 9 | Just use `TimeTravel.program` instead of `Html.program`. 10 | 11 | ```elm 12 | import TimeTravel.Html as TimeTravel 13 | 14 | main = 15 | -- Html.program 16 | TimeTravel.program 17 | { init = init 18 | , view = view 19 | , update = update 20 | , subscriptions = subscriptions 21 | } 22 | ``` 23 | 24 | That's it! 25 | 26 | ## What is this library for? 27 | 28 | Elm has [a great official debugger](http://elm-lang.org/blog/the-perfect-bug-report) from 0.18, but this debugger was born at 0.17! These two are focusing on slightly different things. The official one focuses on reproducing state and communicating between dev and QA people. This one, on the other hand, is more focusing on digging into problems that happen in runtime. 29 | 30 | This library implements following features: 31 | 32 | * Filtering Msgs 33 | * Filtering Model 34 | * Figure out how Msgs are chaining 35 | 36 | And the ideas not implemented yet are: 37 | 38 | * Watch partial Model and find Msgs that changes it 39 | * Automatically save debugger state 40 | 41 | So this library is a PoC of what the official debugger can potentially be in the future. Evan is also positive at this :) 42 | 43 | 44 | ## LICENSE 45 | 46 | BSD3 47 | -------------------------------------------------------------------------------- /demo/.gitignore: -------------------------------------------------------------------------------- 1 | # elm-package generated files 2 | elm-stuff/ 3 | # elm-repl generated files 4 | repl-temp-* 5 | 6 | *.js 7 | *.html 8 | !msg-tree.html 9 | -------------------------------------------------------------------------------- /demo/Clock.elm: -------------------------------------------------------------------------------- 1 | import Html exposing (Html) 2 | import Svg exposing (..) 3 | import Svg.Attributes exposing (..) 4 | import Time exposing (Time, second) 5 | 6 | import TimeTravel.Html as TimeTravel 7 | 8 | 9 | main = 10 | TimeTravel.program 11 | { init = init 12 | , view = view 13 | , update = update 14 | , subscriptions = subscriptions 15 | } 16 | 17 | 18 | 19 | -- MODEL 20 | 21 | 22 | type alias Model = Time 23 | 24 | 25 | init : (Model, Cmd Msg) 26 | init = 27 | (0, Cmd.none) 28 | 29 | 30 | 31 | -- UPDATE 32 | 33 | 34 | type Msg 35 | = Tick Time 36 | 37 | 38 | update : Msg -> Model -> (Model, Cmd Msg) 39 | update msg model = 40 | case msg of 41 | Tick newTime -> 42 | (newTime, Cmd.none) 43 | 44 | 45 | 46 | -- SUBSCRIPTIONS 47 | 48 | 49 | subscriptions : Model -> Sub Msg 50 | subscriptions model = 51 | Time.every second Tick 52 | 53 | 54 | 55 | -- VIEW 56 | 57 | 58 | view : Model -> Html Msg 59 | view model = 60 | let 61 | angle = 62 | turns (Time.inMinutes model) 63 | 64 | handX = 65 | toString (50 + 40 * cos angle) 66 | 67 | handY = 68 | toString (50 + 40 * sin angle) 69 | in 70 | svg [ viewBox "0 0 100 100", width "300px" ] 71 | [ circle [ cx "50", cy "50", r "45", fill "#0B79CE" ] [] 72 | , line [ x1 "50", y1 "50", x2 handX, y2 handY, stroke "#023963" ] [] 73 | ] 74 | -------------------------------------------------------------------------------- /demo/Counter.elm: -------------------------------------------------------------------------------- 1 | import Html exposing (div, button, text) 2 | import Html.Events exposing (onClick) 3 | 4 | import TimeTravel.Html as TimeTravel 5 | 6 | 7 | main = 8 | TimeTravel.beginnerProgram { model = 0, view = view, update = update } 9 | 10 | 11 | view model = 12 | div [] 13 | [ button [ onClick Decrement ] [ text "-" ] 14 | , div [] [ text (toString model) ] 15 | , button [ onClick Increment ] [ text "+" ] 16 | ] 17 | 18 | 19 | type Msg = Increment | Decrement 20 | 21 | 22 | update msg model = 23 | case msg of 24 | Increment -> 25 | model + 1 26 | 27 | Decrement -> 28 | model - 1 29 | -------------------------------------------------------------------------------- /demo/DragAndDrop.elm: -------------------------------------------------------------------------------- 1 | import Html exposing (..) 2 | import Html.Attributes exposing (..) 3 | import Html.Events exposing (on) 4 | import Json.Decode as Json exposing (field) 5 | import Mouse exposing (Position) 6 | 7 | import TimeTravel.Html as TimeTravel 8 | 9 | 10 | main = 11 | TimeTravel.program 12 | { init = init 13 | , view = view 14 | , update = update 15 | , subscriptions = subscriptions 16 | } 17 | 18 | 19 | -- MODEL 20 | 21 | 22 | type alias Model = 23 | { position : Position 24 | , drag : Maybe Drag 25 | } 26 | 27 | 28 | type alias Drag = 29 | { start : Position 30 | , current : Position 31 | } 32 | 33 | 34 | init : ( Model, Cmd Msg ) 35 | init = 36 | ( Model (Position 200 200) Nothing, Cmd.none ) 37 | 38 | 39 | 40 | -- UPDATE 41 | 42 | 43 | type Msg 44 | = DragStart Position 45 | | DragAt Position 46 | | DragEnd Position 47 | 48 | 49 | update : Msg -> Model -> ( Model, Cmd Msg ) 50 | update msg model = 51 | ( updateHelp msg model, Cmd.none ) 52 | 53 | 54 | updateHelp : Msg -> Model -> Model 55 | updateHelp msg ({position, drag} as model) = 56 | case msg of 57 | DragStart xy -> 58 | Model position (Just (Drag xy xy)) 59 | 60 | DragAt xy -> 61 | Model position (Maybe.map (\{start} -> Drag start xy) drag) 62 | 63 | DragEnd _ -> 64 | Model (getPosition model) Nothing 65 | 66 | 67 | 68 | -- SUBSCRIPTIONS 69 | 70 | 71 | subscriptions : Model -> Sub Msg 72 | subscriptions model = 73 | case model.drag of 74 | Nothing -> 75 | Sub.none 76 | 77 | Just _ -> 78 | Sub.batch [ Mouse.moves DragAt, Mouse.ups DragEnd ] 79 | 80 | 81 | 82 | -- VIEW 83 | 84 | 85 | (=>) = (,) 86 | 87 | 88 | view : Model -> Html Msg 89 | view model = 90 | let 91 | realPosition = 92 | getPosition model 93 | in 94 | div 95 | [ onMouseDown 96 | , style 97 | [ "background-color" => "#3C8D2F" 98 | , "cursor" => "move" 99 | 100 | , "width" => "100px" 101 | , "height" => "100px" 102 | , "border-radius" => "4px" 103 | , "position" => "absolute" 104 | , "left" => px realPosition.x 105 | , "top" => px realPosition.y 106 | 107 | , "color" => "white" 108 | , "display" => "flex" 109 | , "align-items" => "center" 110 | , "justify-content" => "center" 111 | ] 112 | ] 113 | [ text "Drag Me!" 114 | ] 115 | 116 | 117 | px : Int -> String 118 | px number = 119 | toString number ++ "px" 120 | 121 | 122 | getPosition : Model -> Position 123 | getPosition {position, drag} = 124 | case drag of 125 | Nothing -> 126 | position 127 | 128 | Just {start,current} -> 129 | Position 130 | (position.x + current.x - start.x) 131 | (position.y + current.y - start.y) 132 | 133 | 134 | onMouseDown : Attribute Msg 135 | onMouseDown = 136 | on "mousedown" (Json.map DragStart Mouse.position) 137 | -------------------------------------------------------------------------------- /demo/LargeModel.elm: -------------------------------------------------------------------------------- 1 | import Html exposing (div, button, text) 2 | import Html.Events exposing (onClick) 3 | 4 | import TimeTravel.Html as TimeTravel 5 | 6 | 7 | main = 8 | TimeTravel.beginnerProgram { model = model, view = view, update = update } 9 | 10 | 11 | model = 12 | { a = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 13 | , b = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 14 | , c = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 15 | , d = 0 16 | , e = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 17 | , f = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 18 | , g = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 19 | , h = {a=1,b=1,c=1,d=1,e="1",f="1",g="1",h="1",i="1",j="1",k="1"} 20 | , i = 0 21 | , j = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" 22 | , k = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" 23 | , l = "ccccccccccccccccccccccccccccccccccc" 24 | , o = "dddddddddddddddddddddddddddddddddddddddddddddddddddddd" 25 | , p = Just (Just (Just (Just (Just (Just (Just (Just (Just 1)))))))) 26 | , q = Just (Just (Just (Just (Just (Just (Just (Just (Just 2)))))))) 27 | , r = Just (Just (Just (Just (Just (Just (Just (Just (Just 3)))))))) 28 | , s = Just (Just (Just (Just (Just (Just (Just (Just (Just 4)))))))) 29 | , t = "Ok, Google" 30 | , u = 123456789 31 | , v = 123.456 32 | , w = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 33 | , x = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 34 | , y = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 35 | , z = [0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9] 36 | } 37 | 38 | 39 | 40 | view model = 41 | div [] 42 | [ button [ onClick Decrement ] [ text "-" ] 43 | , div [] [ text (toString model) ] 44 | , button [ onClick Increment ] [ text "+" ] 45 | ] 46 | 47 | 48 | type Msg = Increment | Decrement 49 | 50 | 51 | update msg model = 52 | case msg of 53 | Increment -> 54 | { model | i = 100 } 55 | 56 | Decrement -> 57 | { model | d = 100 } 58 | -------------------------------------------------------------------------------- /demo/MsgTree.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (..) 6 | import Http 7 | import Json.Decode as Json 8 | import Task 9 | 10 | import TimeTravel.Html as TimeTravel 11 | 12 | import Dict exposing (Dict) 13 | import Process 14 | 15 | 16 | -- port outgoing : TimeTravel.OutgoingMsg -> Cmd msg 17 | -- 18 | -- port incoming : (TimeTravel.IncomingMsg -> msg) -> Sub msg 19 | 20 | 21 | main = 22 | TimeTravel.program 23 | -- TimeTravel.programWithOptions 24 | -- { outgoingMsg = outgoing 25 | -- , incomingMsg = incoming 26 | -- } 27 | { init = init 28 | , view = view 29 | , update = update 30 | , subscriptions = subscriptions 31 | } 32 | 33 | 34 | -- MODEL 35 | 36 | 37 | type alias Model = 38 | { user : Maybe String 39 | , team : Team 40 | , members : List String 41 | , memberDetails : Dict String Member 42 | , selectedMember : Maybe String 43 | , err : List String 44 | } 45 | 46 | 47 | type alias Team = 48 | { id : String 49 | , name : String 50 | } 51 | 52 | 53 | type alias Member = 54 | { id : String 55 | , name : String 56 | , tel : String 57 | , mail : String 58 | } 59 | 60 | 61 | initMember : Member 62 | initMember = 63 | { id = "" 64 | , name = "" 65 | , tel = "" 66 | , mail = "" 67 | } 68 | 69 | 70 | initTeam : Team 71 | initTeam = 72 | { id = "" 73 | , name = "" 74 | } 75 | 76 | 77 | init : (Model, Cmd Msg) 78 | init = 79 | ( { user = Nothing 80 | , team = initTeam 81 | , members = [] 82 | , memberDetails = Dict.empty 83 | , selectedMember = Nothing 84 | , err = [] 85 | } 86 | , Cmd.none 87 | ) 88 | 89 | 90 | 91 | -- UPDATE 92 | 93 | 94 | type Msg 95 | = Load 96 | | UserLoaded String 97 | | TeamDetailLoaded Team 98 | | MembersLoaded (List String) 99 | | MemberDetailLoaded Member 100 | | Error String 101 | 102 | 103 | update : Msg -> Model -> (Model, Cmd Msg) 104 | update msg model = 105 | case msg of 106 | Load -> 107 | ( { model | err = [] }, getUser) 108 | 109 | UserLoaded name -> 110 | ( { model | user = Just name } 111 | , Cmd.batch [getTeamDetail name, getTeamMembers name] 112 | ) 113 | 114 | TeamDetailLoaded team -> 115 | ( { model | team = team }, Cmd.none ) 116 | 117 | MembersLoaded members -> 118 | ( { model | members = members, selectedMember = List.head members } 119 | , Cmd.batch (List.map getMemberDetail members) 120 | ) 121 | 122 | MemberDetailLoaded detail -> 123 | ( { model | memberDetails = Dict.insert detail.id detail model.memberDetails } 124 | , Cmd.none 125 | ) 126 | 127 | Error e -> 128 | ({ model | err = e :: model.err }, Cmd.none) 129 | 130 | 131 | 132 | -- VIEW 133 | 134 | 135 | view : Model -> Html Msg 136 | view model = 137 | div [] 138 | [ greeting model 139 | , button [ onClick Load ] [ text "Load" ] 140 | , hr [] [] 141 | , teamDetailView model 142 | , hr [] [] 143 | , div [] (List.map memberItemView model.members) 144 | , hr [] [] 145 | , memberDetailView model 146 | ] 147 | 148 | 149 | greeting : Model -> Html Msg 150 | greeting model = 151 | case model.user of 152 | Just name -> div [] [ text ("Hello, " ++ name) ] 153 | Nothing -> div [] [ text "" ] 154 | 155 | 156 | teamDetailView : Model -> Html Msg 157 | teamDetailView model = 158 | div [] [ text model.team.name ] 159 | 160 | 161 | memberItemView : String -> Html Msg 162 | memberItemView name = 163 | div [] [ text name ] 164 | 165 | 166 | memberDetailView : Model -> Html Msg 167 | memberDetailView model = 168 | case model.selectedMember of 169 | Just id -> 170 | case Dict.get id model.memberDetails of 171 | Just member -> 172 | div 173 | [] 174 | [ div [] [ text member.name ] 175 | , div [] [ text member.tel ] 176 | , div [] [ text member.mail ] 177 | ] 178 | 179 | Nothing -> 180 | text "" 181 | 182 | Nothing -> 183 | text "" 184 | 185 | 186 | -- SUBSCRIPTIONS 187 | 188 | 189 | subscriptions : Model -> Sub Msg 190 | subscriptions model = 191 | Sub.none 192 | 193 | 194 | 195 | -- HTTP 196 | 197 | dummyHttp : Int -> Msg -> Cmd Msg 198 | dummyHttp sleepTime msg = 199 | Task.perform 200 | (\_ -> msg) 201 | (Process.sleep (toFloat sleepTime)) 202 | 203 | 204 | getUser : Cmd Msg 205 | getUser = 206 | dummyHttp 300 (UserLoaded "Elmo") 207 | 208 | 209 | getTeamDetail : String -> Cmd Msg 210 | getTeamDetail name = 211 | dummyHttp 100 (TeamDetailLoaded { id = "0", name = "Awesome Team" }) 212 | 213 | 214 | getTeamMembers : String -> Cmd Msg 215 | getTeamMembers name = 216 | dummyHttp 50 (MembersLoaded ["Alice", "Bob", "Chuck"]) 217 | 218 | 219 | getMemberDetail : String -> Cmd Msg 220 | getMemberDetail id = 221 | if id == "Alice" then 222 | dummyHttp 40 (MemberDetailLoaded { id = "Alice", name = "Alice", tel = "0156", mail = "alice@xxx.com" }) 223 | else if id == "Bob" then 224 | dummyHttp 60 (MemberDetailLoaded { id = "Bob", name = "Bob", tel = "5136", mail = "bob@xxx.com" }) 225 | else if id == "Chuck" then 226 | dummyHttp 70 (Error "Not Found") 227 | else 228 | Cmd.none 229 | -------------------------------------------------------------------------------- /demo/Nav.elm: -------------------------------------------------------------------------------- 1 | import Html exposing (..) 2 | import Html.Attributes exposing (..) 3 | import Html.Events exposing (..) 4 | import Navigation 5 | 6 | import TimeTravel.Navigation as TimeTravel 7 | 8 | 9 | main = 10 | TimeTravel.program UrlChange 11 | { init = init 12 | , view = view 13 | , update = update 14 | , subscriptions = (\_ -> Sub.none) 15 | } 16 | 17 | 18 | 19 | -- MODEL 20 | 21 | 22 | type alias Model = 23 | { history : List Navigation.Location 24 | } 25 | 26 | 27 | init : Navigation.Location -> ( Model, Cmd Msg ) 28 | init location = 29 | ( Model [ location ] 30 | , Cmd.none 31 | ) 32 | 33 | 34 | 35 | -- UPDATE 36 | 37 | 38 | type Msg 39 | = UrlChange Navigation.Location 40 | 41 | 42 | {- We are just storing the location in our history in this example, but 43 | normally, you would use a package like evancz/url-parser to parse the path 44 | or hash into nicely structured Elm values. 45 | 46 | -} 47 | update : Msg -> Model -> (Model, Cmd Msg) 48 | update msg model = 49 | case msg of 50 | UrlChange location -> 51 | ( { model | history = location :: model.history } 52 | , Cmd.none 53 | ) 54 | 55 | 56 | 57 | -- VIEW 58 | 59 | 60 | view : Model -> Html msg 61 | view model = 62 | div [] 63 | [ h1 [] [ text "Pages" ] 64 | , ul [] (List.map viewLink [ "bears", "cats", "dogs", "elephants", "fish" ]) 65 | , h1 [] [ text "History" ] 66 | , ul [] (List.map viewLocation model.history) 67 | ] 68 | 69 | 70 | viewLink : String -> Html msg 71 | viewLink name = 72 | li [] [ a [ href ("#" ++ name) ] [ text name ] ] 73 | 74 | 75 | viewLocation : Navigation.Location -> Html msg 76 | viewLocation location = 77 | li [] [ text (location.pathname ++ location.hash) ] 78 | -------------------------------------------------------------------------------- /demo/build.sh: -------------------------------------------------------------------------------- 1 | elm-make Counter.elm --output=counter.html && # Html.beginnerProgram 2 | elm-make Clock.elm --output=clock.html && # Html.program 3 | elm-make Nav.elm --output=nav.html && # Navigation.program 4 | elm-make DragAndDrop.elm --output=drag-and-drop.html && # Html.Program 5 | elm-make MsgTree.elm --output=msg-tree.js && # Html.Program 6 | elm-make LargeModel.elm --output=large-model.html && # Html.beginnerProgram 7 | echo "done" 8 | -------------------------------------------------------------------------------- /demo/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "helpful summary of your project, less than 80 characters", 4 | "repository": "https://github.com/user/project.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | ".", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "Bogdanp/elm-combine": "3.0.0 <= v < 4.0.0", 13 | "jinjor/elm-diff": "1.0.0 <= v < 2.0.0", 14 | "elm-community/elm-material-icons": "2.0.0 <= v < 3.0.0", 15 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 16 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 17 | "elm-lang/mouse": "1.0.0 <= v < 2.0.0", 18 | "elm-lang/navigation": "2.0.0 <= v < 3.0.0", 19 | "elm-lang/svg": "2.0.0 <= v < 3.0.0", 20 | "elm-lang/http": "1.0.0 <= v < 2.0.0", 21 | "jinjor/elm-inline-hover": "1.0.0 <= v < 2.0.0" 22 | }, 23 | "elm-version": "0.18.0 <= v < 0.19.0" 24 | } 25 | -------------------------------------------------------------------------------- /demo/msg-tree.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 24 | 25 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "summary": "An experimental debugger for Elm", 4 | "repository": "https://github.com/jinjor/elm-time-travel.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [ 10 | "TimeTravel.Html", 11 | "TimeTravel.Navigation" 12 | ], 13 | "dependencies": { 14 | "Bogdanp/elm-combine": "3.0.0 <= v < 4.0.0", 15 | "elm-community/elm-material-icons": "2.0.0 <= v < 3.0.0", 16 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 17 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 18 | "elm-lang/navigation": "2.0.0 <= v < 3.0.0", 19 | "elm-lang/svg": "2.0.0 <= v < 3.0.0", 20 | "jinjor/elm-diff": "1.0.0 <= v < 2.0.0", 21 | "jinjor/elm-inline-hover": "1.0.0 <= v < 2.0.0" 22 | }, 23 | "elm-version": "0.18.0 <= v < 0.19.0" 24 | } 25 | -------------------------------------------------------------------------------- /src/TimeTravel/Html.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Html exposing 2 | ( beginnerProgram 3 | , program 4 | -- , programWithOptions 5 | , programWithFlags 6 | -- , programWithFlagsWithOptions 7 | -- , OutgoingMsg 8 | -- , IncomingMsg 9 | ) 10 | 11 | 12 | {-| Each functions in this module has the same interface as [Html.App](http://package.elm-lang.org/packages/elm-lang/html/latest/Html) 13 | 14 | # Start your Program 15 | @docs beginnerProgram, program, programWithFlags 16 | 17 | -} 18 | 19 | 20 | import TimeTravel.Internal.Model as Model exposing (..) 21 | import TimeTravel.Internal.Update as Update 22 | import TimeTravel.Internal.View as View 23 | import TimeTravel.Internal.Util.Nel as Nel 24 | 25 | import Html exposing (Html, div, text) 26 | 27 | 28 | type Msg msg 29 | = DebuggerMsg Model.Msg 30 | | UserMsg (Maybe Int, msg) 31 | 32 | 33 | {- Alias for internal use -} 34 | type alias OptionsWithFlags flags model msg = 35 | { init : flags -> (model, Cmd msg) 36 | , view : model -> Html msg 37 | , update : msg -> model -> (model, Cmd msg) 38 | , subscriptions : model -> Sub msg 39 | } 40 | 41 | type alias OutgoingMsg = Model.OutgoingMsg 42 | type alias IncomingMsg = Model.IncomingMsg 43 | 44 | 45 | {-| See [Html.beginnerProgram](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#beginnerProgram) 46 | -} 47 | beginnerProgram : 48 | { model : model 49 | , view : model -> Html msg 50 | , update : msg -> model -> model 51 | } 52 | -> Program Never (Model model msg) (Msg msg) 53 | beginnerProgram { model, view, update } = 54 | let 55 | options = 56 | wrap 57 | { outgoingMsg = always Cmd.none 58 | , incomingMsg = always Sub.none 59 | } 60 | { init = always (model, Cmd.none) 61 | , view = view 62 | , update = \msg model -> (update msg model, Cmd.none) 63 | , subscriptions = always Sub.none 64 | } 65 | in 66 | Html.beginnerProgram 67 | { model = Tuple.first (options.init ()) 68 | , view = options.view 69 | , update = \msg model -> Tuple.first (options.update msg model) 70 | } 71 | 72 | 73 | {-| See [Html.program](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#program) 74 | -} 75 | program : 76 | { init : (model, Cmd msg) 77 | , view : model -> Html msg 78 | , update : msg -> model -> (model, Cmd msg) 79 | , subscriptions : model -> Sub msg 80 | } 81 | -> Program Never (Model model msg) (Msg msg) 82 | program { init, view, update, subscriptions } = 83 | let 84 | options = 85 | wrap 86 | { outgoingMsg = always Cmd.none 87 | , incomingMsg = always Sub.none 88 | } 89 | { init = always init 90 | , view = view 91 | , update = update 92 | , subscriptions = subscriptions 93 | } 94 | in 95 | Html.program 96 | { init = options.init () 97 | , view = options.view 98 | , update = options.update 99 | , subscriptions = options.subscriptions 100 | } 101 | 102 | 103 | programWithOptions : 104 | { outgoingMsg : OutgoingMsg -> Cmd Never 105 | , incomingMsg : (IncomingMsg -> (Msg msg)) -> Sub (Msg msg) 106 | } 107 | -> 108 | { init : (model, Cmd msg) 109 | , view : model -> Html msg 110 | , update : msg -> model -> (model, Cmd msg) 111 | , subscriptions : model -> Sub msg 112 | } 113 | -> Program Never (Model model msg) (Msg msg) 114 | programWithOptions options { init, view, update, subscriptions } = 115 | programWithFlagsWithOptions options 116 | { init = always init 117 | , view = view 118 | , update = update 119 | , subscriptions = subscriptions 120 | } 121 | 122 | 123 | {-| See [Html.programWithFlags](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#programWithFlags) 124 | -} 125 | programWithFlags : 126 | { init : flags -> (model, Cmd msg) 127 | , view : model -> Html msg 128 | , update : msg -> model -> (model, Cmd msg) 129 | , subscriptions : model -> Sub msg 130 | } 131 | -> Program flags (Model model msg) (Msg msg) 132 | programWithFlags stuff = 133 | programWithFlagsWithOptions 134 | { outgoingMsg = always Cmd.none 135 | , incomingMsg = always Sub.none 136 | } 137 | stuff 138 | 139 | 140 | programWithFlagsWithOptions : 141 | { outgoingMsg : OutgoingMsg -> Cmd Never 142 | , incomingMsg : (IncomingMsg -> (Msg msg)) -> Sub (Msg msg) 143 | } 144 | -> 145 | { init : flags -> (model, Cmd msg) 146 | , view : model -> Html msg 147 | , update : msg -> model -> (model, Cmd msg) 148 | , subscriptions : model -> Sub msg 149 | } 150 | -> Program flags (Model model msg) (Msg msg) 151 | programWithFlagsWithOptions options stuff = 152 | Html.programWithFlags (wrap options stuff) 153 | 154 | 155 | wrap : 156 | { outgoingMsg : OutgoingMsg -> Cmd Never 157 | , incomingMsg : (IncomingMsg -> (Msg msg)) -> Sub (Msg msg) 158 | } 159 | -> OptionsWithFlags flags model msg 160 | -> OptionsWithFlags flags (Model model msg) (Msg msg) 161 | wrap { outgoingMsg, incomingMsg } { init, view, update, subscriptions } = 162 | let 163 | init_ flags = 164 | let 165 | (model, cmd) = init flags 166 | in 167 | Model.init model ! [ Cmd.map (\msg -> UserMsg (Just 0, msg)) cmd ] 168 | 169 | update_ msg model = 170 | case msg of 171 | UserMsg msgWithId -> 172 | let 173 | (m, c1) = 174 | updateOnIncomingUserMsg (\(id, msg) -> UserMsg (Just id, msg)) update msgWithId model 175 | 176 | (m_, c2) = 177 | Update.updateAfterUserMsg outgoingMsg m 178 | in 179 | m_ ! [ c1, Cmd.map DebuggerMsg c2 ] 180 | 181 | DebuggerMsg msg -> 182 | let 183 | (m, c) = 184 | Update.update outgoingMsg msg model 185 | in 186 | m ! [ Cmd.map DebuggerMsg c ] 187 | 188 | view_ model = 189 | View.view (\c -> UserMsg (Nothing, c)) DebuggerMsg view model 190 | 191 | subscriptions_ model = 192 | let 193 | item = Nel.head model.history 194 | in 195 | Sub.batch 196 | [ Sub.map (\c -> UserMsg (Nothing, c)) (subscriptions item.model) 197 | , incomingMsg (DebuggerMsg << Receive) 198 | ] 199 | 200 | in 201 | { init = init_ 202 | , update = update_ 203 | , view = view_ 204 | , subscriptions = subscriptions_ 205 | } 206 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/DiffView.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.DiffView exposing (view) 2 | 3 | import TimeTravel.Internal.Styles as S 4 | import TimeTravel.Internal.Parser.AST exposing (ASTX) 5 | 6 | import Html exposing (..) 7 | import Html.Attributes exposing (..) 8 | import Html.Events exposing (..) 9 | 10 | import Diff exposing (..) 11 | 12 | 13 | type Line = Normal String | Delete String | Add String | Omit 14 | 15 | 16 | lines : String -> List String 17 | lines s = 18 | List.filter ((/=) "") <| String.lines s 19 | 20 | 21 | view : List (Change String) -> Html msg 22 | view changes = 23 | let 24 | linesView = 25 | List.map (\line -> 26 | case line of 27 | Normal s -> 28 | normalLine s 29 | 30 | Delete s -> 31 | deletedLine s 32 | 33 | Add s -> 34 | addedLine s 35 | 36 | Omit -> 37 | omittedLine 38 | ) (reduceLines changes) 39 | in 40 | div 41 | [ style S.diffView ] 42 | linesView 43 | 44 | 45 | reduceLines : List (Change String) -> List Line 46 | reduceLines list = 47 | let 48 | additionalLines = 2 49 | 50 | (tmp, result) = 51 | List.foldr (\line (tmp, result) -> 52 | case line of 53 | NoChange s -> 54 | ((Normal s) :: tmp, result) 55 | 56 | Removed s -> 57 | tmpToResult additionalLines (Delete s) tmp result 58 | 59 | Added s -> 60 | tmpToResult additionalLines (Add s) tmp result 61 | ) ([], []) list 62 | in 63 | if result == [] then 64 | -- no change found 65 | [] 66 | else if List.length tmp > additionalLines then 67 | Omit :: (List.drop (List.length tmp - additionalLines) tmp ++ result) 68 | else 69 | tmp ++ result 70 | 71 | 72 | tmpToResult : Int -> Line -> List Line -> List Line -> (List Line, List Line) 73 | tmpToResult additionalLines next tmp result = 74 | if result == [] then 75 | ([], next :: (List.take additionalLines tmp ++ (if List.length tmp > additionalLines then [ Omit ] else []))) 76 | else if List.length tmp > (additionalLines * 2) then 77 | ([], next :: (List.take additionalLines tmp ++ [Omit] ++ List.drop (List.length tmp - additionalLines) tmp ++ result)) 78 | else 79 | ([], next :: (tmp ++ result)) 80 | 81 | 82 | omittedLine : Html msg 83 | omittedLine = 84 | div [ style S.omittedLine ] [ text "..." ] 85 | 86 | 87 | deletedLine : String -> Html msg 88 | deletedLine s = 89 | div [ style S.deletedLine ] [ text s ] 90 | 91 | 92 | addedLine : String -> Html msg 93 | addedLine s = 94 | div [ style S.addedLine ] [ text s ] 95 | 96 | 97 | normalLine : String -> Html msg 98 | normalLine s = 99 | div [ style S.normalLine ] [ text s ] 100 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Icons.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Icons exposing (..) 2 | 3 | import Material.Icons.Content exposing (filter_list, content_copy, remove, add) 4 | import Material.Icons.Navigation exposing (arrow_drop_down, arrow_drop_up, close) 5 | import Material.Icons.Av exposing (play_arrow, pause) 6 | import Material.Icons.Action exposing (swap_horiz) 7 | 8 | import Svg exposing (Svg) 9 | import Color 10 | 11 | 12 | sync : Bool -> Svg msg 13 | sync synchronized = 14 | (if synchronized then pause else play_arrow) Color.white 24 15 | 16 | 17 | filter : Bool -> Svg msg 18 | filter enabled = 19 | filter_list (if enabled then Color.white else Color.gray) 24 20 | 21 | 22 | filterExpand : Bool -> Svg msg 23 | filterExpand expanded = 24 | (if expanded then arrow_drop_up else arrow_drop_down) Color.white 24 25 | 26 | 27 | layout : Svg msg 28 | layout = 29 | swap_horiz Color.white 24 30 | 31 | 32 | toggleModelDetail : Svg msg 33 | toggleModelDetail = 34 | content_copy Color.white 24 35 | 36 | 37 | minimize : Bool -> Svg msg 38 | minimize minimized = 39 | (if minimized then add else remove) Color.white 24 40 | 41 | 42 | stopWatching : Svg msg 43 | stopWatching = 44 | close Color.gray 14 45 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Model.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Model exposing (..) 2 | 3 | import Set exposing (Set) 4 | 5 | import TimeTravel.Internal.Util.Nel as Nel exposing (..) 6 | import TimeTravel.Internal.Parser.AST as AST exposing (ASTX) 7 | import TimeTravel.Internal.Parser.Parser as Parser 8 | import TimeTravel.Internal.Parser.Formatter as Formatter 9 | import TimeTravel.Internal.Util.RTree as RTree exposing (RTree) 10 | import TimeTravel.Internal.MsgLike exposing (MsgLike(..)) 11 | 12 | import Json.Decode as Decode exposing (field, Decoder) 13 | import Json.Encode as Encode 14 | 15 | import Diff exposing (Change, diffLines) 16 | 17 | type alias HistoryItem model msg = 18 | { id : Id 19 | , msg : MsgLike msg 20 | , causedBy : Maybe Id 21 | , model : model 22 | , lazyMsgAst : Maybe (Result String ASTX) 23 | , lazyModelAst : Maybe (Result String ASTX) 24 | , lazyDiff : Maybe (List (Change String)) 25 | } 26 | 27 | 28 | type alias Model model msg = 29 | { future : List (HistoryItem model msg) 30 | , history : Nel (HistoryItem model msg) 31 | , filter : FilterOptions 32 | , sync : Bool 33 | , showModelDetail : Bool 34 | , expand : Bool 35 | , msgId : Id 36 | , selectedMsg : Maybe Id 37 | , showDiff : Bool 38 | , fixedToLeft : Bool 39 | , expandedTree : Set AST.ASTId 40 | , minimized : Bool 41 | , modelFilter : String 42 | , watch : Maybe AST.ASTId 43 | } 44 | 45 | type alias Id = Int 46 | 47 | type alias FilterOptions = 48 | List (String, Bool) 49 | 50 | type alias Settings = 51 | { fixedToLeft : Bool 52 | , filter : FilterOptions 53 | } 54 | 55 | type alias OutgoingMsg = 56 | { type_ : String 57 | , settings : String 58 | } 59 | 60 | type alias IncomingMsg = 61 | { type_ : String 62 | , settings : String 63 | } 64 | 65 | type Msg 66 | = ToggleSync 67 | | ToggleExpand 68 | | ToggleFilter String 69 | | SelectMsg Id 70 | | Resync 71 | | ToggleLayout 72 | | Receive IncomingMsg 73 | | ToggleModelDetail Bool 74 | | ToggleModelTree AST.ASTId 75 | | ToggleMinimize 76 | | InputModelFilter String 77 | | SelectModelFilter AST.ASTId 78 | | SelectModelFilterWatch AST.ASTId 79 | | StopWatching 80 | 81 | 82 | init : model -> Model model msg 83 | init model = 84 | { future = [] 85 | , history = Nel (initItem model) [] 86 | , filter = [] 87 | , sync = True 88 | , showModelDetail = True 89 | , expand = False 90 | , msgId = 1 91 | , selectedMsg = Nothing 92 | , showDiff = False 93 | , fixedToLeft = False 94 | , expandedTree = Set.empty 95 | , minimized = False 96 | , modelFilter = "" 97 | , watch = Nothing 98 | } 99 | 100 | 101 | initItem : model -> HistoryItem model msg 102 | initItem model = newItem 0 Init Nothing model 103 | 104 | 105 | newItem : Id -> MsgLike msg -> Maybe Id -> model -> HistoryItem model msg 106 | newItem id msg causedBy model = 107 | { id = id 108 | , msg = msg 109 | , causedBy = causedBy 110 | , model = model 111 | , lazyMsgAst = Nothing 112 | , lazyModelAst = Nothing 113 | , lazyDiff = Nothing 114 | } 115 | 116 | 117 | selectedItem : Model model msg -> Maybe (HistoryItem model msg) 118 | selectedItem model = 119 | case (model.sync, model.selectedMsg) of 120 | (True, _) -> 121 | Just <| Nel.head model.history 122 | 123 | (False, Nothing) -> 124 | Just <| Nel.head model.history 125 | 126 | (False, Just msgId) -> 127 | (Nel.find (\item -> item.id == msgId) model.history) 128 | 129 | 130 | updateOnIncomingUserMsg : 131 | ((Id, msg) -> parentMsg) 132 | -> (msg -> model -> (model, Cmd msg)) 133 | -> (Maybe Id, msg) 134 | -> Model model msg 135 | -> (Model model msg, Cmd parentMsg) 136 | updateOnIncomingUserMsg transformMsg update (causedBy, msg) model = 137 | let 138 | (Nel last past) = model.history 139 | 140 | (newRawUserModel, userCmd) = update msg last.model 141 | 142 | megLike = Message msg 143 | 144 | nextItem = newItem model.msgId megLike causedBy newRawUserModel 145 | in 146 | ( { model | 147 | filter = updateFilter megLike model.filter 148 | , msgId = model.msgId + 1 149 | , future = 150 | if not model.sync then 151 | nextItem :: model.future 152 | else 153 | model.future 154 | , history = 155 | if model.sync then 156 | Nel.cons nextItem model.history 157 | else 158 | model.history 159 | } |> selectFirstIfSync |> updateLazyAstForWatch 160 | ) 161 | ! [ Cmd.map transformMsg (Cmd.map ((,) model.msgId) userCmd) 162 | ] 163 | 164 | 165 | updateFilter : MsgLike msg -> FilterOptions -> FilterOptions 166 | updateFilter msgLike filterOptions = 167 | let 168 | str = 169 | case msgLike of 170 | Message msg -> toString msg 171 | Init -> "" -- doesn't count as a filter 172 | in 173 | case String.words str of 174 | head :: _ -> 175 | let 176 | exists = 177 | List.any (\(name, _) -> name == head) filterOptions 178 | in 179 | if exists then 180 | filterOptions 181 | else 182 | (head, True) :: filterOptions 183 | _ -> 184 | filterOptions 185 | 186 | 187 | futureToHistory : Model model msg -> Model model msg 188 | futureToHistory model = 189 | { model | 190 | future = [] 191 | , history = Nel.concat model.future model.history 192 | } 193 | 194 | 195 | -- TODO better not use for performance 196 | mapHistory : 197 | (HistoryItem model msg -> HistoryItem model msg) 198 | -> Model model msg 199 | -> Model model msg 200 | mapHistory f model = 201 | { model | 202 | history = Nel.map f model.history 203 | } 204 | 205 | 206 | updateLazyAst : Model model msg -> Model model msg 207 | updateLazyAst model = 208 | case model.selectedMsg of 209 | Just id -> 210 | mapHistory 211 | (\item -> 212 | if item.id == id || item.id == id - 1 then 213 | (updateLazyMsgAst << updateLazyModelAst) item 214 | else 215 | item 216 | ) 217 | model 218 | _ -> 219 | model 220 | 221 | 222 | updateLazyAstForWatch : Model model msg -> Model model msg 223 | updateLazyAstForWatch model = 224 | case (model.watch, (Nel.head model.history).id) of 225 | (Just _, id) -> 226 | mapHistory 227 | (\item -> 228 | if item.id == id then 229 | updateLazyModelAst item 230 | else 231 | item 232 | ) 233 | model 234 | _ -> 235 | model 236 | 237 | 238 | updateLazyMsgAst : HistoryItem model msg -> HistoryItem model msg 239 | updateLazyMsgAst item = 240 | { item | 241 | lazyMsgAst = 242 | if item.lazyMsgAst == Nothing then 243 | case item.msg of 244 | Message msg -> 245 | Just (Result.map (AST.attachId "@") <| Parser.parse (toString msg)) 246 | 247 | _ -> 248 | Just (Err "") 249 | else 250 | item.lazyMsgAst 251 | } 252 | 253 | 254 | updateLazyModelAst : HistoryItem model msg -> HistoryItem model msg 255 | updateLazyModelAst item = 256 | { item | 257 | lazyModelAst = 258 | if item.lazyModelAst == Nothing then 259 | Just (Result.map (AST.attachId "@") <| Parser.parse (toString item.model)) 260 | else 261 | item.lazyModelAst 262 | } 263 | 264 | 265 | updateLazyDiff : Model model msg -> Model model msg 266 | updateLazyDiff model = 267 | if model.showModelDetail then 268 | model 269 | else 270 | case model.selectedMsg of 271 | Just id -> 272 | mapHistory 273 | (\item -> 274 | if item.id == id then 275 | updateLazyDiffHelp model item 276 | else 277 | item 278 | ) 279 | model 280 | 281 | _ -> 282 | model 283 | 284 | 285 | updateLazyDiffHelp : Model model msg -> HistoryItem model msg -> HistoryItem model msg 286 | updateLazyDiffHelp model item = 287 | let 288 | newDiff = 289 | case item.lazyDiff of 290 | Just changes -> 291 | Just changes 292 | 293 | Nothing -> 294 | case selectedAndOldAst model of 295 | Just (oldAst, newAst) -> 296 | Just (makeChanges oldAst newAst) 297 | 298 | Nothing -> 299 | Nothing 300 | in 301 | { item | lazyDiff = newDiff } 302 | 303 | 304 | makeChanges : ASTX -> ASTX -> List (Change String) 305 | makeChanges oldAst newAst = 306 | if oldAst == newAst then -- strangily, its faster if they are equal 307 | [] 308 | else 309 | diffLines 310 | (Formatter.formatAsString (Formatter.makeModel oldAst)) 311 | (Formatter.formatAsString (Formatter.makeModel newAst)) 312 | 313 | 314 | selectedMsgAst : Model model msg -> Maybe ASTX 315 | selectedMsgAst model = 316 | case model.selectedMsg of 317 | Just id -> 318 | case Nel.findMap (\item -> if item.id == id then Just item.lazyMsgAst else Nothing ) model.history of 319 | Just (Just (Ok ast)) -> 320 | Just ast 321 | 322 | _ -> 323 | Nothing 324 | 325 | _ -> 326 | Nothing 327 | 328 | 329 | selectedAndOldAst : Model model msg -> Maybe (ASTX, ASTX) 330 | selectedAndOldAst model = 331 | case model.selectedMsg of 332 | Just id -> 333 | let 334 | newAndOld = 335 | Nel.findMapMany 2 336 | (\item -> 337 | if item.id == id || item.id == id - 1 then 338 | Just item.lazyModelAst 339 | else 340 | Nothing 341 | ) 342 | model.history 343 | in 344 | case newAndOld of 345 | Just (Ok newAst) :: Just (Ok oldAst) :: _ -> 346 | Just (oldAst, newAst) 347 | 348 | -- first 349 | Just (Ok ast) :: [] -> 350 | Just (ast, ast) 351 | 352 | _ -> 353 | Nothing 354 | _ -> 355 | Nothing 356 | 357 | 358 | selectFirstIfSync : Model model msg -> Model model msg 359 | selectFirstIfSync model = 360 | if model.sync then 361 | { model | 362 | selectedMsg = Just (Nel.head model.history).id 363 | } 364 | else 365 | model 366 | 367 | 368 | selectedMsgTree : Model model msg -> Maybe (RTree (HistoryItem model msg)) 369 | selectedMsgTree model = 370 | case model.selectedMsg of 371 | Just id -> 372 | case msgRootOf id model.history of 373 | Just root -> 374 | let 375 | f item tree = 376 | RTree.addChildAt (\i -> item.causedBy == Just i.id) item tree 377 | in 378 | Just <| 379 | RTree.sortEachBranchBy (\item -> item.id) <| 380 | List.foldr f (RTree.singleton root) (Nel.toList model.history) 381 | 382 | Nothing -> 383 | Nothing 384 | 385 | _ -> 386 | Nothing 387 | 388 | 389 | msgRootOf : Id -> Nel (HistoryItem model msg) -> Maybe (HistoryItem model msg) 390 | msgRootOf id history = 391 | case Nel.find (\item -> item.id == id) history of 392 | Just item -> 393 | case item.causedBy of 394 | Just id -> msgRootOf id history 395 | Nothing -> Just item 396 | 397 | Nothing -> 398 | Nothing 399 | 400 | 401 | settingsDecoder : Decoder Settings 402 | settingsDecoder = 403 | Decode.map2 404 | Settings 405 | (field "fixedToLeft" Decode.bool) 406 | (field "filter" <| Decode.list (Decode.map2 (,) (Decode.index 0 Decode.string) (Decode.index 1 Decode.bool))) 407 | 408 | 409 | encodeSetting : Settings -> String 410 | encodeSetting settings = 411 | Encode.encode 0 <| 412 | Encode.object 413 | [ ("fixedToLeft", Encode.bool settings.fixedToLeft) 414 | , ("filter" 415 | , Encode.list <| 416 | List.map 417 | (\(key, value) -> Encode.list [ Encode.string key, Encode.bool value] ) 418 | settings.filter 419 | ) 420 | ] 421 | 422 | 423 | saveSetting : (OutgoingMsg -> Cmd Never) -> Model model msg -> Cmd Msg 424 | saveSetting save model = 425 | Cmd.map 426 | never 427 | ( save <| 428 | { type_ = "save" 429 | , settings = encodeSetting { fixedToLeft = model.fixedToLeft, filter = model.filter } 430 | } 431 | ) 432 | 433 | 434 | decodeSettings : String -> Result String Settings 435 | decodeSettings = 436 | Decode.decodeString settingsDecoder 437 | 438 | -- 439 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/MsgLike.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.MsgLike exposing (..) 2 | 3 | 4 | type MsgLike msg 5 | = Message msg 6 | | Init 7 | 8 | 9 | format : MsgLike msg -> String 10 | format msgLike = 11 | case msgLike of 12 | Message m -> toString m 13 | Init -> "[Init]" 14 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/MsgTreeView.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.MsgTreeView exposing (view) 2 | 3 | import TimeTravel.Internal.Styles as S 4 | import TimeTravel.Internal.Util.RTree exposing (RTree(..)) 5 | import TimeTravel.Internal.Model exposing (HistoryItem, Id) 6 | import TimeTravel.Internal.MsgLike as MsgLike 7 | 8 | import Html exposing (..) 9 | import Html.Attributes exposing (..) 10 | import Html.Events exposing (..) 11 | 12 | import Diff exposing (..) 13 | 14 | import InlineHover exposing (hover) 15 | 16 | 17 | view : (Id -> m) -> Id -> RTree (HistoryItem model msg) -> Html m 18 | view onSelect selectedMsg tree = 19 | div 20 | [ style S.msgTreeView ] 21 | (viewTree onSelect 0 selectedMsg tree) 22 | 23 | 24 | viewTree : (Id -> m) -> Int -> Int -> RTree (HistoryItem model msg) -> List (Html m) 25 | viewTree onSelect indent selectedMsg (Node item list) = 26 | itemRow onSelect indent selectedMsg item :: 27 | List.concatMap (viewTree onSelect (indent + 1) selectedMsg) list 28 | 29 | 30 | itemRow : (Id -> m) -> Int -> Int -> HistoryItem model msg -> Html m 31 | itemRow onSelect indent selectedMsg item = 32 | hover 33 | (S.msgTreeViewItemRowHover (selectedMsg == item.id)) 34 | div 35 | [ style (S.msgTreeViewItemRow (selectedMsg == item.id)) 36 | , onClick (onSelect item.id) 37 | ] 38 | [ text (String.repeat indent " " ++ toString item.id ++ ": " ++ MsgLike.format item.msg) ] 39 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Parser/AST.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Parser.AST exposing (..) 2 | 3 | 4 | type AST 5 | = Record (List AST) 6 | | StringLiteral String 7 | | ListLiteral (List AST) 8 | | TupleLiteral (List AST) 9 | | Value String 10 | | Union String (List AST) 11 | | Property String AST 12 | 13 | 14 | type alias ASTId = String 15 | 16 | 17 | type ASTX 18 | = RecordX ASTId (List ASTX) 19 | | StringLiteralX ASTId String 20 | | ListLiteralX ASTId (List ASTX) 21 | | TupleLiteralX ASTId (List ASTX) 22 | | ValueX ASTId String 23 | | UnionX ASTId String (List ASTX) 24 | | PropertyX ASTId String ASTX 25 | 26 | 27 | attachId : String -> AST -> ASTX 28 | attachId id ast = 29 | case ast of 30 | Record children -> 31 | RecordX id (attachIdToList id children) 32 | 33 | StringLiteral s -> 34 | StringLiteralX id s 35 | 36 | ListLiteral children -> 37 | ListLiteralX id (attachIdToListWithIndex id children) 38 | 39 | TupleLiteral children -> 40 | case children of 41 | -- don't count (x) as tupple 42 | [x] -> 43 | TupleLiteralX id (attachIdToList id children) 44 | _ -> 45 | TupleLiteralX id (attachIdToListWithIndex id children) 46 | 47 | Value s -> 48 | ValueX id s 49 | 50 | Union tag children -> 51 | let 52 | id_ = id ++ "." ++ tag 53 | in 54 | UnionX id_ tag (attachIdToListWithIndex id_ children) 55 | 56 | Property key value -> 57 | let 58 | id_ = id ++ "." ++ key 59 | in 60 | PropertyX id_ key (attachId id_ value) 61 | 62 | 63 | attachIdToList : String -> List AST -> List ASTX 64 | attachIdToList id list = 65 | List.map (attachId id) list 66 | 67 | 68 | attachIdToListWithIndex : String -> List AST -> List ASTX 69 | attachIdToListWithIndex id list = 70 | List.indexedMap (\index p -> 71 | attachId (id ++ "." ++ toString index) p 72 | ) list 73 | 74 | 75 | filterById : String -> ASTX -> List (ASTId, ASTX) 76 | filterById s ast = 77 | case ast of 78 | RecordX id children -> 79 | if match s id then 80 | [ (id, ast) ] 81 | else 82 | List.concatMap (filterById s) children 83 | 84 | StringLiteralX id v -> 85 | if match s id then 86 | [ (id, ast) ] 87 | else 88 | [] 89 | 90 | ListLiteralX id children -> 91 | if match s id then 92 | [ (id, ast) ] 93 | else 94 | List.concatMap (filterById s) children 95 | 96 | TupleLiteralX id children -> 97 | if match s id then 98 | [ (id, ast) ] 99 | else 100 | List.concatMap (filterById s) children 101 | 102 | ValueX id v -> 103 | if match s id then 104 | [ (id, ast) ] 105 | else 106 | [] 107 | 108 | UnionX id tag children -> 109 | if match s id then 110 | [ (id, ast) ] 111 | else 112 | List.concatMap (filterById s) children 113 | 114 | PropertyX id key value -> 115 | if match s id then 116 | [ (id, ast) ] 117 | else 118 | filterById s value 119 | 120 | 121 | match : String -> String -> Bool 122 | match s id = 123 | String.contains (String.toLower s) (String.toLower id) 124 | 125 | 126 | filterByExactId : String -> ASTX -> Maybe ASTX 127 | filterByExactId s ast = 128 | case ast of 129 | RecordX id children -> 130 | if s == id then 131 | Just ast 132 | else if String.length s < String.length id then 133 | Nothing 134 | else 135 | filterByExactIdForList s children 136 | 137 | StringLiteralX id v -> 138 | if s == id then 139 | Just ast 140 | else 141 | Nothing 142 | 143 | ListLiteralX id children -> 144 | if s == id then 145 | Just ast 146 | else if String.length s < String.length id then 147 | Nothing 148 | else 149 | filterByExactIdForList s children 150 | 151 | TupleLiteralX id children -> 152 | if s == id then 153 | Just ast 154 | else if String.length s < String.length id then 155 | Nothing 156 | else 157 | filterByExactIdForList s children 158 | 159 | ValueX id v -> 160 | if s == id then 161 | Just ast 162 | else 163 | Nothing 164 | 165 | UnionX id tag children -> 166 | if s == id then 167 | Just ast 168 | else if String.length s < String.length id then 169 | Nothing 170 | else 171 | filterByExactIdForList s children 172 | 173 | PropertyX id key value -> 174 | if s == id then 175 | Just ast 176 | else if String.length s < String.length id then 177 | Nothing 178 | else 179 | filterByExactId s value 180 | 181 | 182 | filterByExactIdForList : String -> List ASTX -> Maybe ASTX 183 | filterByExactIdForList s list = 184 | case list of 185 | [] -> 186 | Nothing 187 | 188 | ast :: tail -> 189 | case filterByExactId s ast of 190 | Nothing -> 191 | filterByExactIdForList s tail 192 | 193 | found -> 194 | found 195 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Parser/Formatter.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Parser.Formatter exposing (..) 2 | 3 | import Set exposing (Set) 4 | import Html exposing (..) 5 | import Html.Attributes exposing (..) 6 | import Html.Events exposing (..) 7 | 8 | import TimeTravel.Internal.Styles as S 9 | import TimeTravel.Internal.Parser.AST as AST exposing (..) 10 | 11 | import InlineHover exposing (hover) 12 | 13 | 14 | type alias Context = 15 | { nest : Int 16 | , parens : Bool 17 | , wordsLimit : Int 18 | } 19 | 20 | 21 | type FormatModel 22 | = Plain String 23 | | Link AST.ASTId String 24 | | Listed (List FormatModel) 25 | | Long AST.ASTId String (List FormatModel) 26 | 27 | 28 | makeModel : ASTX -> FormatModel 29 | makeModel = 30 | makeModelWithContext { nest = 0, parens = False, wordsLimit = 40 } 31 | 32 | 33 | makeModelWithContext : Context -> ASTX -> FormatModel 34 | makeModelWithContext c ast = 35 | case ast of 36 | RecordX id properties -> 37 | makeModelFromListLike True id (indent c) c.wordsLimit "{" "}" (List.map (makeModelWithContext { c | nest = c.nest + 1 }) properties) 38 | 39 | PropertyX id key value -> 40 | let 41 | s = makeModelWithContext { c | parens = False, nest = c.nest + 1 } value 42 | str = formatAsString s 43 | in 44 | Listed <| 45 | (Link id key) :: 46 | Plain " = " :: 47 | ( if String.contains "\n" str || String.length (key ++ " = " ++ str) > c.wordsLimit then -- TODO not correct 48 | [ Plain ("\n" ++ indent { c | nest = c.nest + 1 }), s ] 49 | else [s] 50 | ) 51 | 52 | StringLiteralX id s -> 53 | Plain <| "\"" ++ s ++ "\"" 54 | 55 | ValueX id s -> 56 | Plain s 57 | 58 | UnionX id tag tail -> 59 | let 60 | tailX = 61 | List.map (makeModelWithContext { c | nest = c.nest + 1, parens = True }) tail 62 | 63 | joinedTailStr = 64 | formatAsString (Listed tailX) 65 | 66 | multiLine = 67 | String.contains "\n" joinedTailStr || String.length (tag ++ joinedTailStr) > c.wordsLimit -- TODO not correct 68 | 69 | s = 70 | Listed <| 71 | if multiLine then 72 | Plain (tag ++ "\n" ++ indent { c | nest = c.nest + 1 }) :: joinX ("\n" ++ indent { c | nest = c.nest + 1 }) tailX 73 | else 74 | joinX " " (Plain tag :: tailX) 75 | in 76 | if (not (List.isEmpty tail)) && c.parens then 77 | Listed [ Plain "(", s, Plain (if multiLine then ("\n" ++ indent c ++ ")") else ")") ] 78 | else 79 | s 80 | 81 | ListLiteralX id list -> 82 | makeModelFromListLike True id (indent c) c.wordsLimit "[" "]" (List.map (makeModelWithContext { c | parens = False, nest = c.nest + 1 }) list) 83 | 84 | TupleLiteralX id list -> 85 | makeModelFromListLike False id (indent c) c.wordsLimit "(" ")" (List.map (makeModelWithContext { c | parens = False, nest = c.nest + 1 }) list) 86 | 87 | 88 | makeModelFromListLike : Bool -> AST.ASTId -> String -> Int -> String -> String -> List FormatModel -> FormatModel 89 | makeModelFromListLike canFold id indent wordsLimit start end list = 90 | case list of 91 | [] -> 92 | Plain <| start ++ end 93 | 94 | _ -> 95 | let 96 | singleLine = 97 | Listed <| Plain (start ++ " ") :: ((joinX ", " list) ++ [ Plain <| " " ++ end ]) 98 | 99 | singleLineStr = 100 | formatAsString singleLine 101 | 102 | long = 103 | String.length singleLineStr > wordsLimit || String.contains "\n" singleLineStr 104 | in 105 | if (indent /= "" && canFold) && long then 106 | Long id (start ++ " .. " ++ end) 107 | ( Plain (start ++ " ") :: ((joinX ("\n" ++ indent ++ ", ") list) ++ [Plain <| "\n" ++ indent] ++ [ Plain end ]) 108 | ) 109 | else if long then 110 | Listed ( Plain (start ++ " ") :: ((joinX ("\n" ++ indent ++ ", ") list) ++ [Plain <| "\n" ++ indent] ++ [ Plain end ]) 111 | ) 112 | else 113 | singleLine 114 | 115 | 116 | indent : Context -> String 117 | indent context = 118 | String.repeat context.nest " " 119 | 120 | 121 | joinX : String -> List FormatModel -> List FormatModel 122 | joinX s list = 123 | case list of 124 | [] -> [] 125 | [head] -> [head] 126 | head :: tail -> head :: Plain s :: joinX s tail 127 | 128 | 129 | formatAsString : FormatModel -> String 130 | formatAsString model = 131 | formatHelp 132 | identity 133 | (\_ s -> s) 134 | (String.join "" << List.map formatAsString) 135 | (\_ _ children -> String.join "" <| List.map formatAsString children) 136 | model 137 | 138 | 139 | formatAsHtml : (AST.ASTId -> msg) -> (AST.ASTId -> msg) -> Set AST.ASTId -> FormatModel -> List (Html msg) 140 | formatAsHtml selectFilterMsg toggleMsg expandedTree model = 141 | formatHelp 142 | formatPlainAsHtml 143 | (formatLinkAsHtml selectFilterMsg) 144 | (\list -> List.concatMap (formatAsHtml selectFilterMsg toggleMsg expandedTree) list) 145 | (\id alt children -> 146 | if Set.member id expandedTree then 147 | span 148 | [ style S.modelDetailFlagmentToggleExpand 149 | , onClick (toggleMsg id) 150 | ] 151 | [ text " - " ] 152 | :: List.concatMap (formatAsHtml selectFilterMsg toggleMsg expandedTree) children 153 | else 154 | [ span 155 | [ style S.modelDetailFlagmentToggle 156 | , onClick (toggleMsg id) 157 | ] 158 | [ text alt ] 159 | ] 160 | ) model 161 | 162 | 163 | formatPlainAsHtml : String -> List (Html msg) 164 | formatPlainAsHtml s = 165 | [ span 166 | ( [ style S.modelDetailFlagment ] ++ 167 | if String.startsWith "\"" s then [ title s ] else [] 168 | ) 169 | [ text s ] 170 | ] 171 | 172 | 173 | formatLinkAsHtml : (AST.ASTId -> msg) -> AST.ASTId -> String -> List (Html msg) 174 | formatLinkAsHtml selectFilterMsg id s = 175 | [ hover 176 | S.modelDetailFlagmentLinkHover 177 | span 178 | [ style S.modelDetailFlagmentLink 179 | , onClick (selectFilterMsg id) 180 | ] 181 | [ text s ] 182 | ] 183 | 184 | 185 | formatHelp 186 | : (String -> a) 187 | -> (AST.ASTId -> String -> a) 188 | -> (List FormatModel -> a) 189 | -> (AST.ASTId -> String -> List FormatModel -> a) 190 | -> FormatModel -> a 191 | formatHelp formatPlain formatLink formatListed formatLong model = 192 | case model of 193 | Plain s -> 194 | formatPlain s 195 | 196 | Link id s -> 197 | formatLink id s 198 | 199 | Listed list -> 200 | formatListed list 201 | 202 | Long id alt s -> 203 | formatLong id alt s 204 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Parser/Parser.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Parser.Parser exposing (..) 2 | 3 | 4 | import Char 5 | import Combine exposing (..) 6 | import Combine.Num exposing (int, float) 7 | import TimeTravel.Internal.Parser.AST exposing (..) 8 | import TimeTravel.Internal.Parser.Util exposing (..) 9 | 10 | 11 | parse : String -> Result String AST 12 | parse s = 13 | case Combine.parse (spaced expression) s of 14 | Ok (_, _, ast) -> 15 | Ok ast 16 | 17 | Err (_, _, errors) -> 18 | Err (String.join "," errors) 19 | 20 | 21 | ---- 22 | 23 | expression : Parser s AST 24 | expression = 25 | lazy (\_ -> 26 | union <|> 27 | expressionWithoutUnion 28 | ) 29 | 30 | 31 | expressionWithoutUnion : Parser s AST 32 | expressionWithoutUnion = 33 | lazy (\_ -> 34 | record <|> 35 | listLiteral <|> 36 | tupleLiteral <|> 37 | internalStructure <|> 38 | stringLiteral <|> 39 | numberLiteral <|> 40 | null 41 | ) 42 | 43 | 44 | stringLiteral : Parser s AST 45 | stringLiteral = 46 | map StringLiteral <| 47 | between (string "\"") (string "\"") (regex """(\\\\"|[^"])*""") 48 | 49 | 50 | numberLiteral : Parser s AST 51 | numberLiteral = 52 | map Value (regex "(\\-)?[0-9][0-9.]*") 53 | 54 | 55 | internalStructure : Parser s AST 56 | internalStructure = 57 | map Value (regex "<[^>]*>") 58 | 59 | 60 | null : Parser s AST 61 | null = 62 | map Value (regex "[a-z]+") 63 | 64 | 65 | tupleLiteral : Parser s AST 66 | tupleLiteral = 67 | lazy (\_ -> 68 | map TupleLiteral <| parens items 69 | ) 70 | 71 | 72 | listLiteral : Parser s AST 73 | listLiteral = 74 | lazy (\_ -> 75 | map ListLiteral <| brackets items 76 | ) 77 | 78 | 79 | items : Parser s (List AST) 80 | items = 81 | lazy (\_ -> 82 | spaced (sepBy comma (spaced expression)) 83 | ) 84 | 85 | 86 | union : Parser s AST 87 | union = 88 | lazy (\_ -> 89 | (\tag tail -> Union tag tail) 90 | <$> tag 91 | <*> many unionParam 92 | ) 93 | 94 | 95 | -- assuming things like `True 1` never come (effective, but unsafe) 96 | -- union : Parser AST 97 | -- union = 98 | -- rec (\_ -> 99 | -- tag `andThen` \s -> 100 | -- if s == "True" || s == "False" || s == "Nothing" then 101 | -- succeed (Union s []) 102 | -- else if s == "Just" || s == "Ok" || s == "Err" then 103 | -- (\param -> Union s [param]) `map` unionParam 104 | -- else 105 | -- (\tail -> Union s tail) `map` many unionParam 106 | -- ) 107 | 108 | 109 | singleUnion : Parser s AST 110 | singleUnion = 111 | lazy (\_ -> 112 | map (\tag -> Union tag []) tag 113 | ) 114 | 115 | 116 | unionParam : Parser s AST 117 | unionParam = 118 | lazy (\_ -> 119 | (\_ exp -> exp) 120 | <$> spaces 121 | <*> (singleUnion <|> expressionWithoutUnion) 122 | ) 123 | 124 | 125 | tag : Parser s String 126 | tag = 127 | regex "[A-Z][a-zA-Z0-9_.]*" 128 | 129 | 130 | record : Parser s AST 131 | record = 132 | lazy (\_ -> 133 | map Record <| braces properties 134 | ) 135 | 136 | 137 | properties : Parser s (List AST) 138 | properties = 139 | lazy (\_ -> 140 | spaced (sepBy comma property) 141 | ) 142 | 143 | 144 | propertyKey : Parser s String 145 | propertyKey = 146 | regex "[^ ]+" 147 | 148 | 149 | property : Parser s AST 150 | property = 151 | lazy (\_ -> 152 | (\_ key _ _ _ value _ -> Property key value) 153 | <$> spaces 154 | <*> propertyKey 155 | <*> spaces 156 | <*> equal 157 | <*> spaces 158 | <*> expression 159 | <*> spaces 160 | ) 161 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Parser/Util.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Parser.Util exposing (..) 2 | 3 | import Combine exposing (Parser, between, regex, string) 4 | 5 | 6 | spaced : Parser s a -> Parser s a 7 | spaced p = 8 | between spaces spaces p 9 | 10 | 11 | spaces : Parser s String 12 | spaces = regex "[ ]*" 13 | 14 | 15 | comma : Parser s String 16 | comma = string "," 17 | 18 | 19 | equal : Parser s String 20 | equal = string "=" 21 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Styles.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Styles exposing (..) 2 | 3 | 4 | zIndex = { modelDetailView = "2147483646", debugView = "2147483646", resyncView = "2147483645" } 5 | 6 | 7 | darkTextColor = "#999" 8 | 9 | 10 | textLinkHover : List (String, String) 11 | textLinkHover = 12 | [ ("text-decoration", "underline") ] 13 | 14 | 15 | button : List (String, String) 16 | button = 17 | [ ("padding", "10px") 18 | , ("border", "solid 1px #666") 19 | , ("border-radius", "3px") 20 | , ("cursor", "pointer") 21 | ] 22 | 23 | 24 | buttonHover : List (String, String) 25 | buttonHover = 26 | [ ("background-color", "#555") 27 | ] 28 | 29 | 30 | pointer : List (String, String) 31 | pointer = 32 | [ ("cursor", "pointer") ] 33 | 34 | 35 | iconButton : List (String, String) 36 | iconButton = 37 | [ ("padding", "10px 10px 6px 10px") -- workaround 38 | , ("border", "solid 1px #666") 39 | , ("border-radius", "3px") 40 | ] ++ pointer 41 | 42 | 43 | buttonView : Bool -> List (String, String) 44 | buttonView left = 45 | (if left then [("margin-right", "auto")] else [ ("margin-left", "auto")]) 46 | ++ iconButton 47 | 48 | 49 | panel : Bool -> List (String, String) 50 | panel visible = 51 | [ ("padding", if visible then "20px" else "0 20px") 52 | , ("overflow", "hidden") 53 | ] 54 | 55 | 56 | panelBorder : List (String, String) 57 | panelBorder = 58 | [ ("border-bottom", "solid 1px #666") 59 | ] 60 | 61 | 62 | debugViewTheme : List (String, String) 63 | debugViewTheme = 64 | [ ("background-color", "#444") 65 | , ("color", "#eee") 66 | , ("font-family", "calibri, helvetica, arial, sans-serif") 67 | , ("font-size", "14px") 68 | ] 69 | 70 | 71 | debugView : Bool -> List (String, String) 72 | debugView fixedToLeft = 73 | [ ("position", "fixed") 74 | , ("width", "250px") 75 | , ("top", "0") 76 | , (if fixedToLeft then "left" else "right", "0") 77 | , ("bottom", "0") 78 | , ("z-index", zIndex.debugView) 79 | ] ++ debugViewTheme 80 | 81 | 82 | filterView : Bool -> List (String, String) 83 | filterView visible = 84 | [ ("background-color", "#333") 85 | , ("transition", "height ease 0.3s, padding ease 0.3s") 86 | , ("height", if visible then "" else "0") 87 | ] 88 | ++ panelBorder ++ panel visible 89 | 90 | 91 | headerView : List (String, String) 92 | headerView = 93 | [ ("display", "flex") 94 | , ("justify-content", "flex-end") 95 | ] ++ panel True 96 | 97 | 98 | minimizedButton : Bool -> List (String, String) 99 | minimizedButton fixedToLeft = 100 | [ ("position", "fixed") 101 | , ("bottom", "0") 102 | , (if fixedToLeft then "left" else "right", "0") 103 | , ("z-index", zIndex.debugView) 104 | ] ++ iconButton ++ debugViewTheme 105 | 106 | 107 | modelViewContainer : List (String, String) 108 | modelViewContainer = 109 | [] 110 | 111 | 112 | modelView : List (String, String) 113 | modelView = 114 | [ ("height", "150px") 115 | , ("box-sizing", "border-box") 116 | ] 117 | ++ panelBorder ++ panel True 118 | 119 | 120 | modelFilterInput : List (String, String) 121 | modelFilterInput = 122 | [ ("display", "block") 123 | , ("width", "100%") 124 | , ("padding", "5px 10px") 125 | , ("background-color", "rgba(0,0,0,0.2)") 126 | , ("margin-bottom", "10px") 127 | , ("border", "none") 128 | , ("box-shadow", "2px 1px 7px 0px rgba(0,0,0,0.4) inset") 129 | , ("color", "#eee") 130 | , ("font-size", "14px") 131 | , ("width", "100%") 132 | , ("box-sizing", "border-box") 133 | ] 134 | 135 | 136 | modelDetailTreeEachId : List (String, String) 137 | modelDetailTreeEachId = 138 | [ ("color", darkTextColor) 139 | , ("cursor", "pointer") 140 | ] 141 | 142 | 143 | modelDetailTreeEachIdHover : List (String, String) 144 | modelDetailTreeEachIdHover = 145 | textLinkHover 146 | 147 | 148 | modelDetailTreeEachIdWatch : List (String, String) 149 | modelDetailTreeEachIdWatch = 150 | modelDetailTreeEachId 151 | 152 | 153 | modelDetailTreeEachIdWatchHover : List (String, String) 154 | modelDetailTreeEachIdWatchHover = 155 | modelDetailTreeEachIdHover 156 | 157 | 158 | modelDetailTreeEach : List (String, String) 159 | modelDetailTreeEach = 160 | [ ("margin-bottom", "20px") ] 161 | 162 | 163 | modelDetailView : Bool -> List (String, String) 164 | modelDetailView fixedToLeft = 165 | [ ("width", "320px") 166 | , ("z-index", zIndex.modelDetailView) 167 | , ("box-sizing", "border-box") 168 | , ("height", "100%") 169 | , ("overflow-y", "scroll") 170 | ] ++ --panel True 171 | [ ("padding", "20px") 172 | , ("overflow-x", "hidden") 173 | , ("overflow-y", "scroll") 174 | ] 175 | 176 | 177 | modelDetailFlagment : List (String, String) 178 | modelDetailFlagment = 179 | [ ("white-space", "pre") 180 | , ("display", "inline") 181 | ] 182 | 183 | 184 | modelDetailFlagmentLink : List (String, String) 185 | modelDetailFlagmentLink = 186 | [("cursor", "pointer")] ++ modelDetailFlagment 187 | 188 | 189 | modelDetailFlagmentLinkHover : List (String, String) 190 | modelDetailFlagmentLinkHover = 191 | textLinkHover 192 | 193 | 194 | modelDetailFlagmentToggle : List (String, String) 195 | modelDetailFlagmentToggle = 196 | [ ("white-space", "pre") 197 | , ("display", "inline") 198 | , ("background-color", "#777") 199 | , ("cursor", "pointer") 200 | ] 201 | 202 | 203 | modelDetailFlagmentToggleExpand : List (String, String) 204 | modelDetailFlagmentToggleExpand = 205 | [ ("position", "relative") 206 | , ("left", "-16px") 207 | , ("margin-right", "-14px") 208 | ] ++ modelDetailFlagmentToggle 209 | 210 | 211 | watchView : List (String, String) 212 | watchView = 213 | [ ("position", "relative") 214 | ] ++ panel True ++ panelBorder 215 | 216 | 217 | watchViewHeader : List (String, String) 218 | watchViewHeader = 219 | [ ("color", darkTextColor) 220 | ] 221 | 222 | 223 | stopWatchingButton : List (String, String) 224 | stopWatchingButton = 225 | [ ("position", "absolute") 226 | , ("right", "20px") 227 | , ("top", "20px") 228 | , ("cursor", "pointer") 229 | ] 230 | 231 | 232 | stopWatchingButtonHover : List (String, String) 233 | stopWatchingButtonHover = 234 | [ ("opacity", "0.5") ] 235 | 236 | 237 | msgListView : List (String, String) 238 | msgListView = 239 | panel True 240 | 241 | 242 | itemBackground : Bool -> List (String, String) 243 | itemBackground selected = 244 | [ ("background-color", if selected then "rgba(0, 0, 0, 0.5)" else "") 245 | ] 246 | 247 | 248 | msgViewHover : Bool -> List (String, String) 249 | msgViewHover selected = 250 | if selected then [] else [ ("background-color", "#555") ] 251 | 252 | 253 | msgView : Bool -> List (String, String) 254 | msgView selected = 255 | [ ("white-space", "nowrap") 256 | , ("text-overflow", "ellipsis") 257 | , ("overflow", "hidden") 258 | ] 259 | ++ itemBackground selected ++ pointer 260 | 261 | 262 | resyncView : Bool -> List (String, String) 263 | resyncView sync = 264 | [ ("z-index", zIndex.resyncView) 265 | , ("position", "fixed") 266 | , ("top", "0") 267 | , ("bottom", "0") 268 | , ("left", "0") 269 | , ("right", "0") 270 | , ("background-color", "rgba(0, 0, 0, 0.15)") 271 | , ("opacity", if sync then "0" else "1") 272 | , ("pointer-events", if sync then "none" else "") 273 | , ("transition", "opacity ease 0.5s") 274 | ] 275 | 276 | 277 | subPain : Bool -> List (String, String) 278 | subPain fixedToLeft = 279 | [ ( "box-shadow" 280 | , if fixedToLeft then 281 | "rgba(0, 0, 0, 0.15) 6px -3px 6px inset" 282 | else 283 | "rgba(0, 0, 0, 0.15) -6px -3px 6px inset") 284 | ] 285 | 286 | 287 | detailView : Bool -> Bool -> List (String, String) 288 | detailView fixedToLeft opened = 289 | [ ("position", "absolute") 290 | , ("width", "320px") 291 | , (if fixedToLeft then "right" else "left", "-320px") 292 | , ("box-sizing", "border-box") 293 | , ("height", "calc(100% - 87px)") 294 | ] ++ subPain fixedToLeft ++ debugViewTheme 295 | 296 | 297 | msgTreeView : List (String, String) 298 | msgTreeView = 299 | panel True ++ panelBorder 300 | 301 | 302 | detailedMsgView : List (String, String) 303 | detailedMsgView = 304 | [ ("white-space", "pre") ] ++ panel True ++ panelBorder 305 | 306 | 307 | msgTreeViewItemRow : Bool -> List (String, String) 308 | msgTreeViewItemRow selected = 309 | [ ("white-space", "pre") 310 | , ("text-overflow", "ellipsis") 311 | , ("overflow", "hidden") 312 | ] 313 | ++ itemBackground selected ++ pointer 314 | 315 | 316 | msgTreeViewItemRowHover : Bool -> List (String, String) 317 | msgTreeViewItemRowHover selected = 318 | if selected then [] else [ ("background-color", "#555") ] 319 | 320 | 321 | diffView : List (String, String) 322 | diffView = 323 | panel True 324 | 325 | 326 | lineBase : List (String, String) 327 | lineBase = 328 | [ ("padding-left", "10px") 329 | , ("white-space", "pre") 330 | ] 331 | 332 | 333 | omittedLine : List (String, String) 334 | omittedLine = 335 | lineBase 336 | 337 | 338 | normalLine : List (String, String) 339 | normalLine = 340 | lineBase 341 | 342 | 343 | deletedLine : List (String, String) 344 | deletedLine = 345 | [ ("background-color", "rgba(255, 100, 100, 0.15)") 346 | ] ++ lineBase 347 | 348 | 349 | addedLine : List (String, String) 350 | addedLine = 351 | [ ("background-color", "rgba(100, 255, 100, 0.15)") 352 | ] ++ lineBase 353 | 354 | 355 | diffOrModelDetailViewContainer : List (String, String) 356 | diffOrModelDetailViewContainer = 357 | [ ("position", "relative") 358 | ] 359 | 360 | 361 | toggleModelDetailIcon : List (String, String) 362 | toggleModelDetailIcon = 363 | [ ("right", "20px") 364 | , ("top", "20px") 365 | , ("position", "absolute") 366 | ] ++ iconButton ++ debugViewTheme 367 | 368 | subHeaderView : List (String, String) 369 | subHeaderView = 370 | headerView ++ panelBorder 371 | 372 | 373 | detailViewHead : List (String, String) 374 | detailViewHead = 375 | [] 376 | 377 | 378 | detailTab : Bool -> List (String, String) 379 | detailTab active = 380 | [ ("border-radius", "3px 3px 0 0") 381 | , ("height", "30px") 382 | , ("top", "-30px") 383 | , ("cursor", "pointer") 384 | , ("position", "absolute") 385 | , ("text-align", "center") 386 | , ("line-height", "30px") 387 | ] ++ 388 | ( if active then 389 | [] 390 | else 391 | [ ("box-shadow", "rgba(0, 0, 0, 0.25) 0px -1px 5px inset") ] 392 | ) ++ debugViewTheme 393 | 394 | 395 | detailTabHover : List (String, String) 396 | detailTabHover = 397 | [ ("background-color", "#555") 398 | ] 399 | 400 | 401 | detailTabModel : Bool -> Bool -> List (String, String) 402 | detailTabModel fixedToLeft active = 403 | [ ("width", "130px") 404 | , ("left", if fixedToLeft then "10px" else "0") 405 | ] ++ detailTab active 406 | 407 | 408 | detailTabDiff : Bool -> Bool -> List (String, String) 409 | detailTabDiff fixedToLeft active = 410 | [ ("width", "170px") 411 | , ("left", if fixedToLeft then "150px" else "140px") 412 | ] ++ detailTab active 413 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Update.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Update exposing (update, updateAfterUserMsg) 2 | 3 | import TimeTravel.Internal.Model exposing (..) 4 | import TimeTravel.Internal.Util.Nel as Nel exposing (..) 5 | import Set exposing (Set) 6 | 7 | update : (OutgoingMsg -> Cmd Never) -> Msg -> Model model msg -> (Model model msg, Cmd Msg) 8 | update save message model = 9 | case message of 10 | Receive incomingMsg -> 11 | if incomingMsg.type_ == "load" then 12 | case decodeSettings incomingMsg.settings of 13 | Ok { fixedToLeft, filter } -> 14 | { model | fixedToLeft = fixedToLeft, filter = filter } ! [] 15 | 16 | Err _ -> 17 | model ! [] |> Debug.log "err decoding" 18 | else 19 | model ! [] 20 | 21 | ToggleSync -> 22 | let 23 | nextSync = not model.sync 24 | newModel = 25 | { model | 26 | selectedMsg = 27 | if nextSync then 28 | Nothing 29 | else 30 | model.selectedMsg 31 | , sync = nextSync 32 | , showModelDetail = False 33 | } 34 | |> selectFirstIfSync 35 | |> if nextSync then futureToHistory else identity 36 | in 37 | newModel ! [] 38 | 39 | ToggleExpand -> 40 | let 41 | newModel = 42 | { model | expand = not model.expand } 43 | in 44 | newModel ! [] 45 | 46 | ToggleFilter name -> 47 | let 48 | newModel = 49 | { model | 50 | filter = 51 | List.map 52 | (\(name_, visible) -> 53 | if name == name_ then 54 | (name_, not visible) 55 | else 56 | (name_, visible) 57 | ) 58 | model.filter 59 | } 60 | in 61 | newModel ! [ saveSetting save newModel ] 62 | 63 | SelectMsg id -> 64 | let 65 | newModel = 66 | { model | 67 | selectedMsg = Just id 68 | , sync = False 69 | } |> updateLazyAst |> updateLazyDiff 70 | in 71 | newModel ! [] 72 | 73 | Resync -> 74 | let 75 | newModel = 76 | { model | 77 | sync = True 78 | } |> selectFirstIfSync |> futureToHistory 79 | in 80 | newModel ! [] 81 | 82 | ToggleLayout -> 83 | let 84 | newModel = 85 | { model | 86 | fixedToLeft = not (model.fixedToLeft) 87 | } 88 | in 89 | newModel ! [ saveSetting save newModel ] 90 | 91 | ToggleModelDetail showModelDetail -> 92 | ( { model | 93 | showModelDetail = showModelDetail 94 | } 95 | |> updateLazyDiff 96 | ) ! [] 97 | 98 | ToggleModelTree id -> 99 | { model | expandedTree = toggleSet id model.expandedTree } ! [] 100 | 101 | ToggleMinimize -> 102 | ( { model | 103 | minimized = not model.minimized 104 | , sync = True 105 | } 106 | |> selectFirstIfSync 107 | |> futureToHistory 108 | ) ! [] 109 | 110 | InputModelFilter s -> 111 | { model | modelFilter = s } ! [] 112 | 113 | SelectModelFilter id -> 114 | { model | modelFilter = id } ! [] 115 | 116 | SelectModelFilterWatch id -> 117 | ( { model | 118 | modelFilter = id 119 | , watch = Just id 120 | } 121 | |> updateLazyAstForWatch 122 | ) ! [] 123 | 124 | StopWatching -> 125 | { model | 126 | watch = Nothing 127 | } ! [] 128 | 129 | 130 | toggleSet : comparable -> Set comparable -> Set comparable 131 | toggleSet a set = 132 | (if Set.member a set then Set.remove else Set.insert) a set 133 | 134 | 135 | updateAfterUserMsg : (OutgoingMsg -> Cmd Never) -> Model model msg -> (Model model msg, Cmd Msg) 136 | updateAfterUserMsg save model = 137 | model ! [ saveSetting save model ] 138 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Util/Nel.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Util.Nel exposing (..) 2 | 3 | -- non-empty list 4 | type Nel a = 5 | Nel a (List a) 6 | 7 | 8 | toList : Nel a -> List a 9 | toList (Nel head tail) = 10 | head :: tail 11 | 12 | 13 | map : (a -> b) -> Nel a -> Nel b 14 | map f (Nel head tail) = 15 | Nel (f head) (List.map f tail) 16 | 17 | 18 | filter : (a -> Bool) -> Nel a -> List a 19 | filter match nel = 20 | List.filter match (toList nel) 21 | 22 | 23 | filterMap : (a -> Maybe b) -> Nel a -> List b 24 | filterMap match nel = 25 | List.filterMap match (toList nel) 26 | 27 | 28 | find : (a -> Bool) -> Nel a -> Maybe a 29 | find f nel = 30 | findHelp f (toList nel) 31 | 32 | 33 | findHelp : (a -> Bool) -> List a -> Maybe a 34 | findHelp f list = 35 | case list of 36 | [] -> 37 | Nothing 38 | head :: tail -> 39 | if f head then Just head else findHelp f tail 40 | 41 | 42 | findMap : (a -> Maybe b) -> Nel a -> Maybe b 43 | findMap f nel = 44 | findMapHelp f (toList nel) 45 | 46 | 47 | findMapHelp : (a -> Maybe b) -> List a -> Maybe b 48 | findMapHelp f list = 49 | case list of 50 | [] -> 51 | Nothing 52 | head :: tail -> 53 | case f head of 54 | Nothing -> findMapHelp f tail 55 | x -> x 56 | 57 | 58 | findMapMany : Int -> (a -> Maybe b) -> Nel a -> List b 59 | findMapMany n f nel = 60 | List.reverse (findMapManyHelp [] n f (toList nel)) 61 | 62 | 63 | findMapManyHelp : List b -> Int -> (a -> Maybe b) -> List a -> List b 64 | findMapManyHelp result n f list = 65 | if n <= 0 then 66 | result 67 | else 68 | case list of 69 | [] -> result 70 | h :: t -> 71 | case f h of 72 | Just b -> 73 | findMapManyHelp (b :: result) (n - 1) f t 74 | 75 | Nothing -> 76 | findMapManyHelp result n f t 77 | 78 | 79 | take : Int -> Nel a -> List a 80 | take n nel = 81 | List.reverse (takeHelp [] n (toList nel)) 82 | 83 | 84 | takeHelp : List a -> Int -> List a -> List a 85 | takeHelp result n list = 86 | if n <= 0 then 87 | result 88 | else 89 | case list of 90 | [] -> result 91 | h :: t -> 92 | takeHelp (h :: result) (n - 1) t 93 | 94 | 95 | head : Nel a -> a 96 | head (Nel head tail) = 97 | head 98 | 99 | 100 | concat : List a -> Nel a -> Nel a 101 | concat list (Nel h t) = 102 | case list of 103 | head :: tail -> 104 | Nel head (tail ++ (h :: t)) 105 | _ -> 106 | Nel h t 107 | 108 | 109 | cons : a -> Nel a -> Nel a 110 | cons new (Nel h t) = 111 | Nel new (h :: t) 112 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/Util/RTree.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.Util.RTree exposing (..) 2 | 3 | type RTree a = 4 | Node a (List (RTree a)) 5 | 6 | 7 | singleton : a -> RTree a 8 | singleton a = 9 | Node a [] 10 | 11 | 12 | root : RTree a -> a 13 | root (Node a list) = 14 | a 15 | 16 | 17 | addChild : a -> RTree a -> RTree a 18 | addChild new (Node a list) = 19 | Node a (singleton new :: list) 20 | 21 | 22 | addChildAt : (a -> Bool) -> a -> RTree a -> RTree a 23 | addChildAt f new tree = 24 | let 25 | (Node a list) = tree 26 | (Node a_ list_) = 27 | if f a then 28 | addChild new tree 29 | else 30 | tree 31 | in 32 | Node a_ (List.map (addChildAt f new) list_) 33 | 34 | 35 | sortEachBranchBy : (a -> comparable) -> RTree a -> RTree a 36 | sortEachBranchBy f (Node a list) = 37 | Node a (List.sortBy (f << root) (List.map (sortEachBranchBy f) list)) 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | -- 46 | -------------------------------------------------------------------------------- /src/TimeTravel/Internal/View.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Internal.View exposing (view) 2 | 3 | import TimeTravel.Internal.Model exposing (..) 4 | import TimeTravel.Internal.MsgLike as MsgLike exposing (MsgLike(..)) 5 | import TimeTravel.Internal.Util.Nel as Nel exposing (..) 6 | import TimeTravel.Internal.Styles as S 7 | import TimeTravel.Internal.Icons as I 8 | import TimeTravel.Internal.MsgTreeView as MsgTreeView 9 | import TimeTravel.Internal.DiffView as DiffView 10 | import TimeTravel.Internal.Parser.Formatter as Formatter 11 | import TimeTravel.Internal.Parser.AST as AST exposing (ASTX) 12 | 13 | import Html exposing (..) 14 | import Html.Attributes exposing (..) 15 | import Html.Events exposing (..) 16 | import Html.Keyed as Keyed 17 | 18 | import Set exposing (Set) 19 | import InlineHover exposing (hover) 20 | 21 | 22 | view : (msg -> a) -> (Msg -> a) -> (model -> Html msg) -> Model model msg -> Html a 23 | view transformUserMsg transformDebuggerMsg userViewFunc model = 24 | div 25 | [] 26 | [ Html.map transformUserMsg (userView userViewFunc model) 27 | , Html.map transformDebuggerMsg (debugView model) 28 | ] 29 | 30 | 31 | userView : (model -> Html msg) -> Model model msg -> Html msg 32 | userView userView model = 33 | case selectedItem model of 34 | Just item -> 35 | userView item.model 36 | 37 | Nothing -> 38 | text "Error: Unable to render" 39 | 40 | 41 | debugView : Model model msg -> Html Msg 42 | debugView model = 43 | (if model.minimized then minimizedDebugView else normalDebugView) model 44 | 45 | 46 | normalDebugView : Model model msg -> Html Msg 47 | normalDebugView model = 48 | div 49 | [] 50 | [ resyncView model.sync 51 | , div 52 | [ style (S.debugView model.fixedToLeft) ] 53 | [ headerView model.fixedToLeft model.sync model.expand model.filter 54 | , msgListView 55 | model.filter 56 | model.selectedMsg 57 | (Nel.toList model.history) 58 | (watchView model) 59 | (detailView model) 60 | ] 61 | ] 62 | 63 | 64 | minimizedDebugView : Model model msg -> Html Msg 65 | minimizedDebugView model = 66 | buttonView ToggleMinimize (S.minimizedButton model.fixedToLeft) [ I.minimize True ] 67 | 68 | 69 | resyncView : Bool -> Html Msg 70 | resyncView sync = 71 | if sync then 72 | text "" 73 | else 74 | div [ style (S.resyncView sync), onMouseDown Resync ] [] 75 | 76 | 77 | headerView : Bool -> Bool -> Bool -> FilterOptions -> Html Msg 78 | headerView fixedToLeft sync expand filterOptions = 79 | div [] 80 | [ div [ style S.headerView ] 81 | [ buttonView ToggleLayout (S.buttonView True) [ I.layout ] 82 | , buttonView ToggleMinimize (S.buttonView True) [ I.minimize False ] 83 | , buttonView ToggleSync (S.buttonView False) [ I.sync sync ] 84 | , buttonView ToggleExpand (S.buttonView False) [ I.filterExpand expand ] 85 | ] 86 | , filterView expand filterOptions 87 | ] 88 | 89 | 90 | buttonView : msg -> List (String, String) -> List (Html msg) -> Html msg 91 | buttonView onClickMsg buttonStyle inner = 92 | hover S.buttonHover div [ style buttonStyle, onClick onClickMsg ] inner 93 | 94 | 95 | filterView : Bool -> FilterOptions -> Html Msg 96 | filterView visible filterOptions = 97 | div 98 | [ style (S.filterView visible) ] 99 | (List.map filterItemView (List.sortBy Tuple.first filterOptions)) 100 | 101 | 102 | filterItemView : (String, Bool) -> Html Msg 103 | filterItemView (name, visible) = 104 | div [] 105 | [ label 106 | [] 107 | [ input 108 | [ type_ "checkbox" 109 | , checked visible 110 | , onClick (ToggleFilter name) 111 | ] 112 | [] 113 | , text name 114 | ] 115 | ] 116 | 117 | 118 | modelDetailView : Bool -> String -> Set AST.ASTId -> Maybe (Result String ASTX) -> model -> Html Msg 119 | modelDetailView fixedToLeft modelFilter expandedTree lazyModelAst userModel = 120 | case lazyModelAst of 121 | Just (Ok ast) -> 122 | let 123 | filterInput = 124 | modelFilterInput modelFilter 125 | 126 | filteredAst = 127 | if String.startsWith "@" modelFilter then 128 | case AST.filterByExactId modelFilter ast of 129 | Just x -> [(modelFilter, x)] 130 | Nothing -> [] 131 | else 132 | AST.filterById modelFilter ast 133 | 134 | trees = 135 | List.map 136 | (\(id, ast) -> 137 | modelDetailTreeEach 138 | expandedTree 139 | (if modelFilter /= "" then Just id else Nothing) 140 | ast 141 | ) 142 | filteredAst 143 | 144 | in 145 | div [ style (S.modelDetailView fixedToLeft) ] (filterInput :: trees) 146 | 147 | _ -> 148 | div [ style S.modelView ] [ text (toString userModel) ] 149 | 150 | 151 | modelFilterInput : String -> Html Msg 152 | modelFilterInput modelFilter = 153 | input 154 | [ style S.modelFilterInput 155 | , placeholder "Filter by property" 156 | , value modelFilter 157 | , onInput InputModelFilter 158 | ] 159 | [] 160 | 161 | 162 | modelDetailTreeEach : Set AST.ASTId -> Maybe String -> ASTX -> Html Msg 163 | modelDetailTreeEach expandedTree maybeId ast = 164 | let 165 | idView = 166 | case maybeId of 167 | Just id -> 168 | modelDetailTreeEachId id 169 | 170 | _ -> 171 | text "" 172 | in 173 | div 174 | [ style S.modelDetailTreeEach ] 175 | ( idView :: 176 | Formatter.formatAsHtml 177 | SelectModelFilter 178 | ToggleModelTree 179 | expandedTree 180 | (Formatter.makeModel ast) 181 | ) 182 | 183 | 184 | modelDetailTreeEachId : String -> Html Msg 185 | modelDetailTreeEachId id = 186 | let 187 | filterLink = 188 | hover 189 | S.modelDetailTreeEachIdHover 190 | span 191 | [ style S.modelDetailTreeEachId 192 | , onClick (SelectModelFilter id) 193 | ] 194 | [ text id 195 | ] 196 | 197 | watchLink = 198 | hover 199 | S.modelDetailTreeEachIdWatchHover 200 | span 201 | [ style S.modelDetailTreeEachIdWatch 202 | , onClick (SelectModelFilterWatch id) 203 | ] 204 | [ text "watch" 205 | ] 206 | in 207 | div 208 | [] 209 | [ filterLink 210 | , span [ style S.modelDetailTreeEachIdWatch ] [ text " (" ] 211 | , watchLink 212 | , span [ style S.modelDetailTreeEachIdWatch ] [ text ")" ] 213 | ] 214 | 215 | 216 | msgListView : FilterOptions -> Maybe Id -> List (HistoryItem model msg) -> Html Msg -> Html Msg -> Html Msg 217 | msgListView filterOptions selectedMsg items watchView detailView = 218 | div 219 | [] 220 | [ detailView 221 | , watchView 222 | , Keyed.node "div" 223 | [ style S.msgListView ] 224 | ( filterMapUntilLimit 60 (msgView filterOptions selectedMsg) items ) 225 | ] 226 | 227 | 228 | watchView : Model model msg -> Html Msg 229 | watchView model = 230 | case (model.watch, (Nel.head model.history).lazyModelAst) of 231 | (Just id, Just (Ok ast)) -> 232 | let 233 | treeView = 234 | case AST.filterByExactId id ast of 235 | Just ast -> 236 | modelDetailTreeEach model.expandedTree Nothing ast 237 | 238 | Nothing -> 239 | text "" 240 | 241 | stopWatchingButton = 242 | hover 243 | S.stopWatchingButtonHover 244 | div 245 | [ style S.stopWatchingButton 246 | , onClick StopWatching 247 | ] 248 | [ I.stopWatching ] 249 | in 250 | div 251 | [ style S.watchView ] 252 | [ div [ style S.watchViewHeader ] [ text ("Watching " ++ id) ] 253 | , treeView 254 | , stopWatchingButton 255 | ] 256 | 257 | _ -> 258 | text "" 259 | 260 | 261 | msgView : FilterOptions -> Maybe Id -> (HistoryItem model msg) -> Maybe (String, Html Msg) 262 | msgView filterOptions selectedMsg { id, msg, causedBy } = 263 | let 264 | selected = 265 | case selectedMsg of 266 | Just msgId -> msgId == id 267 | Nothing -> False 268 | 269 | str = 270 | MsgLike.format msg 271 | 272 | visible = 273 | msg == Init || 274 | case String.words str of 275 | tag :: _ -> 276 | List.any (\(name, visible) -> tag == name && visible) filterOptions 277 | _ -> 278 | False 279 | in 280 | if visible then 281 | Just ( 282 | toString id 283 | , hover 284 | (S.msgViewHover selected) 285 | div 286 | [ style (S.msgView selected) 287 | , onClick (SelectMsg id) 288 | , title (toString id ++ ": " ++ str) 289 | ] 290 | [ text (toString id ++ ": " ++ str) ] 291 | ) 292 | else 293 | Nothing 294 | 295 | 296 | filterMapUntilLimit : Int -> (a -> Maybe b) -> List a -> List b 297 | filterMapUntilLimit limit f list = 298 | List.reverse (filterMapUntilLimitHelp [] limit f list) 299 | 300 | 301 | filterMapUntilLimitHelp : List b -> Int -> (a -> Maybe b) -> List a -> List b 302 | filterMapUntilLimitHelp result limit f list = 303 | if limit <= 0 then 304 | result 305 | else 306 | case list of 307 | [] -> result 308 | h :: t -> 309 | case f h of 310 | Just b -> 311 | filterMapUntilLimitHelp (b :: result) (limit - 1) f t 312 | Nothing -> 313 | filterMapUntilLimitHelp result limit f t 314 | 315 | 316 | detailView : Model model msg -> Html Msg 317 | detailView model = 318 | if not model.sync then 319 | let 320 | msgTreeView = 321 | case (model.selectedMsg, selectedMsgTree model) of 322 | (Just id, Just tree) -> 323 | MsgTreeView.view SelectMsg id tree 324 | _ -> 325 | text "" 326 | 327 | diffView = 328 | case selectedItem model of 329 | Just item -> 330 | case item.lazyDiff of 331 | Just changes -> 332 | DiffView.view changes 333 | Nothing -> 334 | text "" 335 | Nothing -> 336 | text "" 337 | 338 | detailedMsgView = 339 | case selectedMsgAst model of 340 | Just ast -> 341 | div 342 | [ style S.detailedMsgView ] 343 | [ text (Formatter.formatAsString (Formatter.makeModel ast)) ] 344 | 345 | Nothing -> 346 | text "" 347 | 348 | head = 349 | div 350 | [ style S.detailViewHead ] 351 | [ detailTab (S.detailTabModel model.fixedToLeft model.showModelDetail) (ToggleModelDetail True) "Model" 352 | , detailTab (S.detailTabDiff model.fixedToLeft (not model.showModelDetail)) (ToggleModelDetail False) "Messages and Diff" 353 | ] 354 | 355 | body = 356 | if model.showModelDetail then 357 | case selectedItem model of 358 | Just item -> 359 | modelDetailView 360 | model.fixedToLeft 361 | model.modelFilter 362 | model.expandedTree 363 | item.lazyModelAst 364 | item.model 365 | :: [] 366 | _ -> 367 | [] 368 | else 369 | [ msgTreeView 370 | , detailedMsgView 371 | , diffView 372 | ] 373 | 374 | in 375 | div 376 | [ style (S.detailView model.fixedToLeft True) ] 377 | ( head :: body ) 378 | else 379 | text "" 380 | 381 | 382 | detailTab : List (String, String) -> msg -> String -> Html msg 383 | detailTab styles msg name = 384 | hover S.detailTabHover div [ style styles, onClick msg ] [ text name ] 385 | -------------------------------------------------------------------------------- /src/TimeTravel/Navigation.elm: -------------------------------------------------------------------------------- 1 | module TimeTravel.Navigation exposing (program, programWithFlags) 2 | 3 | {-| Each functions in this module has the same interface as [Navigation](http://package.elm-lang.org/packages/elm-lang/navigation/latest/Navigation) 4 | 5 | # Create a Program 6 | @docs program, programWithFlags 7 | 8 | -} 9 | 10 | import TimeTravel.Internal.Model as Model exposing (..) 11 | import TimeTravel.Internal.Update as Update 12 | import TimeTravel.Internal.View as View 13 | import TimeTravel.Internal.Util.Nel as Nel 14 | 15 | import Html exposing (Html, div, text) 16 | import Navigation exposing (Location) 17 | 18 | 19 | type Msg msg 20 | = DebuggerMsg Model.Msg 21 | | UserMsg (Maybe Int, msg) 22 | 23 | 24 | {- Alias for internal use -} 25 | type alias OptionsWithFlags flags model msg = 26 | { init : flags -> Location -> (model, Cmd msg) 27 | , update : msg -> model -> (model, Cmd msg) 28 | , view : model -> Html msg 29 | , subscriptions : model -> Sub msg 30 | } 31 | 32 | 33 | {-| See [Navigation.program](http://package.elm-lang.org/packages/elm-lang/navigation/latest/Navigation#program) 34 | -} 35 | program : 36 | (Location -> msg) 37 | -> { init : Location -> (model, Cmd msg) 38 | , update : msg -> model -> (model, Cmd msg) 39 | , view : model -> Html msg 40 | , subscriptions : model -> Sub msg 41 | } 42 | -> Program Never (Model model msg) (Msg msg) 43 | program parser { init, view, update, subscriptions } = 44 | let 45 | options = 46 | wrap 47 | { init = \flags location -> init location 48 | , view = view 49 | , update = update 50 | , subscriptions = subscriptions 51 | } 52 | in 53 | Navigation.program 54 | (\location -> UserMsg (Nothing, parser location)) 55 | { init = options.init () 56 | , view = options.view 57 | , update = options.update 58 | , subscriptions = options.subscriptions 59 | } 60 | 61 | 62 | {-| See [Navigation.programWithFlags](http://package.elm-lang.org/packages/elm-lang/navigation/latest/Navigation#programWithFlags) 63 | -} 64 | programWithFlags : 65 | (Location -> msg) 66 | -> { init : flags -> Location -> (model, Cmd msg) 67 | , update : msg -> model -> (model, Cmd msg) 68 | , view : model -> Html msg 69 | , subscriptions : model -> Sub msg 70 | } 71 | -> Program flags (Model model msg) (Msg msg) 72 | programWithFlags parser options = 73 | Navigation.programWithFlags (\location -> UserMsg (Nothing, parser location)) (wrap options) 74 | 75 | 76 | wrap : OptionsWithFlags flags model msg -> OptionsWithFlags flags (Model model msg) (Msg msg) 77 | wrap { init, view, update, subscriptions } = 78 | let 79 | -- TODO save settings and refactor 80 | outgoingMsg = always Cmd.none 81 | 82 | init_ flags location = 83 | let 84 | (model, cmd) = init flags location 85 | in 86 | Model.init model ! [ Cmd.map (\msg -> UserMsg (Just 0, msg)) cmd ] 87 | 88 | update_ msg model = 89 | case msg of 90 | UserMsg msgWithId -> 91 | updateOnIncomingUserMsg (\(id, msg) -> UserMsg (Just id, msg)) update msgWithId model 92 | 93 | DebuggerMsg msg -> 94 | let 95 | (m, c) = 96 | Update.update outgoingMsg msg model 97 | in 98 | m ! [ Cmd.map DebuggerMsg c ] 99 | 100 | view_ model = 101 | View.view (\c -> UserMsg (Nothing, c)) DebuggerMsg view model 102 | 103 | subscriptions_ model = 104 | let 105 | item = Nel.head model.history 106 | in 107 | Sub.map (\c -> UserMsg (Nothing, c)) (subscriptions item.model) 108 | in 109 | { init = init_ 110 | , update = update_ 111 | , view = view_ 112 | , subscriptions = subscriptions_ 113 | } 114 | -------------------------------------------------------------------------------- /tests/.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff/ 2 | -------------------------------------------------------------------------------- /tests/Main.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (..) 2 | 3 | import Tests 4 | import Test.Runner.Node exposing (run, TestProgram) 5 | import Json.Encode exposing (Value) 6 | 7 | 8 | main : TestProgram 9 | main = 10 | run emit Tests.all 11 | 12 | 13 | port emit : ( String, Value ) -> Cmd msg 14 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect exposing (Expectation) 5 | import Fuzz exposing (list, int, tuple, string) 6 | 7 | import Combine as RawParser exposing (..) 8 | import TimeTravel.Internal.Parser.AST exposing(..) 9 | import TimeTravel.Internal.Parser.Parser as Parser exposing(..) 10 | import TimeTravel.Internal.Parser.Formatter as Formatter exposing(..) 11 | 12 | 13 | isOk : Result a b -> Bool 14 | isOk r = 15 | case r of 16 | Ok _ -> True 17 | _ -> False 18 | 19 | 20 | testParse : String -> AST -> Expectation 21 | testParse s ast = Expect.equal (Ok ast) (Parser.parse s) 22 | 23 | 24 | mapResult : Result (ParseErr state) (ParseOk state x) -> Result String x 25 | mapResult result = 26 | case result of 27 | Ok (_, _, x) -> Ok x 28 | Err _ -> Err "" 29 | 30 | 31 | 32 | testParseStringLiteral : String -> AST -> Expectation 33 | testParseStringLiteral s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.stringLiteral s) 34 | 35 | 36 | testParseExpression : String -> AST -> Expectation 37 | testParseExpression s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.expression s) 38 | 39 | 40 | testParseUnion : String -> AST -> Expectation 41 | testParseUnion s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.union s) 42 | 43 | 44 | testParseRecord : String -> AST -> Expectation 45 | testParseRecord s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.record s) 46 | 47 | 48 | testParseList : String -> AST -> Expectation 49 | testParseList s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.listLiteral s) 50 | 51 | 52 | testParseTuple : String -> AST -> Expectation 53 | testParseTuple s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.tupleLiteral s) 54 | 55 | 56 | testParseProperty : String -> AST -> Expectation 57 | testParseProperty s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.property s) 58 | 59 | 60 | testParseProperties : String -> List AST -> Expectation 61 | testParseProperties s ast = Expect.equal (Ok ast) (mapResult <| RawParser.parse Parser.properties s) 62 | 63 | 64 | testParseComplex : String -> Expectation 65 | testParseComplex s = 66 | Expect.true "" ( 67 | isOk <| 68 | -- Debug.log "result" <| 69 | (Parser.parse s) 70 | ) 71 | 72 | 73 | all : Test 74 | all = 75 | describe "A Test Suite" 76 | [ test "number1" (\_ -> testParseExpression "1" (Value "1")) 77 | , test "number2" (\_ -> testParseExpression "1.2" (Value "1.2")) 78 | , test "number3" (\_ -> testParseExpression "-1" (Value "-1")) 79 | , test "number4" (\_ -> testParseExpression "-1.2" (Value "-1.2")) 80 | , test "struct1" (\_ -> testParseExpression "" (Value "")) 81 | , test "struct2" (\_ -> testParseExpression "" (Value "")) 82 | , test "struct3" (\_ -> testParseExpression "" (Value "")) 83 | , test "null" (\_ -> testParseExpression "null" (Value "null")) 84 | , test "stringLiteral1" (\_ -> testParseStringLiteral (toString """f"oo""") (StringLiteral "f\\\"oo")) 85 | , test "stringLiteral2" (\_ -> testParseStringLiteral (toString """f"o"o""") (StringLiteral "f\\\"o\\\"o")) 86 | , test "stringLiteral3" (\_ -> testParseStringLiteral (toString """f"o"o"o"o"o"o"o"o"o""") (StringLiteral "f\\\"o\\\"o\\\"o\\\"o\\\"o\\\"o\\\"o\\\"o\\\"o")) 87 | , test "stringLiteral4" (\_ -> testParseStringLiteral "\" str = { } \"" (StringLiteral " str = { } ")) 88 | , test "union1" (\_ -> testParseUnion "Tag" (Union "Tag" [])) 89 | , test "union2" (\_ -> testParseUnion "Tag 1" (Union "Tag" [Value "1"])) 90 | , test "union3" (\_ -> testParseUnion "Tag 1 \"a\"" (Union "Tag" [Value "1", StringLiteral "a"])) 91 | , test "union4" (\_ -> testParseUnion "Tag { a = Inner }" (Union "Tag" [Record [Property "a" (Union "Inner" [])]])) 92 | , test "union5" (\_ -> testParseUnion "Tag Nothing" (Union "Tag" [Union "Nothing" []])) 93 | , test "union6" (\_ -> testParseUnion "Tag Nothing Nothing" (Union "Tag" [Union "Nothing" [], Union "Nothing" []])) 94 | , test "union7" (\_ -> testParseUnion "CamelCase" (Union "CamelCase" [])) 95 | , test "union8" (\_ -> testParseUnion "Camel_Snake" (Union "Camel_Snake" [])) 96 | , test "union9" (\_ -> testParseUnion "True" (Union "True" [])) 97 | , test "union10" (\_ -> testParseUnion "True1" (Union "True1" [])) 98 | , test "union11" (\_ -> testParseUnion "Just 1" (Union "Just" [Value "1"])) 99 | , test "union12" (\_ -> testParseUnion "Just1 1" (Union "Just1" [Value "1"])) 100 | , test "union13" (\_ -> testParseUnion "True 1" (Union "True" [Value "1"])) 101 | , test "property" (\_ -> testParseProperty "a = 1" (Property "a" (Value "1"))) 102 | , test "properties" (\_ -> testParseProperties "a = 1,a = 2" [Property "a" (Value "1"),Property "a" (Value "2")]) 103 | , test "record1" (\_ -> testParseRecord "{}" (Record [])) 104 | , test "record2" (\_ -> testParseRecord "{ }" (Record [])) 105 | , test "record3" (\_ -> testParseRecord "{a = 1}" (Record [Property "a" (Value "1")])) 106 | , test "record4" (\_ -> testParseRecord "{a_b = 1}" (Record [Property "a_b" (Value "1")])) 107 | , test "list1" (\_ -> testParseList "[]" (ListLiteral [])) 108 | , test "list2" (\_ -> testParseList "[ ]" (ListLiteral [])) 109 | , test "list3" (\_ -> testParseList "[1,2]" (ListLiteral [Value "1", Value "2"])) 110 | , test "list4" (\_ -> testParseList "[ \"1\" , \"2\" ]" (ListLiteral [StringLiteral "1", StringLiteral "2"])) 111 | , test "list5" (\_ -> testParseList "[ [[ []] ] ]" (ListLiteral [ListLiteral [ListLiteral [ListLiteral []]]])) 112 | , test "list6" (\_ -> testParseList "[\",\"]" (ListLiteral [StringLiteral ","])) 113 | , test "list7" (\_ -> testParseList "[\"][\"]" (ListLiteral [StringLiteral "]["])) 114 | , test "tuple1" (\_ -> testParseTuple "()" (TupleLiteral [])) 115 | , test "tuple2" (\_ -> testParseTuple "( )" (TupleLiteral [])) 116 | , test "tuple3" (\_ -> testParseTuple "(1,\"2\")" (TupleLiteral [Value "1", StringLiteral "2"])) 117 | , test "tuple4" (\_ -> testParseTuple "( [] , [] )" (TupleLiteral [ListLiteral [], ListLiteral []])) 118 | , test "tuple5" (\_ -> testParseTuple "( (( (1,2)) ) )" (TupleLiteral [TupleLiteral [TupleLiteral [TupleLiteral [Value "1", Value "2"]]]])) 119 | , test "tuple6" (\_ -> testParseTuple "(\",\")" (TupleLiteral [StringLiteral ","])) 120 | , test "tuple7" (\_ -> testParseTuple "(\")(\")" (TupleLiteral [StringLiteral ")("])) 121 | , test "tuple8" (\_ -> testParseTuple "( Tag 1 \"a\", { a = 1 } )" (TupleLiteral [Union "Tag" [Value "1", StringLiteral "a"], Record [Property "a" (Value "1")]])) 122 | , test "expression1" (\_ -> testParse "1" (Value "1")) 123 | , test "expression2" (\_ -> testParse " 1 " (Value "1")) 124 | , test "expression3" (\_ -> testParse "{}" (Record [])) 125 | , test "expression4" (\_ -> testParse " {} " (Record [])) 126 | , test "expression5" (\_ -> testParse "{ }" (Record [])) 127 | , test "expression7" (\_ -> testParse "{ a = 1 }" (Record [Property "a" (Value "1")])) 128 | , test "expression9" (\_ -> testParse "{ a = 1, a = 1 }" (Record [Property "a" (Value "1"), Property "a" (Value "1")])) 129 | , test "expression10" (\_ -> testParse "\" = {} \"" (StringLiteral " = {} ")) 130 | , test "expression11" (\_ -> testParse "{ a = { b = 1 } }" (Record [Property "a" (Record [Property "b" (Value "1")])])) 131 | , test "expression12" (\_ -> testParse "{ a = \"}={\" }" (Record [Property "a" (StringLiteral "}={")])) 132 | , test "complex1" (\_ -> testParseComplex "{ seed = Seed (Seed (Seed {})) }") 133 | , test "complex2" (\_ -> testParseComplex (String.join " " <| String.lines complexString)) 134 | ] 135 | 136 | complexString = """ 137 | { int = 1 138 | , float = 1.2 139 | , string1 = "string" 140 | , string2 = "a" 141 | , function1 = 142 | , function2 = 143 | , $public = "" 144 | , record1 = { query = "", results = Nothing } 145 | , record2 = 146 | { multi = "line" 147 | , nest = 148 | { more = 1 149 | } 150 | } 151 | , union1 = Single 152 | , union2 = Union 100000 100000 100000 100000 100000 100000 100000 100000 100000 100000 100000 100000 100000 153 | , union3 = Union (100000,100000,100000) { a = 100000, b = 100000, c = 100000 } [100000,100000,100000,100000,100000] 154 | , union4 = 155 | Union 156 | "multi" 157 | "line" 158 | (Nest 1) 159 | , list1 = [100000,100000,100000,100000,100000] 160 | , list2 = [100000,100000,100000,100000,100000,100000,100000,100000,100000,100000,100000,100000] 161 | , list3 = 162 | [ "multi" 163 | , "line" 164 | , [ "nest" 165 | , "more" 166 | ] 167 | ] 168 | , tuple1 = (100000,100000,100000,100000,100000) 169 | , tuple2 = (100000,100000,100000,100000,100000,100000,100000,100000,100000,100000,100000,100000) 170 | , tuple3 = 171 | ( "multi" 172 | , "line" 173 | , ( "nest" 174 | , "more" 175 | ) 176 | ) 177 | } 178 | """ 179 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Sample Elm Test", 4 | "repository": "https://github.com/user/project.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | ".", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "Bogdanp/elm-combine": "3.0.0 <= v < 4.0.0", 13 | "elm-community/json-extra": "2.0.0 <= v < 3.0.0", 14 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 15 | "mgold/elm-random-pcg": "4.0.0 <= v < 5.0.0", 16 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 17 | "elm-community/elm-test": "3.0.0 <= v < 4.0.0", 18 | "rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0", 19 | "jinjor/elm-diff": "1.0.0 <= v < 2.0.0", 20 | "jinjor/elm-inline-hover": "1.0.0 <= v < 2.0.0" 21 | }, 22 | "elm-version": "0.18.0 <= v < 0.19.0" 23 | } 24 | --------------------------------------------------------------------------------