DebuggerAsALibrary.elm

import Html exposing (Html)
import Html.App as App
import Html.Events as Events



main =
    new
        0
        (\diff count -> (diff + count) ! [ Cmd.none ])
        (\count ->
            Html.div [] [ button -1 "-", Html.text <| toString count, button 1 "+"])
        (always Sub.none)
    |> toApp


-- MODEL


type Debug msg model =
    Debug
        { model : model
        , update : msg -> model -> (model, Cmd msg)
        , view : model -> Html msg
        , subscriptions : model -> Sub msg
        , past : List model
        , future : List model
        , paused : Bool
        }


new
    : model
    -> (msg -> model -> (model, Cmd msg))
    -> (model -> Html msg)
    -> (model -> Sub msg)
    -> Debug msg model
new model update view subs =
    Debug
        { model = model, update = update, view = view, subscriptions = subs
        , past = [], future = [], paused = False
        }


toApp : Debug msg model -> Program Never
toApp model =
    App.program
        { init = (model, Cmd.none), update = update, view = view, subscriptions = subscriptions }


subscriptions : Debug msg model -> Sub (Msg msg)
subscriptions (Debug debug) =
    Sub.map Wrap <| debug.subscriptions debug.model


-- UPDATE


type Msg msg
    = Wrap msg
    | Pause
    | Unpause
    | MoveBack
    | MoveForward


update : Msg msg -> Debug msg model -> (Debug msg model, Cmd (Msg msg))
update msg (Debug debug) =
    case msg of
        Wrap msg ->
            if debug.paused then
                (debug |> Debug) ! [ Cmd.none ]
            else
              let
                  (newInnerModel, innerCmd) = debug.update msg debug.model
                  newDebug =
                      { debug
                      | model = newInnerModel
                      , past = debug.model :: debug.past
                      , future = []
                      }
                      |> Debug
                  cmds = [ Cmd.map Wrap innerCmd ]
              in
                  newDebug ! cmds
        Pause ->
            { debug | paused = True } |> withoutEffects
        Unpause ->
            { debug | paused = False } |> withoutEffects
        MoveForward ->
            case debug.future |> List.head of
                Nothing ->
                    debug |> withoutEffects
                Just newModel ->
                    let
                        newPast = debug.model :: debug.past
                        newFuture = debug.future |> List.tail |> Maybe.withDefault []
                    in
                        { debug | past = newPast, model = newModel, future = newFuture }
                        |> withoutEffects
        MoveBack ->
            case debug.past |> List.head of
                Nothing ->
                    debug |> withoutEffects
                Just newModel ->
                    let
                        newPast = debug.past |> List.tail |> Maybe.withDefault []
                        newFuture = debug.model :: debug.future
                    in
                        { debug | past = newPast, model = newModel, future = newFuture }
                        |> withoutEffects


withoutEffects
    : { future : List a
      , model : a
      , past : List a
      , paused : Bool
      , subscriptions : a -> Sub b
      , update : b -> a -> ( a, Cmd b )
      , view : a -> Html b
      }
    -> ( Debug b a, Cmd c )
withoutEffects = Debug >> flip (!) [ Cmd.none ]


-- VIEW


view : Debug msg model -> Html (Msg msg)
view (Debug debug) =
    Html.div
        []
        [ App.map Wrap <| debug.view debug.model
        , debugBar (Debug debug)
        ]


debugBar : Debug msg model -> Html (Msg msg)
debugBar (Debug debug) =
    Html.div
        []
        [ if debug.paused then
              button Unpause "|>"
          else
              button Pause "||"
        , button MoveBack "<<"
        , button MoveForward ">>"
        ]


button : msg -> String -> Html msg
button msg text =
    Html.button [ Events.onClick msg ] [ Html.text text ]