InfiniteScroll.elm

module InfiniteScroll
    exposing
        ( Model
        , Msg(..)
        , init
        , subscriptions
        , timeout
        , offset
        , direction
        , loadMoreCmd
        , Direction(..)
        , update
        , LoadMoreCmd
        , stopLoading
        , startLoading
        , isLoading
        )

import Ports
import Process
import Task
import Time exposing (Time, second)


type alias LoadMoreCmd msg =
    Direction -> Cmd msg


type Direction
    = Top
    | Bottom


type Model msg
    = Model (ModelInternal msg)


type alias ModelInternal msg =
    { direction : Direction
    , offset : Int
    , loadMoreFunc : LoadMoreCmd msg
    , isLoading : Bool
    , timeout : Time
    , lastRequest : Time
    }


type alias ScrollPos =
    { scrollTop : Int
    , contentHeight : Int
    , windowHeight : Int
    }


type Msg
    = Scroll ScrollPos
    | CurrTime Time
    | Timeout Time ()



-- Init


init : LoadMoreCmd msg -> Model msg
init loadMoreFunc =
    Model
        { direction = Bottom
        , offset = 50
        , loadMoreFunc = loadMoreFunc
        , isLoading = False
        , timeout = 5 * second
        , lastRequest = 0
        }


timeout : Time -> Model msg -> Model msg
timeout timeout (Model model) =
    Model { model | timeout = timeout }


offset : Int -> Model msg -> Model msg
offset offset (Model model) =
    Model { model | offset = offset }


direction : Direction -> Model msg -> Model msg
direction direction (Model model) =
    Model { model | direction = direction }


loadMoreCmd : LoadMoreCmd msg -> Model msg -> Model msg
loadMoreCmd loadMoreFunc (Model model) =
    Model { model | loadMoreFunc = loadMoreFunc }



-- Subscriptions


subscriptions : Model msg -> Sub Msg
subscriptions model =
    Ports.windowScrolled Scroll



-- Update


update : (Msg -> msg) -> Msg -> Model msg -> ( Model msg, Cmd msg )
update mapper msg (Model model) =
    case msg of
        Scroll pos ->
            if shouldLoadMore model pos then
                ( startLoading (Model model)
                , Cmd.map mapper <| Task.perform CurrTime <| Time.now
                )
            else
                ( Model model, Cmd.map mapper Cmd.none )

        CurrTime time ->
            ( Model { model | lastRequest = time }
            , Cmd.batch
                [ model.loadMoreFunc model.direction
                , Cmd.map mapper <| Task.perform (Timeout time) <| Process.sleep model.timeout
                ]
            )

        Timeout time _ ->
            if time == model.lastRequest then
                ( stopLoading (Model model), Cmd.map mapper Cmd.none )
            else
                ( Model model, Cmd.map mapper Cmd.none )


shouldLoadMore : ModelInternal msg -> ScrollPos -> Bool
shouldLoadMore { direction, offset, isLoading } { scrollTop, contentHeight, windowHeight } =
    if isLoading then
        False
    else
        case direction of
            Top ->
                scrollTop <= offset

            Bottom ->
                let
                    excessHeight =
                        contentHeight - windowHeight
                in
                    scrollTop >= (excessHeight - offset)



-- Infinite scroll


startLoading : Model msg -> Model msg
startLoading (Model model) =
    Model { model | isLoading = True }


isLoading : Model msg -> Bool
isLoading (Model { isLoading }) =
    isLoading


stopLoading : Model msg -> Model msg
stopLoading (Model model) =
    Model { model | isLoading = False }