Scroll List in Elm

ScrollList.elm

import Html exposing (Html, Attribute)
import Html.Attributes 
import Html.Events
import Json.Decode exposing (Decoder, (:=))
import List
import Signal exposing (Address)
import StartApp
import Array exposing (Array)
import Window
 
--------------
infixl 2 =>
(=>) = (,)
 
type alias Vector = 
  { x : Float , y : Float }
 
 
updateNArray : Int -> (a -> a) -> Array a -> Array a 
updateNArray index f array = 
  case Array.get index array of 
    Nothing ->
      array
      
    Just x ->
      Array.set index (f x) array
      
      
scrollTop : Decoder Float 
scrollTop = 
  Json.Decode.at [ "target" , "scrollTop" ] Json.Decode.float
 
 
onScroll : Address a -> (Float -> a) -> Attribute
onScroll address constructor = 
  Html.Events.on "scroll" scrollTop (Signal.message address << constructor)
  
--------------
 
type alias State cellState = 
  { cells  : Array cellState 
  , offset : Float
  , bufferSize : Int
  , size : Vector
  , cellHeight : Float
  }
  
  
init : Array cellState -> State cellState 
init array = 
  { cells  = array
  , offset = 0
  , bufferSize = 10
  , size = { x = 400 , y = 400 }
  , cellHeight = 40 
  }
 
  
  
type alias CellContext = 
  { size : Vector }
  
    
type Action cellAction
  = CellAction Int cellAction
  | Scroll Float
  | Resize Vector 
    
 
getVisibleCells : State cellState -> (Array cellState, Int)
getVisibleCells state = 
  let 
      firstVisibleIndex = 
        max 0 (round ((state.offset / state.cellHeight)) - (state.bufferSize // 2))
        
      visibleRange = 
        round (state.size.y / state.cellHeight) + state.bufferSize
        
      lastVisibleIndex = 
        min (Array.length state.cells) (firstVisibleIndex + visibleRange)
        
      visibleCells = 
        Array.slice firstVisibleIndex lastVisibleIndex state.cells
        
  in 
      (visibleCells, firstVisibleIndex)
 
 
 
 
update : (cellAction -> cellState -> cellState) -> Action cellAction -> State cellState -> State cellState 
update updateCell action state = 
  case action of 
    CellAction index cellAction -> 
      { state | cells <- updateNArray index (updateCell cellAction) state.cells }
    
    Scroll offset -> 
      { state | offset <- offset }
      
    Resize size ->
     { state | size <- size }
            
            
   
   
view : (CellContext -> Address cellAction -> cellState -> Html) -> Address (Action cellAction) -> State cellState -> Html
view viewCell address state = 
  let 
      fullHeight = 
        toFloat (Array.length state.cells) * state.cellHeight
  
      containerStyle = 
          [ "position" => "absolute"
          , "width"    => toString state.size.x ++ "px"
          , "height"   => toString state.size.y ++ "px"
          , "overflow-y" => "scroll"
          , "overflow-x" => "hidden"
          ]
          
      innerContainerStyle = 
          [ "position" => "absolute" 
          , "width" => toString state.size.x ++ "px"
          , "height" => toString fullHeight ++ "px"
          ]
          
      cellContext = 
        { size = { x = state.size.x , y = state.cellHeight } }
        
        
      (visibleCells, firstVisibleIndex) = 
          getVisibleCells state
          
      viewN index cell = 
          let 
              position = 
                  { x = 0 , y = toFloat index * state.cellHeight }
                  
                
              cellContainerStyle = 
                  [ "position"    => "absolute"
                  , "transform"   => "translate3d(" ++ toString position.x ++ "px, " ++ toString position.y ++ "px, 0px)"
                  , "will-change" => "transform, width, height"
                  , "width"       => toString cellContext.size.x ++ "px"
                  , "height"      => toString cellContext.size.y ++ "px"
                  , "overflow"    => "hidden"
                  ]
                  
              cellAddress = 
                  Signal.forwardTo address (CellAction index)
          in
              Html.div 
                  [ Html.Attributes.style cellContainerStyle ]
                  [ viewCell cellContext cellAddress cell ]
                                   
  in 
      Html.div 
          [ Html.Attributes.style containerStyle
          , onScroll address Scroll ]
          [ Html.div 
                [ Html.Attributes.style innerContainerStyle 
                
                ]  
                ( Array.toList (Array.indexedMap (\index -> viewN (index + firstVisibleIndex)) visibleCells) )
          ]
  
  
------------------------------------
 
 
type alias Counter = Int 
 
type CounterAction = Increment | Decrement 
 
viewCounter _ address counter = 
  Html.div 
      []
      [ Html.button
            [ Html.Events.onClick address Increment ]
            [ Html.text "+" ]
      , Html.span 
            [ ]
            [ Html.text (toString counter) ]
      , Html.button 
            [ Html.Events.onClick address Decrement ]
            [ Html.text "-" ]
      ]
        
 
 
updateCounter action counter = 
  case action of 
    Increment -> 
      counter + 1
      
    Decrement -> 
      counter - 1
    
    
initCounter = 0
 
 
--------------------------------------
 
resizes = 
  Signal.map (\(x,y) -> Resize { x = toFloat x , y = toFloat y }) Window.dimensions
  
  
actionMailbox = 
  Signal.mailbox (Scroll 0)
  
  
actions = 
  Signal.merge resizes actionMailbox.signal 
  
  
address = 
  actionMailbox.address
  
  
initial = 
  init (Array.repeat 1000000 initCounter)
  
  
main = 
  Signal.map (view viewCounter address)
    (Signal.foldp (update updateCounter) initial actions)
 
 
 
{-
main = 
  StartApp.start 
    { model  = init (Array.repeat 100 initCounter)
    , view   = view viewCounter 
    , update = update updateCounter 
    }
    
-}