Track the progress of an HTTP request. This can be useful if you are requesting a large amount of data and want to show the user a progress bar or something.
Here is an example usage: demo and code.
Note: If you stop tracking progress, you cancel the request.
The progress of an HTTP request.
You start with None
. As data starts to come in, you will see Some
. The
bytesExpected
field will match the Content-Length
header, indicating how
long the response body is in bytes (8-bits). The bytes
field indicates how
many bytes have been loaded so far, so if you want progress as a percentage,
you would say:
Some { bytes, bytesExpected } ->
toFloat bytes / toFloat bytesExpected
You will end up with Fail
or Done
depending on the success of the request.
effect module Http.Progress where { subscription = MySub } exposing
( Progress(..)
, track
)
{-| Track the progress of an HTTP request. This can be useful if you are
requesting a large amount of data and want to show the user a progress bar
or something.
Here is an example usage: [demo][] and [code][].
[demo]: https://hirafuji.com.br/elm/http-progress-example/
[code]: https://gist.github.com/pablohirafuji/fa373d07c42016756d5bca28962008c4
**Note:** If you stop tracking progress, you cancel the request.
# Progress
@docs Progress, track
-}
import Dict
import Http
import Http.Internal exposing ( Request(Request) )
import Task exposing (Task)
import Platform exposing (Router)
import Process
-- PROGRESS
{-| The progress of an HTTP request.
You start with `None`. As data starts to come in, you will see `Some`. The
`bytesExpected` field will match the `Content-Length` header, indicating how
long the response body is in bytes (8-bits). The `bytes` field indicates how
many bytes have been loaded so far, so if you want progress as a percentage,
you would say:
Some { bytes, bytesExpected } ->
toFloat bytes / toFloat bytesExpected
You will end up with `Fail` or `Done` depending on the success of the request.
-}
type Progress data
= None
| Some { bytes : Int, bytesExpected : Int}
| Fail Http.Error
| Done data
-- TRACK
{-| Create a subscription that tracks the progress of an HTTP request.
See it in action in this example: [demo][] and [code][].
[demo]: https://hirafuji.com.br/elm/http-progress-example/
[code]: https://gist.github.com/pablohirafuji/fa373d07c42016756d5bca28962008c4
-}
track : String -> (Progress data -> msg) -> Http.Request data -> Sub msg
track id toMessage (Request request) =
subscription <| Track id <|
{ request = Http.Internal.map (Done >> toMessage) request
, toProgress = Some >> toMessage
, toError = Fail >> toMessage
}
type alias TrackedRequest msg =
{ request : Http.Internal.RawRequest msg
, toProgress : { bytes : Int, bytesExpected : Int } -> msg
, toError : Http.Error -> msg
}
map : (a -> b) -> TrackedRequest a -> TrackedRequest b
map func { request, toProgress, toError } =
{ request = Http.Internal.map func request
, toProgress = toProgress >> func
, toError = toError >> func
}
-- SUBSCRIPTIONS
type MySub msg =
Track String (TrackedRequest msg)
subMap : (a -> b) -> MySub a -> MySub b
subMap func (Track id trackedRequest) =
Track id (map func trackedRequest)
-- EFFECT MANAGER
type alias State =
Dict.Dict String Process.Id
init : Task Never State
init =
Task.succeed Dict.empty
-- APP MESSAGES
onEffects : Platform.Router msg Never -> List (MySub msg) -> State -> Task Never State
onEffects router subs state =
let
subDict =
collectSubs subs
leftStep id process (dead, ongoing, new) =
( Process.kill process :: dead
, ongoing
, new
)
bothStep id process _ (dead, ongoing, new) =
( dead
, Dict.insert id process ongoing
, new
)
rightStep id trackedRequest (dead, ongoing, new) =
( dead
, ongoing
, (id, trackedRequest) :: new
)
(dead, ongoing, new) =
Dict.merge leftStep bothStep rightStep state subDict ([], Dict.empty, [])
in
Task.sequence dead
|> Task.andThen (\_ -> spawnRequests router new ongoing)
spawnRequests : Router msg Never -> List (String, TrackedRequest msg) -> State -> Task Never State
spawnRequests router trackedRequests state =
case trackedRequests of
[] ->
Task.succeed state
(id, trackedRequest) :: others ->
Process.spawn (toTask router trackedRequest)
|> Task.andThen (\process -> spawnRequests router others (Dict.insert id process state))
toTask : Router msg Never -> TrackedRequest msg -> Task Never ()
toTask router { request, toProgress, toError } =
Native.Http.toTask request (Just (Platform.sendToApp router << toProgress))
|> Task.andThen (Platform.sendToApp router)
|> Task.onError (Platform.sendToApp router << toError)
-- COLLECT SUBS AS DICT
type alias SubDict msg =
Dict.Dict String (TrackedRequest msg)
collectSubs : List (MySub msg) -> SubDict msg
collectSubs subs =
List.foldl addSub Dict.empty subs
addSub : MySub msg -> SubDict msg -> SubDict msg
addSub (Track id trackedRequest) subDict =
let
request =
trackedRequest.request
uid =
id ++ request.method ++ request.url
in
Dict.insert uid trackedRequest subDict
-- SELF MESSAGES
onSelfMsg : Platform.Router msg Never -> Never -> State -> Task Never State
onSelfMsg router _ state =
Task.succeed state