Add library for fetching paginated JSON
This commit is contained in:
parent
5ef8751d51
commit
98d6ebcef4
2 changed files with 197 additions and 0 deletions
165
src/Paginated.elm
Normal file
165
src/Paginated.elm
Normal file
|
@ -0,0 +1,165 @@
|
||||||
|
module Paginated
|
||||||
|
exposing
|
||||||
|
( Request
|
||||||
|
, Response(..)
|
||||||
|
, request
|
||||||
|
, get
|
||||||
|
, post
|
||||||
|
, send
|
||||||
|
, update
|
||||||
|
, httpRequest
|
||||||
|
, links
|
||||||
|
)
|
||||||
|
|
||||||
|
import Dict exposing (Dict)
|
||||||
|
import Http
|
||||||
|
import Json.Decode exposing (Decoder)
|
||||||
|
import Maybe.Extra
|
||||||
|
import Regex
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
type alias RequestOptions a =
|
||||||
|
{ method : String
|
||||||
|
, headers : List Http.Header
|
||||||
|
, url : String
|
||||||
|
, body : Http.Body
|
||||||
|
, decoder : Decoder a
|
||||||
|
, timeout : Maybe Time.Time
|
||||||
|
, withCredentials : Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type Request a
|
||||||
|
= Request (RequestOptions a)
|
||||||
|
|
||||||
|
|
||||||
|
type Response a
|
||||||
|
= Partial (RequestOptions a) (List a)
|
||||||
|
| Complete (List a)
|
||||||
|
|
||||||
|
|
||||||
|
request : RequestOptions a -> Request a
|
||||||
|
request =
|
||||||
|
Request
|
||||||
|
|
||||||
|
|
||||||
|
get : String -> Decoder a -> Request a
|
||||||
|
get url decoder =
|
||||||
|
request
|
||||||
|
{ method = "GET"
|
||||||
|
, headers = []
|
||||||
|
, url = url
|
||||||
|
, body = Http.emptyBody
|
||||||
|
, decoder = decoder
|
||||||
|
, timeout = Nothing
|
||||||
|
, withCredentials = False
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
post : String -> Http.Body -> Decoder a -> Request a
|
||||||
|
post url body decoder =
|
||||||
|
request
|
||||||
|
{ method = "POST"
|
||||||
|
, headers = []
|
||||||
|
, url = url
|
||||||
|
, body = body
|
||||||
|
, decoder = decoder
|
||||||
|
, timeout = Nothing
|
||||||
|
, withCredentials = False
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
send :
|
||||||
|
(Result Http.Error (Response a) -> msg)
|
||||||
|
-> Request a
|
||||||
|
-> Cmd msg
|
||||||
|
send resultToMessage request =
|
||||||
|
Http.send resultToMessage <|
|
||||||
|
httpRequest request
|
||||||
|
|
||||||
|
|
||||||
|
update : Maybe (Response a) -> Response a -> Response a
|
||||||
|
update old new =
|
||||||
|
case ( old, new ) of
|
||||||
|
( Nothing, _ ) ->
|
||||||
|
new
|
||||||
|
|
||||||
|
( Just (Complete items), _ ) ->
|
||||||
|
Complete items
|
||||||
|
|
||||||
|
( Just (Partial _ oldItems), Complete newItems ) ->
|
||||||
|
Complete (oldItems ++ newItems)
|
||||||
|
|
||||||
|
( Just (Partial _ oldItems), Partial request newItems ) ->
|
||||||
|
Partial request (oldItems ++ newItems)
|
||||||
|
|
||||||
|
|
||||||
|
httpRequest : Request a -> Http.Request (Response a)
|
||||||
|
httpRequest (Request options) =
|
||||||
|
Http.request
|
||||||
|
{ method = options.method
|
||||||
|
, headers = options.headers
|
||||||
|
, url = options.url
|
||||||
|
, body = options.body
|
||||||
|
, expect = expect options
|
||||||
|
, timeout = options.timeout
|
||||||
|
, withCredentials = options.withCredentials
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
expect : RequestOptions a -> Http.Expect (Response a)
|
||||||
|
expect options =
|
||||||
|
Http.expectStringResponse (fromResponse options)
|
||||||
|
|
||||||
|
|
||||||
|
fromResponse :
|
||||||
|
RequestOptions a
|
||||||
|
-> Http.Response String
|
||||||
|
-> Result String (Response a)
|
||||||
|
fromResponse options response =
|
||||||
|
let
|
||||||
|
items : Result String (List a)
|
||||||
|
items =
|
||||||
|
Json.Decode.decodeString
|
||||||
|
(Json.Decode.list options.decoder)
|
||||||
|
response.body
|
||||||
|
|
||||||
|
nextPage =
|
||||||
|
Dict.get "Link" response.headers
|
||||||
|
|> Maybe.map links
|
||||||
|
|> Maybe.andThen (Dict.get "next")
|
||||||
|
|
||||||
|
newOptions : Result String (RequestOptions a)
|
||||||
|
newOptions =
|
||||||
|
Err "Next request not implemented"
|
||||||
|
in
|
||||||
|
case nextPage of
|
||||||
|
Nothing ->
|
||||||
|
Result.map Complete items
|
||||||
|
|
||||||
|
Just url ->
|
||||||
|
Result.map
|
||||||
|
(Partial { options | url = url })
|
||||||
|
items
|
||||||
|
|
||||||
|
|
||||||
|
links : String -> Dict String String
|
||||||
|
links s =
|
||||||
|
let
|
||||||
|
toTuples xs =
|
||||||
|
case xs of
|
||||||
|
[ Just a, Just b ] ->
|
||||||
|
Just ( b, a )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
in
|
||||||
|
Regex.find
|
||||||
|
Regex.All
|
||||||
|
(Regex.regex "<(.*?)>; rel=\"(.*?)\"")
|
||||||
|
s
|
||||||
|
|> List.map .submatches
|
||||||
|
|> List.map toTuples
|
||||||
|
|> Maybe.Extra.values
|
||||||
|
|> Dict.fromList
|
32
tests/PaginatedTests.elm
Normal file
32
tests/PaginatedTests.elm
Normal file
|
@ -0,0 +1,32 @@
|
||||||
|
module PaginatedTests exposing (..)
|
||||||
|
|
||||||
|
import Dict
|
||||||
|
import Expect
|
||||||
|
import Paginated
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Paginated"
|
||||||
|
[ test "Parse links" <|
|
||||||
|
\() ->
|
||||||
|
let
|
||||||
|
header =
|
||||||
|
String.join ", "
|
||||||
|
[ "<https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=1&per_page=3>; rel=\"prev\""
|
||||||
|
, "<https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=3&per_page=3>; rel=\"next\""
|
||||||
|
, "<https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=1&per_page=3>; rel=\"first\""
|
||||||
|
, "<https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=3&per_page=3>; rel=\"last\""
|
||||||
|
]
|
||||||
|
|
||||||
|
expected =
|
||||||
|
Dict.fromList
|
||||||
|
[ ( "prev", "https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=1&per_page=3" )
|
||||||
|
, ( "next", "https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=3&per_page=3" )
|
||||||
|
, ( "first", "https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=1&per_page=3" )
|
||||||
|
, ( "last", "https://gitlab.example.com/api/v4/projects/8/issues/8/notes?page=3&per_page=3" )
|
||||||
|
]
|
||||||
|
in
|
||||||
|
Expect.equalDicts expected (Paginated.links header)
|
||||||
|
]
|
Loading…
Reference in a new issue