Infinite list of primes

infiniteprimes.elm

import Html exposing (Html, Attribute, ul, li, text, div)
import Html.Attributes exposing (style)
import Html.Events 
import Json.Decode as Json exposing (Decoder, (:=))
import Signal exposing (Address)
import StartApp
----------------------------------

initial : State Int 
initial = 
  { data = primes 
  , size = { x = 400, y = 400 }
  , cellHeight = 50
  , offset = 0
  }
  

main = 
  StartApp.start
    { model = initial
    , update = update
    , view = view
    }


----------------------------------

type alias State a = 
  { data : LazyList a 
  , size : Vector 
  , cellHeight : Float
  , offset : Float
  }
  
  
type Action 
  = SetOffset Float
  
  
update : Action -> State a -> State a
update action state = 
  case action of 
    SetOffset offset ->
      { state | offset <- offset }
  
  
        
   
  
getCurrentIndices : State a -> (Int, Int)
getCurrentIndices state = 
  let 
      firstIndex = 
        max 0 (round (state.offset / state.cellHeight))
        
      numberOfVisibleElements =
        round (state.size.y / state.cellHeight) + 2
        
      lastIndex = 
        firstIndex + numberOfVisibleElements
        
  in 
      (firstIndex, lastIndex)
        
  
  
  
view : Address Action -> State a -> Html
view address state = 
  let 
      (firstIndex, lastIndex) = 
        getCurrentIndices state
        
      totalNumber =
        lastIndex - firstIndex + 2
        
      currentData = 
        slice firstIndex lastIndex state.data 
        |> toList
        
      width = 
        toString state.size.x ++ "px"
        
      height =
        toString state.size.y ++ "px"
        
      cellHeight = 
        toString state.cellHeight ++ "px"
        
      fullHeight = 
        toString (state.cellHeight * toFloat totalNumber) ++ "px"
        
      containerStyle = 
        [ "position" => "absolute"
        , "width" => width
        , "height" => height
        , "overflow" => "scroll"
        ]
        
        
      viewN index data = 
        let 
            top = 
              state.cellHeight * toFloat (index + firstIndex)
              
            transform = 
              "translate3d(0px, " ++ toString top ++ "px, 0px)"
              
            dataContainerStyle = 
              [ "position" => "absolute"
              , "transform" => transform
              , "-webkit-transform" => transform
              , "width" => width
              , "height" => cellHeight
              ]
              
        in 
            div 
              [ style dataContainerStyle ]
              [ text (toString data) ]
              
  in 
      div 
        [ style containerStyle 
        , onScroll address SetOffset 
        ]
        ( List.indexedMap viewN currentData )
        
              
      
  
----------------------------------

scrollTop : Decoder Float 
scrollTop = 
  Json.at [ "target" , "scrollTop" ] Json.float
 
 
onScroll : Address a -> (Float -> a) -> Attribute
onScroll address constructor = 
  Html.Events.on "scroll" scrollTop (Signal.message address << constructor)


----------------------------------

type alias Vector = 
  { x : Float 
  , y : Float
  }
  
infixl 2 =>  
(=>) = (,)

----------------------------------

type alias Lazy a = () -> a

force : Lazy a -> a
force l = l ()

type LazyListView a
  = Nil
  | Cons a (LazyList a)

type alias LazyList a = Lazy (LazyListView a)


empty : LazyList a 
empty _ = Nil

cons : a -> LazyList a -> LazyList a
cons a list _ = 
  Cons a list
  
  
iterate : (a -> a) -> a -> LazyList a
iterate f a _ = 
  Cons a (\() -> force <| iterate f (f a))
  
integers = 
  iterate ((+) 1) 1
  
sieve list _ = 
  case force list of
    Nil ->
      Nil 
      
    Cons p xs ->
      Cons p (sieve (keepIf (\x -> rem x p /= 0) xs))
 
primes = 
  sieve (iterate ((+) 1) 2)
 

keepIf : (a -> Bool) -> LazyList a -> LazyList a
keepIf pred list _ = 
  case force list of 
    Nil ->
      Nil
      
    Cons x xs ->
      if pred x 
      then 
        Cons x (keepIf pred xs)
      else
        keepIf pred xs ()
      
  
takeWhile : (a -> Bool) -> LazyList a -> LazyList a
takeWhile pred list _ =
  case force list of 
    Nil ->
      Nil
      
    Cons x xs -> 
      if pred x
      then 
        Cons x (takeWhile pred xs)
      else
        Nil
        
      
  
  
toList : LazyList a -> List a 
toList list = 
  case force list of 
    Nil -> 
      [] 
      
    Cons x xs -> 
      x :: toList xs
      
      
take : Int -> LazyList a -> LazyList a 
take n list = 
  if n <= 0
  then 
    empty 
  else 
    case force list of 
      Nil -> 
        empty
        
      Cons x xs ->
        cons x (take (n - 1) xs)
        
        
drop : Int -> LazyList a -> LazyList a
drop n list = 
  if n <= 0 
  then 
    list
  else
    case force list of 
      Nil -> 
        empty
        
      Cons x xs ->
        drop (n - 1) xs
  

slice : Int -> Int -> LazyList a -> LazyList a 
slice start end list = 
  list
  |> drop start
  |> take (end - start)
 
-----------------------------------