Fetch paginated GitLab objects

This commit is contained in:
Correl Roush 2018-01-18 01:34:10 -05:00
parent 98d6ebcef4
commit b73272864b
2 changed files with 75 additions and 30 deletions

View file

@ -2,6 +2,7 @@ module App exposing (..)
import Gitlab
import Html
import Paginated
import RemoteData
@ -15,13 +16,17 @@ client =
Gitlab.Client "http://git.phoenixinquis.net" (Just "AuGrRWBdXfSJbm36itUG")
type alias ObjectsResponse =
RemoteData.WebData (Paginated.Response Gitlab.Object)
type alias Model =
{ objects : RemoteData.WebData (List Gitlab.Object) }
{ objects : ObjectsResponse }
type Msg
= GetObjects
| GotObjects (RemoteData.WebData (List Gitlab.Object))
| GotObjects ObjectsResponse
main : Program Never Model Msg
@ -44,11 +49,34 @@ init =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
GotObjects objects ->
( { model | objects = objects }
, Cmd.none
GotObjects data ->
let
updatePaginated new =
let
updated =
Paginated.update
(RemoteData.toMaybe model.objects)
new
in
case updated of
Paginated.Partial options items ->
( updated
, Paginated.request options
|> Paginated.httpRequest
|> RemoteData.sendRequest
|> Cmd.map GotObjects
)
Paginated.Complete items ->
( updated, Cmd.none )
( objects, cmd ) =
RemoteData.update
updatePaginated
data
in
( { model | objects = objects }, cmd )
_ ->
( model, Cmd.none )
@ -61,19 +89,37 @@ view model =
]
viewFiles : RemoteData.WebData (List Gitlab.Object) -> Html.Html Msg
viewFiles : ObjectsResponse -> Html.Html Msg
viewFiles data =
case data of
RemoteData.NotAsked ->
Html.div [] [ Html.text "Not loaded." ]
RemoteData.Loading ->
Html.div [] [ Html.text "Loading..." ]
RemoteData.Failure _ ->
Html.div [] [ Html.text "Whoops." ]
RemoteData.Success files ->
RemoteData.Loading ->
Html.div [] [ Html.text "Loading objects..." ]
RemoteData.Success (Paginated.Partial _ objects) ->
Html.div []
[ Html.text <|
"Loading objects... ("
++ (toString (List.length objects))
++ " )"
]
RemoteData.Success (Paginated.Complete objects) ->
let
files =
List.filter
(\o ->
o.objectType
== Gitlab.Blob
&& String.endsWith ".gpg" o.name
)
objects
in
Html.ul [] <|
List.map (\x -> Html.li [] [ viewFile x ]) files
@ -85,6 +131,7 @@ viewFile file =
getObjects : Cmd Msg
getObjects =
Gitlab.getFiles repo client
Gitlab.getObjects repo client
|> Paginated.httpRequest
|> RemoteData.sendRequest
|> Cmd.map GotObjects

View file

@ -4,6 +4,7 @@ import Http
import Json.Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (decode, required)
import Maybe.Extra
import Paginated
type Msg
@ -40,19 +41,19 @@ type alias Path =
List String
request : String -> Path -> Decoder a -> Client -> Http.Request a
request : String -> Path -> Decoder a -> Client -> Paginated.Request a
request method path decoder client =
let
url =
apiUrl client path
in
Http.request
Paginated.request
{ method = method
, headers = apiHeaders client
, url = url
, body = Http.emptyBody
, expect = Http.expectJson decoder
, timeout = Maybe.Nothing
, decoder = decoder
, timeout = Nothing
, withCredentials = False
}
@ -71,13 +72,13 @@ apiHeaders client =
[ Maybe.map (Http.header "Private-Token") client.token ]
get : Path -> Decoder a -> Client -> Http.Request a
get : Path -> Decoder a -> Client -> Paginated.Request a
get =
request "GET"
getFiles : Repo -> Client -> Http.Request (List Object)
getFiles repo client =
getObjects : Repo -> Client -> Paginated.Request Object
getObjects repo client =
let
typeFromString s =
case s of
@ -91,20 +92,17 @@ getFiles repo client =
Tree
decoder =
Json.Decode.list
(decode Object
decode Object
|> required "id" Json.Decode.string
|> required "name" Json.Decode.string
|> required "type" (Json.Decode.map typeFromString Json.Decode.string)
|> required "path" Json.Decode.string
)
|> Json.Decode.map (List.filter (\x -> x.objectType == Blob))
in
get
[ "projects"
, Http.encodeUri (repo.owner ++ "/" ++ repo.name)
, "repository"
, "tree?recursive=true&per_page=100&page=2"
, "tree?recursive=true"
]
decoder
client