Skip to content

Instantly share code, notes, and snippets.

@szabba
Created May 11, 2016 10:34
Show Gist options
  • Save szabba/067fb85b219a1891a6a654a45ba020da to your computer and use it in GitHub Desktop.
Save szabba/067fb85b219a1891a6a654a45ba020da to your computer and use it in GitHub Desktop.
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 ]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment