setInterval.elm

import Graphics.Element exposing (..)
import Color exposing (blue, white)
import Task exposing (Task)
import Signal exposing (Mailbox, Address)
import Html exposing (Attribute, input)
import Html.Attributes exposing (type')
import Html.Events exposing (on, targetValue)
import Json.Decode exposing (Decoder)
import String

-- SIGNALS

main : Signal Element
main =
  Signal.map (view actionMailbox.address) modelSignal

actionMailbox : Mailbox Action
actionMailbox = Signal.mailbox Tick

modelAndTaskSignal : Signal (Model, Task () ())
modelAndTaskSignal =
  Signal.foldp update (initModel, Task.succeed ()) actionMailbox.signal

modelSignal : Signal Model
modelSignal =
  Signal.map fst modelAndTaskSignal

taskSignal : Signal (Task () ())
taskSignal =
  Signal.map snd modelAndTaskSignal

port tasks : Signal (Task () ())
port tasks =
  taskSignal

port initialTask : Task () ()
port initialTask =
  Signal.send actionMailbox.address Tick

-- ACTIONS

type Action
    = Tick
    | SetInterval String
    | NoOp

-- MODEL

type alias Model =
  { interval : Float
  , step : Int
  }

initModel : Model
initModel = Model 500 0

-- UPDATE

queueTick : Float -> Task () ()
queueTick interval =
  Task.sleep interval `Task.andThen` (\_ -> Signal.send actionMailbox.address Tick)

update : Action -> (Model, Task () ()) -> (Model, Task () ())
update action (model,_) =
  case action of
    Tick ->
      ({ model | step = if model.step < 5 then model.step + 1 else 0 }, queueTick model.interval)
    SetInterval interval ->
      ({ model | interval = (String.toFloat interval |> Result.withDefault model.interval)}, Task.succeed ())
    NoOp ->
      (model, Task.succeed ())


-- VIEW

blocks : Int -> Element
blocks step =
  let
    block index =
      spacer 50 50
        |> color (if index == step then blue else white)
  in
    List.map block [0..5]
      |> flow right

targetValueFloat : Decoder Float
targetValueFloat =
  Json.Decode.at ["target", "value"] Json.Decode.float

onRange : Address Action -> Attribute
onRange address = 
  on "input" targetValue (\str -> Signal.message address (SetInterval str))

slider : Address Action -> Element
slider address =
  input
    [ type' "range"
    , onRange address
    , Html.Attributes.min "20"
    , Html.Attributes.max "1000"
    ]
    []
    |> Html.toElement 200 200

view : Address Action -> Model -> Element
view address model =
  flow down
    [ blocks model.step
    , slider address
    ]