├── .gitignore ├── LICENSE ├── README.md ├── elm.json ├── examples ├── Counter.elm ├── CounterWithCats.elm ├── TextEditor.elm ├── elm-package.json └── elm.json ├── src ├── UndoList.elm └── UndoList │ ├── Decode.elm │ └── Encode.elm └── tests ├── Tests.elm └── elm-verify-examples.json /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | 3 | VerifyExamples 4 | 5 | .tool-versions 6 | 7 | node_modules 8 | package.json 9 | package-lock.json 10 | yarn.lock 11 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016-2017 the Elm-Community Members 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of elm-test nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Undo/redo in any Elm app 2 | 3 | Add undo/redo to any Elm app with just a few lines of code! 4 | 5 | Trying to add undo/redo in JS can be a nightmare. If anything gets mutated in 6 | an unexpected way, your history can get corrupted. Elm is built from the ground 7 | up around efficient, immutable data structures. That means adding support for 8 | undo/redo is a matter of remembering the state of your app at certain times. 9 | Since there is no mutation, there is no risk of things getting corrupted. Given 10 | immutability lets you do structural sharing within data structures, it also 11 | means these snapshots can be quite compact! 12 | 13 | 14 | ## How it works 15 | 16 | The library is centered around a single data structure, the `UndoList`. 17 | 18 | ```elm 19 | type alias UndoList state = 20 | { past: List state 21 | , present: state 22 | , future: List state 23 | } 24 | ``` 25 | 26 | An `UndoList` contains a list of past states, a present state, and a list of 27 | future states. By keeping track of the past, present, and future states, undo 28 | and redo become just a matter of sliding the present around a bit. 29 | 30 | 31 | ## Example 32 | 33 | ### Initial counter app 34 | 35 | We will start with a very simple counter application. There is a button, and 36 | when it is clicked, a counter is incremented. 37 | 38 | ```elm 39 | -- BEFORE 40 | import Html exposing (div, button, text) 41 | import Html.Events exposing (onClick) 42 | import Html.App as Html 43 | 44 | main = 45 | Html.beginnerProgram 46 | { model = 0 47 | , view = view 48 | , update = update 49 | } 50 | 51 | type alias Model = Int 52 | 53 | type Msg = Increment 54 | 55 | update : Msg -> Model -> Model 56 | update msg model = 57 | case msg of 58 | Increment -> 59 | model + 1 60 | 61 | view : Model -> Html Msg 62 | view model = 63 | div 64 | [] 65 | [ button 66 | [ onClick Increment ] 67 | [ text "Increment" ] 68 | , div 69 | [] 70 | [ text (toString model) ] 71 | ] 72 | ``` 73 | 74 | ### Adding undo 75 | 76 | Suppose that further down the line we decide it would be nice to have an undo 77 | button. 78 | 79 | The next code block is the same program updated to use the `UndoList` module to 80 | add this functionality. It is in one big block because it is mostly the same as 81 | the original, and we will go into the differences afterwards. 82 | 83 | ```elm 84 | -- AFTER 85 | import Html exposing (div, button, text) 86 | import Html.Events exposing (onClick) 87 | import Html.App as Html 88 | import UndoList exposing (UndoList) 89 | 90 | main = 91 | Html.beginnerProgram 92 | { model = UndoList.fresh 0 93 | , view = view 94 | , update = update 95 | } 96 | 97 | type alias Model 98 | = UndoList Int 99 | 100 | type Msg 101 | = Increment 102 | | Undo 103 | 104 | update : Msg -> Model -> Model 105 | update msg model = 106 | case msg of 107 | Increment -> 108 | UndoList.new (model.present + 1) model 109 | 110 | Undo -> 111 | UndoList.undo model 112 | 113 | view : Model -> Html Msg 114 | view model = 115 | div 116 | [] 117 | [ button 118 | [ onClick Increment ] 119 | [ text "Increment" ] 120 | , button 121 | [ onClick Undo ] 122 | [ text "Undo" ] 123 | , div 124 | [] 125 | [ text (toString model) ] 126 | ] 127 | ``` 128 | 129 | Here are the differences: 130 | - the `Model` type changed from `Int` to `UndoList Int` 131 | - the `Msg` type now has a new constructor `Undo` 132 | - the `update` function now cares for this new `Undo` message in the pattern matching 133 | - a `button` was added to the `view` function. It sends the `Undo` message 134 | 135 | Adding redo functionality is quite the same. You can find by yourself as an exercise, or look at the 136 | [counter example](./examples/Counter.elm). 137 | 138 | ### Usage with commands 139 | 140 | When you use `Html.App.program` instead of `Html.App.beginnerProgram` as above, you can use commands 141 | in your `update` function. 142 | 143 | Look at the [counter with cats example](./examples/CounterWithCats.elm) which loads a GIF image whenever you increment 144 | the counter, with undo/redo even with asynchronous operations. 145 | 146 | ## More Details 147 | 148 | This API is designed to work really nicely with 149 | [The Elm Architecture](http://guide.elm-lang.org/architecture/index.html). 150 | 151 | It has a lot more cool stuff, so read the [docs](http://package.elm-lang.org/packages/elm-community/undo-redo/latest). 152 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "elm-community/undo-redo", 4 | "summary": "Easy undo in Elm", 5 | "license": "BSD-3-Clause", 6 | "version": "3.0.0", 7 | "exposed-modules": [ 8 | "UndoList", 9 | "UndoList.Decode", 10 | "UndoList.Encode" 11 | ], 12 | "elm-version": "0.19.0 <= v < 0.20.0", 13 | "dependencies": { 14 | "elm/core": "1.0.0 <= v < 2.0.0", 15 | "elm/json": "1.0.0 <= v < 2.0.0" 16 | }, 17 | "test-dependencies": { 18 | "elm-explorations/test": "1.1.0 <= v < 2.0.0" 19 | } 20 | } -------------------------------------------------------------------------------- /examples/Counter.elm: -------------------------------------------------------------------------------- 1 | module Counter exposing (..) 2 | 3 | import UndoList exposing (UndoList) 4 | import Html exposing (Html, div, button, text) 5 | import Browser 6 | import Html.Events exposing (onClick) 7 | 8 | 9 | main : Program () Model Msg 10 | main = 11 | Browser.sandbox 12 | { init = UndoList.fresh 0 13 | , view = view 14 | , update = update 15 | } 16 | 17 | 18 | type alias Model = 19 | UndoList Int 20 | 21 | 22 | type Msg 23 | = Increment 24 | | Undo 25 | | Redo 26 | 27 | 28 | update : Msg -> Model -> Model 29 | update msg model = 30 | case msg of 31 | Increment -> 32 | UndoList.new (model.present + 1) model 33 | 34 | Undo -> 35 | UndoList.undo model 36 | 37 | Redo -> 38 | UndoList.redo model 39 | 40 | 41 | view : Model -> Html Msg 42 | view model = 43 | div [] 44 | [ button [ onClick Increment ] 45 | [ text "Increment" ] 46 | , button [ onClick Undo ] 47 | [ text "Undo" ] 48 | , button [ onClick Redo ] 49 | [ text "Redo" ] 50 | , div [] 51 | [ text (String.fromInt model.present) ] 52 | ] 53 | -------------------------------------------------------------------------------- /examples/CounterWithCats.elm: -------------------------------------------------------------------------------- 1 | module CounterWithCats exposing (..) 2 | 3 | import Browser 4 | import Html exposing (Html, div, button, img, text) 5 | import Html.Attributes exposing (src) 6 | import Html.Events exposing (onClick) 7 | import UndoList exposing (UndoList) 8 | import Http 9 | import Task 10 | import Json.Decode as Json 11 | 12 | 13 | main : Program () Model Msg 14 | main = 15 | Browser.element 16 | { init = \() -> init 17 | , view = view 18 | , update = update 19 | , subscriptions = always Sub.none 20 | } 21 | 22 | 23 | type alias Model = 24 | UndoList 25 | { counter : Int 26 | , gifUrl : Maybe String 27 | } 28 | 29 | 30 | type Msg 31 | = Increment 32 | | Undo 33 | | Redo 34 | | OnFetch (Result Http.Error String) 35 | 36 | 37 | init : ( Model, Cmd msg ) 38 | init = 39 | ( UndoList.fresh { counter = 0, gifUrl = Nothing } 40 | , Cmd.none 41 | ) 42 | 43 | 44 | update : Msg -> Model -> ( Model, Cmd Msg ) 45 | update msg ({ present } as model) = 46 | case msg of 47 | Increment -> 48 | ( UndoList.new { present | counter = present.counter + 1 } 49 | model 50 | , getRandomGif "cats" 51 | ) 52 | 53 | Undo -> 54 | ( UndoList.undo model, Cmd.none ) 55 | 56 | Redo -> 57 | ( UndoList.redo model, Cmd.none ) 58 | 59 | OnFetch (Ok newUrl) -> 60 | ( UndoList.mapPresent (\_ -> { present | gifUrl = Just newUrl }) 61 | model 62 | , Cmd.none 63 | ) 64 | 65 | OnFetch (Err _) -> 66 | ( model, Cmd.none ) 67 | 68 | 69 | view : Model -> Html Msg 70 | view model = 71 | div [] 72 | [ button [ onClick Increment ] 73 | [ text "Increment" ] 74 | , button [ onClick Undo ] 75 | [ text "Undo" ] 76 | , button [ onClick Redo ] 77 | [ text "Redo" ] 78 | , div [] 79 | [ text (String.fromInt model.present.counter) ] 80 | , div [] 81 | (case model.present.gifUrl of 82 | Just gifUrl -> 83 | [ img [ src gifUrl ] [] ] 84 | 85 | Nothing -> 86 | [ text "Increment to display a GIF image" ] 87 | ) 88 | ] 89 | 90 | 91 | 92 | -- Taken from https://guide.elm-lang.org/architecture/effects/http.html 93 | 94 | 95 | getRandomGif : String -> Cmd Msg 96 | getRandomGif topic = 97 | let 98 | url = 99 | "https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic 100 | in 101 | Http.get url decodeGifUrl 102 | |> Http.send OnFetch 103 | 104 | 105 | decodeGifUrl : Json.Decoder String 106 | decodeGifUrl = 107 | Json.at [ "data", "image_url" ] Json.string 108 | -------------------------------------------------------------------------------- /examples/TextEditor.elm: -------------------------------------------------------------------------------- 1 | module TextEditor exposing (..) 2 | 3 | import Browser 4 | import Html exposing (Html) 5 | import Html.Events as Event 6 | import Html.Attributes as Attr 7 | import UndoList exposing (UndoList) 8 | 9 | 10 | -- Main 11 | 12 | 13 | main : Program () Model Msg 14 | main = 15 | Browser.sandbox 16 | { init = init 17 | , update = update 18 | , view = view 19 | } 20 | 21 | 22 | 23 | -- Model 24 | 25 | 26 | type alias Model = 27 | UndoList { content : String } 28 | 29 | 30 | init : Model 31 | init = 32 | UndoList.fresh { content = "" } 33 | 34 | 35 | 36 | -- Update 37 | 38 | 39 | type Msg 40 | = UpdateContent String 41 | | Undo 42 | | Redo 43 | 44 | 45 | update : Msg -> Model -> Model 46 | update msg model = 47 | case msg of 48 | UpdateContent str -> 49 | UndoList.new { content = str } model 50 | 51 | Undo -> 52 | UndoList.undo model 53 | 54 | Redo -> 55 | UndoList.redo model 56 | 57 | 58 | 59 | -- View 60 | 61 | 62 | view : Model -> Html Msg 63 | view model = 64 | let 65 | button text msg = 66 | Html.button 67 | [ Event.onClick msg 68 | , Attr.style "width" "8em" 69 | , Attr.style "height" "3em" 70 | , Attr.style "font-size" "14pt" 71 | ] 72 | [ Html.text text ] 73 | 74 | undoButton = 75 | button "Undo" Undo 76 | 77 | redoButton = 78 | button "Redo" Redo 79 | 80 | title = 81 | Html.span 82 | [ Attr.style "font-size" "16pt" ] 83 | [ Html.text "Simple Text Area with Undo/Redo support" ] 84 | 85 | headerArea = 86 | Html.div 87 | [ Attr.style "display" "flex" 88 | , Attr.style "justify-content" "space-between" 89 | , Attr.style "align-items" "center" 90 | ] 91 | [ undoButton 92 | , title 93 | , redoButton 94 | ] 95 | 96 | textArea = 97 | Html.textarea 98 | [ Event.onInput UpdateContent 99 | , Attr.value model.present.content 100 | , Attr.placeholder "Enter text here..." 101 | , Attr.style "flex" "1" 102 | , Attr.style "font-size" "24pt" 103 | , Attr.style "font-family" "Helvetica Neue, Helvetica, Arial, sans-serif" 104 | , Attr.style "resize" "none" 105 | ] 106 | [] 107 | in 108 | Html.div 109 | [ Attr.style "position" "absolute" 110 | , Attr.style "margin" "0" 111 | , Attr.style "padding" "0" 112 | , Attr.style "width" "100vw" 113 | , Attr.style "height" "100vh" 114 | , Attr.style "display" "flex" 115 | , Attr.style "flex-direction" "column" 116 | ] 117 | [ headerArea 118 | , textArea 119 | ] 120 | -------------------------------------------------------------------------------- /examples/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "undo-redo examples", 4 | "repository": "https://github.com/elm-community/undo-redo.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "elm-community/shrink": "2.0.0 <= v < 3.0.0", 13 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 14 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 15 | "elm-lang/http": "1.0.0 <= v < 2.0.0" 16 | }, 17 | "elm-version": "0.18.0 <= v < 0.19.0" 18 | } 19 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | ".", 5 | "../src" 6 | ], 7 | "elm-version": "0.19.0", 8 | "dependencies": { 9 | "direct": { 10 | "elm/browser": "1.0.1", 11 | "elm/core": "1.0.0", 12 | "elm/html": "1.0.0", 13 | "elm/http": "1.0.0", 14 | "elm/json": "1.0.0" 15 | }, 16 | "indirect": { 17 | "elm/time": "1.0.0", 18 | "elm/url": "1.0.0", 19 | "elm/virtual-dom": "1.0.2" 20 | } 21 | }, 22 | "test-dependencies": { 23 | "direct": {}, 24 | "indirect": {} 25 | } 26 | } -------------------------------------------------------------------------------- /src/UndoList.elm: -------------------------------------------------------------------------------- 1 | module UndoList 2 | exposing 3 | ( UndoList 4 | , undo 5 | , redo 6 | , fresh 7 | , new 8 | , forget 9 | , reset 10 | , hasPast 11 | , hasFuture 12 | , length 13 | , lengthPast 14 | , lengthFuture 15 | , Msg(..) 16 | , mapMsg 17 | , map 18 | , mapPresent 19 | , update 20 | , connect 21 | , reduce 22 | , foldl 23 | , foldr 24 | , reverse 25 | , flatten 26 | , flatMap 27 | , andThen 28 | , map2 29 | , andMap 30 | , view 31 | , toList 32 | , fromList 33 | ) 34 | 35 | {-| UndoList Data Structure. 36 | 37 | 38 | # Definition 39 | 40 | @docs UndoList 41 | 42 | 43 | # Basic Operations 44 | 45 | @docs undo, redo, fresh, new, forget, reset 46 | 47 | 48 | # Query UndoList 49 | 50 | @docs hasPast, hasFuture, length, lengthPast, lengthFuture 51 | 52 | 53 | # Messages 54 | 55 | @docs Msg, mapMsg 56 | 57 | 58 | # Functional Operations 59 | 60 | @docs map, mapPresent, update, connect, reduce, foldl, foldr, reverse, flatten, flatMap, andThen, map2, andMap 61 | 62 | 63 | 64 | # Shorthands 65 | 66 | @docs view 67 | 68 | 69 | # Conversions 70 | 71 | @docs toList, fromList 72 | 73 | -} 74 | 75 | import List 76 | 77 | 78 | ------------------- 79 | -- UndoList Type -- 80 | ------------------- 81 | 82 | 83 | {-| The UndoList data structure. 84 | An UndoList has: 85 | 86 | 1. A list of past states 87 | 2. A present state 88 | 3. A list of future states 89 | 90 | The head of the past list is the most recent state and the head of the future 91 | list is the next state. (i.e., the tails of both lists point away from the 92 | present) 93 | 94 | -} 95 | type alias UndoList state = 96 | { past : List state 97 | , present : state 98 | , future : List state 99 | } 100 | 101 | 102 | 103 | ------------------------------- 104 | -- Basic UndoList Operations -- 105 | ------------------------------- 106 | 107 | 108 | {-| If the undolist has any past states, set the most recent past 109 | state as the current state and turn the old present state into 110 | a future state. 111 | 112 | i.e. 113 | 114 | undo (UndoList [ 3, 2, 1 ] 4 [ 5, 6 ]) 115 | --> UndoList [ 2, 1 ] 3 [ 4, 5, 6 ] 116 | 117 | -} 118 | undo : UndoList state -> UndoList state 119 | undo { past, present, future } = 120 | case past of 121 | [] -> 122 | UndoList past present future 123 | 124 | x :: xs -> 125 | UndoList xs x (present :: future) 126 | 127 | 128 | {-| If the undo-list has any future states, set the next 129 | future state as the current state and turn the old present state 130 | into a past state. 131 | 132 | i.e. 133 | 134 | redo (UndoList [ 3, 2, 1 ] 4 [ 5, 6 ]) 135 | --> UndoList [ 4, 3, 2, 1 ] 5 [ 6 ] 136 | 137 | -} 138 | redo : UndoList state -> UndoList state 139 | redo { past, present, future } = 140 | case future of 141 | [] -> 142 | UndoList past present future 143 | 144 | x :: xs -> 145 | UndoList (present :: past) x xs 146 | 147 | 148 | {-| Turn a state into an undo-list with neither past nor future. 149 | 150 | i.e. 151 | 152 | fresh 0 153 | --> UndoList [] 0 [ ] 154 | 155 | -} 156 | fresh : state -> UndoList state 157 | fresh state = 158 | UndoList [] state [] 159 | 160 | 161 | {-| Add a new present state to the undo-list, turning the old 162 | present state into a past state and erasing the future. 163 | -} 164 | new : state -> UndoList state -> UndoList state 165 | new event { past, present } = 166 | UndoList (present :: past) event [] 167 | 168 | 169 | {-| Forget the past and look to the future! 170 | This simply clears the past list. 171 | 172 | i.e. 173 | 174 | forget (UndoList [3,2,1] 4 [5,6]) 175 | --> UndoList [] 4 [5,6] 176 | 177 | -} 178 | forget : UndoList state -> UndoList state 179 | forget { present, future } = 180 | UndoList [] present future 181 | 182 | 183 | {-| Reset the undo-list by returning to the very first state 184 | and clearing all other states. 185 | 186 | i.e. 187 | 188 | reset (UndoList [ 3, 2, 1 ] 4 [ 5, 6 ]) 189 | --> UndoList [] 1 [] 190 | 191 | -} 192 | reset : UndoList state -> UndoList state 193 | reset { past, present } = 194 | case past of 195 | [] -> 196 | fresh present 197 | 198 | x :: xs -> 199 | reset (UndoList xs x []) 200 | 201 | 202 | 203 | ---------------------- 204 | -- UndoList Queries -- 205 | ---------------------- 206 | 207 | 208 | {-| Check if the undo-list has any past states. 209 | 210 | hasPast (UndoList [] 1 []) --> False 211 | hasPast (UndoList [ 1, 2, 3 ] 4 []) --> True 212 | -} 213 | hasPast : UndoList state -> Bool 214 | hasPast = 215 | not << List.isEmpty << .past 216 | 217 | 218 | {-| Check if the undo-list has any future states. 219 | 220 | hasFuture (UndoList [] 1 []) --> False 221 | hasFuture (UndoList [] 1 [ 2, 3, 4 ]) --> True 222 | -} 223 | hasFuture : UndoList state -> Bool 224 | hasFuture = 225 | not << List.isEmpty << .future 226 | 227 | 228 | {-| Get the full length of an undo-list 229 | 230 | length (UndoList [ 0 ] 1 [ 2, 3, 4 ]) --> 5 231 | -} 232 | length : UndoList state -> Int 233 | length undolist = 234 | lengthPast undolist + 1 + lengthFuture undolist 235 | 236 | 237 | {-| Get the length of the past. 238 | 239 | lengthPast (UndoList [ 0 ] 1 [ 2, 3, 4 ]) --> 1 240 | -} 241 | lengthPast : UndoList state -> Int 242 | lengthPast = 243 | .past >> List.length 244 | 245 | 246 | {-| Get the length of the future 247 | 248 | lengthFuture (UndoList [ 0 ] 1 [ 2, 3, 4 ]) --> 3 249 | -} 250 | lengthFuture : UndoList state -> Int 251 | lengthFuture = 252 | .future >> List.length 253 | 254 | 255 | 256 | -------------------------- 257 | -- UndoList Msg Type -- 258 | -------------------------- 259 | 260 | 261 | {-| Simple UndoList Msg type. This is a simple type that can be used for 262 | most use cases. This works best when paired with the `update` function as 263 | `update` will perform the corresponding operations on the undolist automatically. 264 | 265 | Consider using your own data type only if you really need it. 266 | 267 | -} 268 | type Msg msg 269 | = Reset 270 | | Redo 271 | | Undo 272 | | Forget 273 | | New msg 274 | 275 | 276 | {-| Map a function over a msg. 277 | 278 | mapMsg sqrt (New 100) --> New 10 279 | mapMsg sqrt Undo --> Undo 280 | -} 281 | mapMsg : (a -> b) -> Msg a -> Msg b 282 | mapMsg f msg = 283 | case msg of 284 | Reset -> 285 | Reset 286 | 287 | Redo -> 288 | Redo 289 | 290 | Undo -> 291 | Undo 292 | 293 | Forget -> 294 | Forget 295 | 296 | New newMsg -> 297 | New (f newMsg) 298 | 299 | 300 | 301 | --------------------------- 302 | -- Functional Operations -- 303 | --------------------------- 304 | 305 | 306 | {-| Map a function over an undo-list. 307 | Be careful with this. The function will be applied to the past and the future 308 | as well. If you just want to change the present, use `mapPresent`. 309 | 310 | A good use case for `map` is to encode an undo-list as JSON. 311 | 312 | Example: 313 | 314 | import UndoList.Encode as Encode 315 | 316 | encode encoder undolist = 317 | map encoder undolist 318 | |> Encode.undolist 319 | -} 320 | map : (a -> b) -> UndoList a -> UndoList b 321 | map f { past, present, future } = 322 | UndoList (List.map f past) (f present) (List.map f future) 323 | 324 | 325 | {-| Map a function over a pair of undo-lists. 326 | -} 327 | map2 : (a -> b -> c) -> UndoList a -> UndoList b -> UndoList c 328 | map2 f undoListA undoListB = 329 | UndoList (List.map2 f undoListA.past undoListB.past) 330 | (f undoListA.present undoListB.present) 331 | (List.map2 f undoListA.future undoListB.future) 332 | 333 | 334 | {-| Map a function over any number of undo-lists. 335 | 336 | map f xs 337 | |> andMap ys 338 | |> andMap zs 339 | 340 | -} 341 | andMap : UndoList a -> UndoList (a -> b) -> UndoList b 342 | andMap = 343 | \y x -> map2 (<|) x y 344 | 345 | 346 | {-| Apply a function only to the present. 347 | -} 348 | mapPresent : (a -> a) -> UndoList a -> UndoList a 349 | mapPresent f { past, present, future } = 350 | UndoList past (f present) future 351 | 352 | 353 | {-| Convert a function that updates the state to a function that updates an undo-list. 354 | This is very useful to allow you to write update functions that only deal with 355 | the individual states of your system and treat undo/redo as an add on. 356 | 357 | Example: 358 | 359 | -- Your update function 360 | update msg state = 361 | case msg of 362 | ... -- some implementation 363 | 364 | -- Your new update function 365 | updateWithUndo = UndoList.update update 366 | 367 | -} 368 | update : (msg -> state -> state) -> Msg msg -> UndoList state -> UndoList state 369 | update updater wrapperMessage undolist = 370 | case wrapperMessage of 371 | Reset -> 372 | reset undolist 373 | 374 | Redo -> 375 | redo undolist 376 | 377 | Undo -> 378 | undo undolist 379 | 380 | Forget -> 381 | forget undolist 382 | 383 | New msg -> 384 | new (updater msg undolist.present) undolist 385 | 386 | 387 | {-| Alias for `foldl` 388 | -} 389 | reduce : (a -> b -> b) -> b -> UndoList a -> b 390 | reduce = 391 | foldl 392 | 393 | 394 | {-| Reduce an undo-list from the left (or from the past) 395 | -} 396 | foldl : (a -> b -> b) -> b -> UndoList a -> b 397 | foldl reducer initial { past, present, future } = 398 | List.foldr reducer initial past 399 | |> reducer present 400 | |> (\b -> List.foldl reducer b future) 401 | 402 | 403 | {-| Reduce an undo-list from the right (or from the future) 404 | -} 405 | foldr : (a -> b -> b) -> b -> UndoList a -> b 406 | foldr reducer initial { past, present, future } = 407 | List.foldr reducer initial future 408 | |> reducer present 409 | |> (\b -> List.foldl reducer b past) 410 | 411 | 412 | {-| Reverse an undo-list. 413 | -} 414 | reverse : UndoList a -> UndoList a 415 | reverse { past, present, future } = 416 | UndoList future present past 417 | 418 | 419 | {-| Flatten an undo-list of undo-lists into a single undo-list. 420 | -} 421 | flatten : UndoList (UndoList a) -> UndoList a 422 | flatten { past, present, future } = 423 | UndoList (present.past ++ List.reverse (List.concatMap toList past)) 424 | present.present 425 | (present.future ++ List.concatMap toList future) 426 | 427 | 428 | {-| Map over an undo-list and then flatten the result. 429 | -} 430 | flatMap : (a -> UndoList b) -> UndoList a -> UndoList b 431 | flatMap f = 432 | map f >> flatten 433 | 434 | 435 | {-| Chain undo-list operations. This is simply an alias of `flatMap` 436 | -} 437 | andThen : (a -> UndoList b) -> UndoList a -> UndoList b 438 | andThen = 439 | flatMap 440 | 441 | 442 | {-| Connect two undo-lists end to end. The present of the first undolist is 443 | considered the present of the output undolist. 444 | -} 445 | connect : UndoList state -> UndoList state -> UndoList state 446 | connect { past, present, future } undolist = 447 | UndoList past present (future ++ toList undolist) 448 | 449 | 450 | 451 | ---------------- 452 | -- Shorthands -- 453 | ---------------- 454 | 455 | 456 | {-| Function to help not having to deal with the full undolist from with 457 | your actual view function. 458 | 459 | Suppose you define the following: 460 | 461 | initial : model 462 | 463 | update : msg -> model -> model 464 | 465 | view : model -> Html (UndoList.Msg msg) 466 | 467 | Then, you could construct the main function as follows: 468 | 469 | main = 470 | Html.beginnerProgram 471 | { model = UndoList.fresh initial 472 | , update = UndoList.update update 473 | , view = UndoList.view view 474 | } 475 | 476 | -} 477 | view : (state -> view) -> UndoList state -> view 478 | view viewer { present } = 479 | viewer present 480 | 481 | 482 | 483 | ----------------- 484 | -- Conversions -- 485 | ----------------- 486 | 487 | 488 | {-| Convert an undo-list to a list : 489 | 490 | toList (UndoList [ 3, 2, 1 ] 4 [ 5, 6 ]) 491 | --> [ 1, 2, 3, 4, 5, 6 ] 492 | 493 | -} 494 | toList : UndoList state -> List state 495 | toList { past, present, future } = 496 | List.reverse past ++ [ present ] ++ future 497 | 498 | 499 | {-| Convert a list to undolist. The provided state is used as the present 500 | state and the list is used as the future states. 501 | 502 | fromList 1 [ 2, 3, 4 ] 503 | --> UndoList [] 1 [ 2, 3, 4 ] 504 | 505 | -} 506 | fromList : state -> List state -> UndoList state 507 | fromList present future = 508 | UndoList [] present future 509 | -------------------------------------------------------------------------------- /src/UndoList/Decode.elm: -------------------------------------------------------------------------------- 1 | module UndoList.Decode exposing (undolist, msg) 2 | 3 | {-| Decode UndoList submodule. 4 | 5 | Provides JSON decoders for Timelines and UndoList Messages. 6 | 7 | 8 | # Decoders 9 | 10 | @docs undolist, msg 11 | 12 | -} 13 | 14 | import Json.Decode as Decode exposing (Decoder) 15 | import UndoList exposing (Msg(..), UndoList) 16 | 17 | 18 | {-| Decode an undo-list given a decoder of state. 19 | 20 | import Json.Decode 21 | 22 | json : String 23 | json = """{ 24 | "past": [ 1, 2 ], 25 | "present": 3, 26 | "future": [ 4, 5 ] 27 | }""" 28 | 29 | Json.Decode.decodeString (undolist Json.Decode.int) json 30 | --> Ok { past = [ 1, 2 ], present = 3, future = [ 4, 5 ] } 31 | -} 32 | undolist : Decoder state -> Decoder (UndoList state) 33 | undolist state = 34 | Decode.map3 UndoList 35 | (Decode.field "past" (Decode.list state)) 36 | (Decode.field "present" state) 37 | (Decode.field "future" (Decode.list state)) 38 | 39 | 40 | {-| Decode an undo-list msg given a decoder of messages. 41 | 42 | import Json.Decode 43 | import UndoList exposing (Msg(..)) 44 | 45 | Json.Decode.decodeString (msg Json.Decode.string) "{ \"New\": \"Hello!\" }" 46 | --> Ok (New "Hello!") 47 | 48 | json : String 49 | json = """[ "Reset", "Redo", "Undo", "Forget", { "New": 1 } ]""" 50 | 51 | Json.Decode.decodeString (Json.Decode.list <| msg Json.Decode.int) json 52 | --> Ok [ Reset, Redo, Undo, Forget, New 1 ] 53 | -} 54 | msg : Decoder msg -> Decoder (Msg msg) 55 | msg decoder = 56 | let 57 | unionDecoder = 58 | Decode.string 59 | |> Decode.map decodeMsgString 60 | |> Decode.andThen fromResult 61 | in 62 | Decode.oneOf 63 | [ unionDecoder 64 | , Decode.map New (Decode.field "New" decoder) 65 | ] 66 | 67 | 68 | fromResult : Result String a -> Decode.Decoder a 69 | fromResult result = 70 | case result of 71 | Ok val -> 72 | Decode.succeed val 73 | 74 | Err reason -> 75 | Decode.fail reason 76 | 77 | 78 | decodeMsgString : String -> Result String (Msg msg) 79 | decodeMsgString str = 80 | if str == "Reset" then 81 | Ok Reset 82 | else if str == "Redo" then 83 | Ok Redo 84 | else if str == "Undo" then 85 | Ok Undo 86 | else if str == "Forget" then 87 | Ok Forget 88 | else 89 | Err (str ++ " is not a valid undolist message") 90 | -------------------------------------------------------------------------------- /src/UndoList/Encode.elm: -------------------------------------------------------------------------------- 1 | module UndoList.Encode exposing (undolist, msg) 2 | 3 | {-| Encode UndoList submodule. 4 | 5 | Provides JSON encoders for Timelines and UndoList Messages. 6 | 7 | 8 | # Encoders 9 | 10 | @docs undolist, msg 11 | 12 | -} 13 | 14 | import Json.Encode as Encode exposing (Value) 15 | import UndoList exposing (Msg(..), UndoList) 16 | 17 | 18 | {-| Encode an undolist of JSON values. 19 | Best paired with the `map` function from UndoList. 20 | 21 | encodeUndoList stateEncoder = 22 | UndoList.map stateEncoder >> undolist 23 | 24 | -} 25 | undolist : UndoList Value -> Value 26 | undolist { past, present, future } = 27 | Encode.object 28 | [ ( "past", Encode.list identity past ) 29 | , ( "present", present ) 30 | , ( "future", Encode.list identity future ) 31 | ] 32 | 33 | 34 | {-| Encode an UndoList Msg of JSON values. 35 | Best paired with the `mapMsg` function from UndoList. 36 | 37 | encodeMsg msgEncoder = 38 | UndoList.mapMsg msgEncoder >> msg 39 | 40 | -} 41 | msg : Msg Value -> Value 42 | msg wrapperMessage = 43 | case wrapperMessage of 44 | Reset -> 45 | Encode.string "Reset" 46 | 47 | Redo -> 48 | Encode.string "Redo" 49 | 50 | Undo -> 51 | Encode.string "Undo" 52 | 53 | Forget -> 54 | Encode.string "Forget" 55 | 56 | New value -> 57 | Encode.object [ ( "New", value ) ] 58 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (..) 2 | 3 | import Expect 4 | import Fuzz exposing (Fuzzer) 5 | import Test exposing (Test, describe, test) 6 | import UndoList exposing (UndoList, Msg(..)) 7 | import UndoList.Encode as Encode 8 | import UndoList.Decode as Decode 9 | import Json.Decode exposing (Decoder) 10 | import Json.Encode exposing (Value) 11 | 12 | 13 | encoding_and_decoding_inverse : Test 14 | encoding_and_decoding_inverse = 15 | Test.fuzz (undoListFuzzer Fuzz.int) "Encoding and decoding functions are inverse operations" <| 16 | \undolist -> 17 | undolist 18 | |> encodeThenDecode (Json.Encode.int) (Json.Decode.int) 19 | |> Expect.equal (Ok undolist) 20 | 21 | 22 | undolist_length_atleastone : Test 23 | undolist_length_atleastone = 24 | Test.fuzz (undoListFuzzer Fuzz.int) "The length of an undo list is at least one" <| 25 | \undolist -> 26 | UndoList.length undolist 27 | |> Expect.atLeast 1 28 | 29 | 30 | redo_does_not_change_length : Test 31 | redo_does_not_change_length = 32 | Test.fuzz (undoListFuzzer Fuzz.int) "Redo does not change the length of an undo list" <| 33 | \undolist -> 34 | UndoList.redo undolist 35 | |> UndoList.length 36 | |> Expect.equal (UndoList.length undolist) 37 | 38 | 39 | undo_does_not_change_length : Test 40 | undo_does_not_change_length = 41 | Test.fuzz (undoListFuzzer Fuzz.int) "Undo does not change the length of an undo list" <| 42 | \undolist -> 43 | UndoList.undo undolist 44 | |> UndoList.length 45 | |> Expect.equal (UndoList.length undolist) 46 | 47 | 48 | forget_produces_empty_past : Test 49 | forget_produces_empty_past = 50 | Test.fuzz (undoListFuzzer Fuzz.int) "After forgetting the past, the past of the undo list is empty" <| 51 | \undolist -> 52 | UndoList.forget undolist 53 | |> UndoList.lengthPast 54 | |> Expect.equal 0 55 | 56 | 57 | new_produces_empty_future : Test 58 | new_produces_empty_future = 59 | Test.fuzz2 (Fuzz.float) (undoListFuzzer Fuzz.float) "Adding a new state yields an empty future" <| 60 | \item undolist -> 61 | UndoList.new item undolist 62 | |> UndoList.lengthFuture 63 | |> Expect.equal 0 64 | 65 | 66 | new_adds_one_length_past : Test 67 | new_adds_one_length_past = 68 | Test.fuzz2 (Fuzz.string) (undoListFuzzer Fuzz.string) "Adding a new state adds one element to the past" <| 69 | \item undolist -> 70 | UndoList.new item undolist 71 | |> UndoList.lengthPast 72 | |> Expect.equal (UndoList.lengthPast undolist + 1) 73 | 74 | 75 | undo_and_redo_inverse : Test 76 | undo_and_redo_inverse = 77 | Test.fuzz (undoListFuzzer Fuzz.int) "Undo and redo are inverse operations" <| 78 | \undolist -> 79 | undolist 80 | |> undo_redo 81 | |> Expect.equal undolist 82 | 83 | 84 | redo_and_undo_inverse : Test 85 | redo_and_undo_inverse = 86 | Test.fuzz (undoListFuzzer Fuzz.int) "Redo and undo are inverse operations" <| 87 | \undolist -> 88 | undolist 89 | |> redo_undo 90 | |> Expect.equal undolist 91 | 92 | 93 | new_then_undo_yields_same_present : Test 94 | new_then_undo_yields_same_present = 95 | Test.fuzz2 (Fuzz.string) (undoListFuzzer Fuzz.string) "Calling new then undo preserves the original present state" <| 96 | \item undolist -> 97 | undolist 98 | |> UndoList.new item 99 | |> UndoList.undo 100 | |> .present 101 | |> Expect.equal undolist.present 102 | 103 | 104 | reset_equivalent_fresh_oldest : Test 105 | reset_equivalent_fresh_oldest = 106 | Test.fuzz (undoListFuzzer Fuzz.int) "Resetting an undo list is equivalent to creating an undo list with the oldest state" <| 107 | \undolist -> 108 | UndoList.reset undolist 109 | |> Expect.equal (fresh_oldest undolist) 110 | 111 | 112 | state_machine_length : Test 113 | state_machine_length = 114 | Test.fuzz2 (Fuzz.list <| msgFuzzer Fuzz.int) (undoListFuzzer Fuzz.int) "State Machine is consistent with respect to length" <| 115 | \msgs undolist -> 116 | state_machine_update msgs undolist 117 | |> Expect.equal (state_machine_step msgs undolist) 118 | 119 | 120 | 121 | -- Test Helpers 122 | 123 | 124 | msgFuzzer : Fuzzer a -> Fuzzer (Msg a) 125 | msgFuzzer fuzzer = 126 | Fuzz.frequency 127 | [ ( 1, Fuzz.constant Reset ) 128 | , ( 1, Fuzz.constant Forget ) 129 | , ( 6, Fuzz.constant Undo ) 130 | , ( 6, Fuzz.constant Redo ) 131 | , ( 6, Fuzz.map New fuzzer ) 132 | ] 133 | 134 | 135 | undoListFuzzer : Fuzzer a -> Fuzzer (UndoList a) 136 | undoListFuzzer fuzzer = 137 | Fuzz.map3 UndoList 138 | (Fuzz.list fuzzer) 139 | fuzzer 140 | (Fuzz.list fuzzer) 141 | 142 | 143 | encodeThenDecode : (state -> Value) -> Decoder state -> UndoList state -> Result Json.Decode.Error (UndoList state) 144 | encodeThenDecode encoder decoder undolist = 145 | let 146 | encoded = 147 | undolist 148 | |> UndoList.map encoder 149 | |> Encode.undolist 150 | 151 | decoded = 152 | Json.Decode.decodeValue (Decode.undolist decoder) encoded 153 | in 154 | decoded 155 | 156 | 157 | undo_redo : UndoList state -> UndoList state 158 | undo_redo undolist = 159 | if UndoList.hasPast undolist then 160 | UndoList.undo undolist 161 | |> UndoList.redo 162 | else 163 | undolist 164 | 165 | 166 | redo_undo : UndoList state -> UndoList state 167 | redo_undo undolist = 168 | if UndoList.hasFuture undolist then 169 | UndoList.redo undolist 170 | |> UndoList.undo 171 | else 172 | undolist 173 | 174 | 175 | fresh_oldest : UndoList state -> UndoList state 176 | fresh_oldest undolist = 177 | undolist.past 178 | |> List.reverse 179 | |> List.head 180 | |> Maybe.withDefault undolist.present 181 | |> UndoList.fresh 182 | 183 | 184 | state_machine_update : List (Msg Int) -> UndoList Int -> List ( Int, Int ) 185 | state_machine_update msgs undolist = 186 | msgs 187 | |> List.map update 188 | |> pipe undolist 189 | |> List.map (\l -> ( UndoList.lengthPast l, UndoList.lengthFuture l )) 190 | 191 | 192 | state_machine_step : List (Msg Int) -> UndoList Int -> List ( Int, Int ) 193 | state_machine_step msgs undolist = 194 | msgs 195 | |> List.map step 196 | |> pipe ( UndoList.lengthPast undolist, UndoList.lengthFuture undolist ) 197 | 198 | 199 | update : Msg a -> UndoList a -> UndoList a 200 | update msg undolist = 201 | case msg of 202 | Reset -> 203 | UndoList.reset undolist 204 | 205 | Redo -> 206 | UndoList.redo undolist 207 | 208 | Undo -> 209 | UndoList.undo undolist 210 | 211 | Forget -> 212 | UndoList.forget undolist 213 | 214 | New n -> 215 | UndoList.new n undolist 216 | 217 | 218 | step : Msg a -> ( Int, Int ) -> ( Int, Int ) 219 | step msg ( pastLen, futureLen ) = 220 | case msg of 221 | Reset -> 222 | ( 0, 0 ) 223 | 224 | Redo -> 225 | if futureLen == 0 then 226 | ( pastLen, futureLen ) 227 | else 228 | ( pastLen + 1, futureLen - 1 ) 229 | 230 | Undo -> 231 | if pastLen == 0 then 232 | ( pastLen, futureLen ) 233 | else 234 | ( pastLen - 1, futureLen + 1 ) 235 | 236 | Forget -> 237 | ( 0, futureLen ) 238 | 239 | New _ -> 240 | ( pastLen + 1, 0 ) 241 | 242 | 243 | pipe : state -> List (state -> state) -> List state 244 | pipe state msgs = 245 | case msgs of 246 | [] -> 247 | [ state ] 248 | 249 | f :: fs -> 250 | state :: pipe (f state) fs 251 | -------------------------------------------------------------------------------- /tests/elm-verify-examples.json: -------------------------------------------------------------------------------- 1 | { 2 | "root": "../src", 3 | "tests": ["UndoList", "UndoList.Encode", "UndoList.Decode"] 4 | } 5 | --------------------------------------------------------------------------------