Created
July 18, 2016 20:47
-
-
Save z5h/d714ae8ba44a4cd75c607393a55c45ca to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Stopwatch | |
import Html exposing (..) | |
import Html.App as App | |
import Html.Attributes exposing (..) | |
import Html.Events exposing (..) | |
main: Program Never | |
main = | |
App.program | |
{ init = init | |
, update = update | |
, view = view | |
, subscriptions = subscriptions | |
} | |
subscriptions : Model -> Sub Msg | |
subscriptions model = | |
Sub.batch (List.map stopwatchSubscription model.stopwatches) | |
stopwatchSubscription : IndexedStopwatch -> Sub Msg | |
stopwatchSubscription o = | |
Sub.map (Modify o.id) (Stopwatch.subscriptions o.model) | |
-- MODEL | |
type alias Model = | |
{ stopwatches : List IndexedStopwatch | |
, uid : Int | |
} | |
type alias IndexedStopwatch = | |
{ id : Int | |
, model : Stopwatch.Model | |
} | |
init : (Model, Cmd Msg) | |
init = | |
({ stopwatches = [] | |
, uid = 0 | |
}, Cmd.none) | |
-- UPDATE | |
type Msg | |
= Insert | |
| Remove | |
| Modify Int Stopwatch.Msg | |
update : Msg -> Model -> (Model, Cmd Msg) | |
update message ({stopwatches, uid} as model) = | |
case message of | |
Insert -> | |
let | |
(newModel, newCmdMsg) = Stopwatch.init | |
in | |
({ model | |
| stopwatches = stopwatches ++ [ IndexedStopwatch uid newModel ] | |
, uid = uid + 1 | |
}, Cmd.map (Modify uid) newCmdMsg) | |
Remove -> | |
({ model | stopwatches = List.drop 1 stopwatches }, Cmd.none) | |
Modify id msg -> | |
let | |
stopwatchesAndCommands = updateWatches id msg stopwatches | |
in | |
({ model | stopwatches = List.map fst stopwatchesAndCommands }, Cmd.batch (List.map snd stopwatchesAndCommands) ) | |
type alias ImportMessage otherMessage id thisMessage = (otherMessage -> id -> thisMessage) -> otherMessage -> id -> thisMessage | |
updateWatches : Int -> Stopwatch.Msg -> List IndexedStopwatch -> List (IndexedStopwatch, Cmd Msg) | |
updateWatches id msg = List.map (updateHelp id msg) | |
updateHelp : Int -> Stopwatch.Msg -> IndexedStopwatch -> (IndexedStopwatch, Cmd Msg) | |
updateHelp targetId msg {id, model} = | |
let | |
newModelAndCmd = | |
if targetId == id then | |
Stopwatch.update msg model | |
else | |
(model, Cmd.none) | |
in | |
(IndexedStopwatch id (fst newModelAndCmd), Cmd.map (Modify id) (snd newModelAndCmd)) | |
-- VIEW | |
view : Model -> Html Msg | |
view model = | |
let | |
remove = | |
button [ onClick Remove ] [ text "Remove" ] | |
insert = | |
button [ onClick Insert ] [ text "Add" ] | |
stopwatches = | |
List.map viewIndexedCounter model.stopwatches | |
in | |
div [] ([remove, insert] ++ stopwatches) | |
viewIndexedCounter : IndexedStopwatch -> Html Msg | |
viewIndexedCounter {id, model} = | |
App.map (Modify id) (Stopwatch.view model) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Stopwatch exposing (Model, Msg, init, update, view, subscriptions) | |
import Html.App | |
import Html exposing (..) | |
import Html.Attributes exposing (..) | |
import Html.Events exposing (onClick) | |
import Time exposing (..) | |
import Task | |
-- MODEL | |
main = | |
Html.App.program | |
{ init = init | |
, update = update | |
, view = view | |
, subscriptions = subscriptions | |
} | |
type alias Model = | |
{ on: Bool | |
, start : Time | |
, last : Time | |
} | |
init : (Model, Cmd Msg) | |
init = (Model True 0 0, requestTick) | |
-- UPDATE | |
type Msg | |
= Tick Time | |
| TickRequest Time | |
| Toggle Bool | |
| RequestTick | |
update : Msg -> Model -> (Model, Cmd Msg) | |
update msg model = | |
case msg of | |
RequestTick -> | |
(model, requestTick) | |
TickRequest time -> | |
({ model | start = time, last = (Debug.log "tickrequest" time) }, Cmd.none) | |
Tick time -> | |
if model.on then | |
({ model | last = time }, Cmd.none) | |
else | |
(model, Cmd.none) | |
Toggle on -> | |
({ model | on = on }, Cmd.none) | |
requestTick = | |
Task.perform (\_ -> Debug.crash "no time") TickRequest Time.now | |
-- VIEW | |
view : Model -> Html Msg | |
view model = | |
div [] | |
[ button [ onClick (Toggle (not model.on)) ] [ text "pause" ] | |
, button [ onClick RequestTick ] [ text "reset" ] | |
, div [ countStyle ] [ text (toString ( (model.last - model.start) / 1000)) ] | |
] | |
countStyle : Attribute msg | |
countStyle = | |
style | |
[ ("font-size", "20px") | |
, ("font-family", "monospace") | |
, ("display", "inline-block") | |
, ("width", "50px") | |
, ("text-align", "center") | |
] | |
subscriptions : Model -> Sub Msg | |
subscriptions model = | |
Time.every (5*millisecond) Tick |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment