compaltcounterpair.elm

import Signal exposing (Address)
import Html exposing (Html, div, button, span, text)
import Html.Events exposing (onClick)


type alias Component action state effect view
  = Maybe action -> state -> (state, view, List effect)
  
  
type alias HtmlComponent action state effect 
  = Component action state effect (Address action -> Html)
 
 
------------------------------------- 
 
type alias State = 
  { top    : Int
  , bottom : Int
  }
 
 
type PairAction
  = Top Action
  | Bottom Action
  

counterPair : HtmlComponent PairAction State Never
counterPair action oldState = 
  let 
      ( (topState, topView, topEffects)
      , (bottomState, bottomView, bottomEffects)
      ) = 
        case action of 
          Nothing ->
            ( counter Nothing oldState.top
            , counter Nothing oldState.bottom
            )
            
          Just (Top counterAction) ->
            ( counter (Just counterAction) oldState.top
            , counter Nothing oldState.bottom
            )

          Just (Bottom counterAction) ->
            ( counter Nothing oldState.top
            , counter (Just counterAction) oldState.bottom
            )
            
      state = 
        { top    = topState
        , bottom = bottomState
        }
         
      view address =  
        div 
          []
          [ topView (Signal.forwardTo address Top)
          , bottomView (Signal.forwardTo address Bottom)
          ]
       
      effects = 
        topEffects ++ bottomEffects
         
  in 
      (state, view, effects)
            
 
 
 
 
--------------------------------------
  
type Action
  = Increment
  | Decrement
  
  
counter : HtmlComponent Action Int Never
counter action oldState = 
  let
      state = 
        case action of 
          Nothing ->
            oldState
            
          Just Increment -> 
            oldState + 1
          
          Just Decrement -> 
            oldState - 1
            
      
      view address =
        div
          []
          [ button 
              [ onClick address Increment ]
              [ text "+" ]
          , button 
              [ onClick address Decrement ]
              [ text "-" ]
          , span 
              []
              [ text (toString state) ]
          ]
              
  in 
        (state, view, [])
        
        
main = 
  run counterPair (State 0 0)
  |> .views
        
--------------------------------------------        
run : HtmlComponent action state effect
   -> state
   -> Output action state effect Html
run component initialState = 
  let
      {address, signal} = 
        Signal.mailbox Nothing
        
      componentAddress = 
        Signal.forwardTo address Just
        
      initial = 
        component Nothing initialState
        
      update action (state, _, _) = 
        component action state
        
      outputs = 
        Signal.foldp update initial signal
        
  in 
      { states  = Signal.map (\(a,_,_) -> a) outputs
      , effects = Signal.map (\(_,_,b) -> b) outputs
      , views   = Signal.map (\(_,f,_) -> f componentAddress) outputs
      , actions = signal
      }
        
        

type alias Output action state effect view = 
  { states  : Signal state
  , effects : Signal (List effect)
  , views   : Signal view
  , actions : Signal (Maybe action)
  }
        
type Never = Never Never