An example of a genericized undo/redo in Elm

undo.elm

import List
import List ((::))
import Signal
import Signal ((<~), (~))

import Html
import Html (div, text, button, ul, input, li, p, label)
import Html.Attributes (disabled, type', name, id, value, checked)
import Html.Events (onClick, on, targetValue)

type Update =
         TodoUpdate TodoUpdate_
       | ToolbarUpdate ToolbarUpdate_
       | QuickEntryUpdate QuickEntryUpdate_
       | NoOp
       
type alias AppState =
  { todos : List Todo
  , placeholderText : String
  , undoHistory : StateHistory (List Todo)
  }

startingState =
  { todos = []
  , placeholderText = ""
  , undoHistory = defaultHistory [] []
  }

type LocalChannel a =
  LocalChannel (a -> Signal.Message)

localize : (local -> general) -> Signal.Channel general -> LocalChannel local
localize generalize channel =
  LocalChannel (\v -> Signal.send channel (generalize v))
  
send : LocalChannel a -> a -> Signal.Message
send (LocalChannel localizedSend) value =
  localizedSend value
  
  
main = 
  container <~ process

updates =
  Signal.channel NoOp
  

container state =
  let toolbarChannel = localize ToolbarUpdate updates
      quickEntryChannel = localize QuickEntryUpdate updates
      todoChannel = localize TodoUpdate updates
  in
  Html.toElement 500 500
      <| Html.div 
          [] 
          [ toolbar toolbarChannel True True
          , quickEntry quickEntryChannel state.placeholderText
          , todoList todoChannel state.todos
          ]
          
process =
  Signal.foldp step startingState
    <| Signal.subscribe updates
          
step : Update -> AppState -> AppState
step update state =
  case update of
    ToolbarUpdate Undo ->
      
    TodoUpdate (ToggleComplete todo) ->
      let updatedTodos = toggleOneCompleted todo state.todos
      in
        { state | todos <- updatedTodos,
                  undoHistory <- recordPastEntry state.todos state.undoHistory }
    QuickEntryUpdate (UpdatePlaceholder newText) ->
      { state | placeholderText <- newText }
    QuickEntryUpdate AddTodo -> 
      let newTask = { startingTodo | name <- state.placeholderText }
      in
        { state | todos <- newTask :: state.todos,
                  placeholderText <- "" }
    NoOp -> state

-- TOOLBAR

type ToolbarUpdate_ =
        Undo
      | Redo
      | NoOp'
      
toolbar channel undoEnabled redoEnabled =
  Html.div []
    [ button
        [onClick <| send channel Undo
        , disabled <| not undoEnabled ]
        [ text "Undo" ]
    , button
        [ onClick <| send channel Redo
        , disabled <| not redoEnabled
        ]
        [ text "Redo" ]
    ]


-- QUICK ENTRY

type QuickEntryUpdate_ =
        AddTodo
      | UpdatePlaceholder String
      | NoOp''
      
quickEntry channel placeholder =
  Html.div []
    [ input
        [ type' "text"
        , name "new-todo-entry"
        , id "new-todo-entry"
        , on "input" targetValue (\v -> send channel <| UpdatePlaceholder v)
        , value placeholder
        ]
        []
    , button
        [ onClick <| send channel AddTodo
        ]
        [ text "Create task from entry" ]
    ]

-- TODO LIST

todoList todoChannel todos =
  ul [] <| List.map (todo todoChannel) todos
  
  
-- TODO
 
type TodoUpdate_ =
       Remove
     | ToggleComplete Todo
     | SortUp
     | SortDown
     | NoOp'''
     

type alias Todo =
  { name : String
  , completed : Bool
  , sort : Int
  }
  
startingTodo =
  { name = ""
  , completed = False
  , sort = 0
  }

toggleOneCompleted : Todo -> List Todo -> List Todo
toggleOneCompleted todo =
  let toggleCompleted todo = { todo | completed <- not todo.completed }
  in
    List.map (\t -> if t == todo then toggleCompleted todo else t)
todo channel todo' =
 li []
     [ label []
         [
           input
            [ type' "checkbox"
            , name "complete-todo"
            , checked todo'.completed
            , onClick
                <| send channel
                <| ToggleComplete todo'
            ]
            []
         , text todo'.name
         ]
     , button []
       [ text "Move Up" ]
     , button []
       [ text "Move Down" ]
     ]
     

-- UNDO/REDO

type alias StateHistory a =
  { past : List a
  , future : List a
  , current : a
  , startingState : a
  }
  
defaultHistory current starting =
  { past = []
  , future = []
  , current = current
  , startingState = starting
  }
  

resetHistory : StateHistory a -> StateHistory a
resetHistory history =
  defaultHistory history.startingState history.startingState

recordPastEntry : a -> StateHistory a -> StateHistory a
recordPastEntry a history =
  { history | past <- a :: history.past }
  
runUndo : StateHistory a -> StateHistory a
runUndo history =
  case history.past of
    (_ :: previous :: rest) ->
      { history | current <- previous
                , past <- rest
      }
    (previous :: rest) ->
      { history | current <- previous
                , past <- rest
      }
    [] ->
      resetHistory history
  
retrievePast : StateHistory a -> StateHistory a
retrievePast history =
  let newHistory = if List.isEmpty history.past
                      then resetHistory history
                      else runUndo history
  in
    newHistory