timehistory.elm

import Html exposing (Html)
import Html.Events exposing (onClick)
import Signal exposing (Signal, Address, Mailbox)
import Json.Decode as Decode exposing (Decoder, (:=))
import Json.Encode as Encode exposing (Value)
import List
--------------------------------------------
-- Example : 

initial = 0

update _ state = state + 1

view address state = 
  Html.div 
      []
      [ Html.button 
            [ onClick address (New ()) ]
            [ Html.text "Increment" ]
      , Html.button
            [ onClick address Undo ]
            [ Html.text "Undo" ]
      , Html.button
            [ onClick address Redo ]
            [ Html.text "Redo" ]
      , Html.button 
            [ onClick address Reset ]
            [ Html.text "Reset" ]    
      , Html.button
            [ onClick address Forget ]
            [ Html.text "Forget" ]
      , Html.span 
            []
            [ Html.text (toString (present state)) ]
      ]

{address, signal} = mailbox ()

main = 
  Signal.map (view address)
    (foldp update initial signal)

{-
initial = 0

update _ state = state + 1

view address state = 
  Html.div 
      []
      [ Html.button 
            [ onClick address () ]
            [ Html.text "Increment" ]
      , Html.div 
            []
            [ Html.text (toString state) ]
      ]

{address, signal} = mailbox ()

main = 
  Signal.map (view address)
    (Signal.foldp update initial signal)
-}
--------------------------------------------
type History state 
  = History (List state) state (List state)
  
type Action action 
  = Reset
  | Redo 
  | Undo 
  | Forget
  | New action
  
decode : Decoder state -> Decoder (History state)
decode state = 
  Decode.object3 History 
    ("past" := Decode.list state)
    ("present" := state)
    ("future" := Decode.list state)
    
    
encode : History Value -> Value
encode (History past present future) = 
  Encode.object 
    [ ("past", Encode.list past)
    , ("present", present)
    , ("future", Encode.list future)
    ]

{- TODO: Make a Random History Generator will elm-random-extra
random : Int -> Int -> Generator state -> Generator (History state)
random pastLength futureLength generator = 
  Random.map3 History
    (Random.list pastLength generator)
    (generator)
    (Random.list futureLength generator)
-}

map : (a -> b) -> History a -> History b
map f (History past present future) = 
  History (List.map f past) (f present) (List.map f future)


foldp : (action -> state -> state) -> state -> Signal (Action action) -> Signal (History state)
foldp update initial = 
  Signal.foldp (apply update) (fresh initial)

mailbox : action -> Mailbox (Action action)
mailbox action = 
  Signal.mailbox (New action)

apply : (action -> state -> state) -> Action action -> History state -> History state
apply update action history = 
  case action of
    Reset -> reset history
    Redo  -> redo history
    Undo  -> undo history
    Forget -> forget history
    New action -> new (update action (present history)) history

present : History state -> state
present (History _ present' _) = present'

past : History state -> List state
past (History past' _ _) = past' 

future : History state -> List state
future (History _ _ future') = future'


redo : History state -> History state 
redo (History past present future) = 
  case future of 
    [] -> 
      History past present future
    x :: xs -> 
      History (present :: past) x xs
      

undo : History state -> History state 
undo (History past present future) = 
  case past of 
    [] -> 
      History past present future
    x :: xs ->
      History xs x (present :: future)
      
      
new : state -> History state -> History state
new event (History past present _ ) = 
  History (present :: past) event []

fresh : state -> History state
fresh state = 
  History [] state []
  
reset : History state -> History state
reset (History past present _ ) =
  case past of 
    [] -> fresh present
    x :: xs -> 
      reset (History xs x [])

forget : History state -> History state
forget (History _ present future) = 
  History [] present future
-----------------------------------------------