-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
-- The gists API as described at <http://developer.github.com/v3/gists/>.
module GitHub.Endpoints.Gists (
    gistsR,
    gistR,
    createGistR,
    starGistR,
    unstarGistR,
    deleteGistR,
    module GitHub.Data,
    ) where

import GitHub.Data
import GitHub.Internal.Prelude
import Prelude ()

-- | List gists.
-- See <https://developer.github.com/v3/gists/#list-gists>
gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist)
gistsR :: forall (k :: RW).
Name Owner -> FetchCount -> Request k (Vector Gist)
gistsR Name Owner
user = Paths -> QueryString -> FetchCount -> Request k (Vector Gist)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"users", Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
user, Text
"gists"] []

-- | Query a single gist.
-- See <https://developer.github.com/v3/gists/#get-a-single-gist>
gistR :: Name Gist -> Request k Gist
gistR :: forall (k :: RW). Name Gist -> Request k Gist
gistR Name Gist
gid =
    Paths -> QueryString -> Request k Gist
forall (mt :: RW) a. Paths -> QueryString -> Request mt a
query [Text
"gists", Name Gist -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Gist
gid] []

-- | Create a new gist
-- See <https://docs.github.com/rest/reference/gists#create-a-gist>
createGistR :: NewGist -> Request 'RW Gist
createGistR :: NewGist -> Request 'RW Gist
createGistR NewGist
ngist = CommandMethod -> Paths -> ByteString -> Request 'RW Gist
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Post [Text
"gists"] (NewGist -> ByteString
forall a. ToJSON a => a -> ByteString
encode NewGist
ngist)

-- | Star a gist by the authenticated user.
-- See <https://developer.github.com/v3/gists/#star-a-gist>
starGistR :: Name Gist -> GenRequest 'MtUnit 'RW ()
starGistR :: Name Gist -> GenRequest 'MtUnit 'RW ()
starGistR Name Gist
gid = CommandMethod -> Paths -> ByteString -> GenRequest 'MtUnit 'RW ()
forall (mt :: MediaType (*)) a.
CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
Command CommandMethod
Put [Text
"gists", Name Gist -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Gist
gid, Text
"star"] ByteString
forall a. Monoid a => a
mempty

-- | Unstar a gist by the authenticated user.
-- See <https://developer.github.com/v3/gists/#unstar-a-gist>
unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW ()
unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW ()
unstarGistR Name Gist
gid = CommandMethod -> Paths -> ByteString -> GenRequest 'MtUnit 'RW ()
forall (mt :: MediaType (*)) a.
CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
Command CommandMethod
Delete [Text
"gists", Name Gist -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Gist
gid, Text
"star"] ByteString
forall a. Monoid a => a
mempty

-- | Delete a gist by the authenticated user.
-- See <https://developer.github.com/v3/gists/#delete-a-gist>
deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW ()
deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW ()
deleteGistR Name Gist
gid = CommandMethod -> Paths -> ByteString -> GenRequest 'MtUnit 'RW ()
forall (mt :: MediaType (*)) a.
CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
Command CommandMethod
Delete [Text
"gists", Name Gist -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Gist
gid] ByteString
forall a. Monoid a => a
mempty