UI Components in Elm

Components.elm

import Html exposing (Html, button, text)
import Html.Attributes exposing (style)
import Html.Events exposing (..)

import Signal exposing (Signal, Mailbox, Address, mailbox, send)

import Task exposing (Task, andThen, succeed, spawn, ThreadID)

import Graphics.Element exposing (show)

(:::) = (,)

type alias Style = List (String, String)


type alias Component state action view 
  =  { state   : Signal state
     , view    : Signal view
     , address : Address action 
     , history : Signal (List action)
     }


makeComponent 
  :  state 
  -> action 
  -> (action -> state -> state) 
  -> (Address action -> state -> view) 
  -> Component state action view
makeComponent initialState initialAction update view = 
  let
      componentMailbox = mailbox initialAction
      address = componentMailbox.address
      actions = componentMailbox.signal
      history = Signal.foldp (\a b -> a :: b) [] actions
      state = Signal.foldp update initialState actions
      view' = Signal.map (view address) state
  in
      { state   = state 
      , view    = view' 
      , address = address 
      , history = history
      }
      
      
type ButtonSelectionState 
  = Active
  | Idle
  | Disabled
  | Selected
  
  
type alias ButtonState = 
  { label : String
  , selectionState : ButtonSelectionState
  }
  
buttonColor state = 
  case state of
    Active   -> "green"
    Idle     -> "white"
    Disabled -> "gray"
    Selected -> "blue"

buttonStyle state = 
  [ "background-color" ::: buttonColor state
  , "transition" ::: "background-color 0.2s ease-out" 
  ]
  
  
type ButtonAction 
  = Click
  | Hover
  | Disable
  | ChangeLabel String


myButton : Component ButtonState (Maybe ButtonAction) Html
myButton =
  let
      initialState : ButtonState
      initialState  = 
        { label           = "Button"
        , selectionState  = Idle
        }
      
      initialAction : Maybe ButtonAction
      initialAction = Nothing
      
      update : Maybe ButtonAction -> ButtonState -> ButtonState
      update maybeAction state = 
        case maybeAction of
          Nothing     -> 
            { state | selectionState <- Idle }
          Just action -> 
            case action of
              Click   -> 
                { state | selectionState <- Selected }
              Hover   -> 
                { state | selectionState <- Active }
              Disable -> 
                { state | selectionState <- Disabled }
              ChangeLabel label ->
                { state | label <- label }
              
      view : Address (Maybe ButtonAction) -> ButtonState -> Html
      view address state = 
        button
          [ style (buttonStyle state.selectionState) 
          , onMouseDown address (Just Click)
          , onMouseUp address (Just Hover)
          , onMouseOver address (Just Hover)
          , onMouseLeave address Nothing
          ]
          [ text state.label ]
          
  in
      makeComponent initialState initialAction update view
              
              
incrementCounter n = 
  succeed n 
    `andThen` \n -> (succeed (toString n))
    `andThen` \label -> send myButton.address (Just (ChangeLabel label))
    `andThen` \_ -> spawn (incrementCounter (n + 1))
    

counterIncrementMailbox = 
  mailbox (incrementCounter 0)
  
  
--port counterIncrementPort : Signal (Task error ThreadID)
--port counterIncrementPort = 
--  counterIncrementMailbox.signal
   
main = myButton.view 
--main = Signal.map show myButton.history
--main = Signal.map show myButton.state