Limiter.elm

module Limiter exposing
  ( Limiter, Msg
  , debounce, throttle
  , event, push
  , update
  )

{- Imports ------------------------------------------------------------------ -}
import Process
import Task


{- Types -------------------------------------------------------------------- -}
{-| -}
type alias Limiter msg =
    { tagger : Msg msg -> msg
    , mode : Mode msg
    , state : State
    }


{-| -}
type Mode msg
    = Debounce Int (List msg)
    | Throttle Int


{-| -}
type State
    = Open
    | Closed


{-| -}
type Msg msg
    = Emit msg
    | EmitIfSettled Int
    | None
    | Reopen
    | Push msg


{- Creating a Limiter ------------------------------------------------------- -}
{-| -}
debounce : (Msg msg -> msg) -> Int -> Limiter msg
debounce tagger cooldown =
    { tagger = tagger, mode = Debounce cooldown [], state = Open }


{-| -}
throttle : (Msg msg -> msg) -> Int -> Limiter msg
throttle tagger interval =
    { tagger = tagger, mode = Throttle interval, state = Open }


{- Limiting events ---------------------------------------------------------- -}
{-|

    Html.button
      [ Html.Events.onClick (Limiter.event Increment model.debouncer) ]
      [ Html.text "+" ]
-}
event : msg -> Limiter msg -> msg
event msg { tagger, mode, state } =
    case ( state, mode ) of
        ( Open, Debounce _ _ ) ->
            tagger (Push msg)

        ( Open, Throttle _ ) ->
            tagger (Emit msg)

        ( Closed, _ ) ->
            tagger None


{-| 

    case msg of
      GotInput input ->
        Limiter.push (FetchResults input) model.throttler
          |> Tuple.mapFirst (\throttler -> { model | throttler = throttler })

      FetchResults input ->
        Http.get
          { ...
          }
-}
push : msg -> Limiter msg -> ( Limiter msg, Cmd msg )
push msg ({ tagger, mode, state } as limiter) =
    case ( state, mode ) of 
        ( Open, Debounce cooldown queue ) ->
            ( { limiter | mode = Debounce cooldown (msg :: queue) }
            , emitAfter cooldown (tagger <| EmitIfSettled <| List.length queue + 1)
            )

        ( Open, Throttle interval ) ->
            ( { limiter | state = Closed }
            , Cmd.batch
                [ emitAfter interval (tagger Reopen)
                , emit msg
                ]
            )

        ( Closed, _ ) ->
            ( limiter
            , Cmd.none
            )


{- Updating a Limiter ------------------------------------------------------- -}
{-| -}
update : Msg msg -> Limiter msg -> ( Limiter msg, Cmd msg )
update internalMsg ({ tagger, mode, state } as limiter) =
    case ( internalMsg, state, mode ) of
        ( Emit msg, Open, Throttle interval ) ->
            ( { limiter | state = Closed }
            , Cmd.batch
                [ emitAfter interval (tagger Reopen)
                , emit msg
                ]
            )

        ( EmitIfSettled msgCount, Open, Debounce cooldown queue ) ->
            if List.length queue == msgCount then
                ( { limiter | mode = Debounce cooldown [] }
                , List.head queue
                    |> Maybe.map emit
                    |> Maybe.withDefault Cmd.none
                )

            else
                ( limiter
                , Cmd.none
                )

        ( Reopen, _, _ ) ->
            ( { limiter | state = Open }
            , Cmd.none
            )

        ( Push msg, Open, Debounce cooldown queue ) ->
            ( { limiter | mode = Debounce cooldown (msg :: queue) }
            , emitAfter cooldown (tagger <| EmitIfSettled <| List.length queue + 1)
            )

        _ ->
            ( limiter
            , Cmd.none
            )


{- Utils -------------------------------------------------------------------- -}
{-| -}
emitAfter : Int -> msg -> Cmd msg
emitAfter delay msg =
    Basics.toFloat delay
        |> Process.sleep
        |> Task.perform (always msg)


{-| -}
emit : msg -> Cmd msg
emit msg =
    Task.succeed msg
        |> Task.perform identity

Main.elm

module Main exposing (main)

{- Imports ------------------------------------------------------------------ -}
import Browser
import Html
import Html.Attributes
import Html.Events

import Limiter exposing (Limiter)

{- Main --------------------------------------------------------------------- -}
main : Program Flags Model Msg
main =
  Browser.document
    { init = init
    , update = update
    , view = view
    , subscriptions = subscriptions
    }


{- Model -------------------------------------------------------------------- -}
type alias Model =
  { a : Int
  , b : String
  , b_throttled : String
  , debouncer : Limiter Msg
  , throttler : Limiter Msg
  }

type alias Flags =
  {
  }

init : Flags -> (Model, Cmd Msg)
init _ =
  ( { a = 0
    , b = ""
    , b_throttled = ""
    , debouncer = Limiter.debounce DebounceMsg 500
    , throttler = Limiter.throttle ThrottleMsg 500
    }
  , Cmd.none
  )


{- Update ------------------------------------------------------------------- -}
type Msg
  = IncrementA
  | InputB String
  | PretendSearch String
  | DebounceMsg (Limiter.Msg Msg)
  | ThrottleMsg (Limiter.Msg Msg)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    IncrementA ->
      ( { model | a = model.a + 1 }
      , Cmd.none
      )

    InputB input ->
      Limiter.push (PretendSearch input) model.throttler
        |> Tuple.mapFirst (\limiter ->
          { model
            | throttler = limiter
            , b = input
          }
        )

    PretendSearch input ->
      ( { model | b_throttled = input }
      , Cmd.none
      )

    DebounceMsg debounceMsg ->
      Limiter.update debounceMsg model.debouncer
        |> Tuple.mapFirst (\limiter -> { model | debouncer = limiter })

    ThrottleMsg throttleMsg ->
      Limiter.update throttleMsg model.throttler
        |> Tuple.mapFirst (\limiter -> { model | throttler = limiter })


{- View --------------------------------------------------------------------- -}
view : Model -> Browser.Document Msg
view model =
  { title = ""
  , body =
    [ Html.div []
      [ Html.button
        [ Html.Events.onClick (Limiter.event IncrementA model.debouncer) ]
        [ Html.text "Debounced" ]
      , Html.p []
        [ Html.text <| "Count: " ++ String.fromInt model.a ]
      ]
    , Html.div []
      [ Html.input
        [ Html.Events.onInput InputB
        , Html.Attributes.value model.b
        ] []
      , Html.p []
        [ Html.text <| "Searching for: " ++ model.b_throttled ]
      ]
    ]
  }


{- Subscriptions ------------------------------------------------------------ -}
subscriptions : Model -> Sub Msg
subscriptions _ =
  Sub.batch
    [
    ]