{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
module GitHub.Paths.Repos.Labels where

import           Data.Aeson            (encode)
import           Data.Text             (Text)
import           Data.Vector           (Vector)
import           GitHub.Data.Request   (CommandMethod (Delete, Patch, Post),
                                        FetchCount (FetchAll),
                                        GenRequest (Command), MediaType (..),
                                        RW (..), Request, command, pagedQuery)
import           GitHub.Types.Settings (Label)

getLabelsR :: Text -> Text -> Request 'RO (Vector Label)
getLabelsR :: Text -> Text -> Request 'RO (Vector Label)
getLabelsR Text
user Text
repo =
    Paths -> QueryString -> FetchCount -> Request 'RO (Vector Label)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"repos", Text
user, Text
repo, Text
"labels"] [] FetchCount
FetchAll

createLabelR :: Text -> Text -> Label -> Request 'RW Label
createLabelR :: Text -> Text -> Label -> Request 'RW Label
createLabelR Text
user Text
repo =
    CommandMethod -> Paths -> ByteString -> Request 'RW Label
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Post [Text
"repos", Text
user, Text
repo, Text
"labels"] (ByteString -> Request 'RW Label)
-> (Label -> ByteString) -> Label -> Request 'RW Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> ByteString
forall a. ToJSON a => a -> ByteString
encode

updateLabelR :: Text -> Text -> Text -> Label -> Request 'RW Label
updateLabelR :: Text -> Text -> Text -> Label -> Request 'RW Label
updateLabelR Text
user Text
repo Text
name =
    CommandMethod -> Paths -> ByteString -> Request 'RW Label
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Patch [Text
"repos", Text
user, Text
repo, Text
"labels", Text
name] (ByteString -> Request 'RW Label)
-> (Label -> ByteString) -> Label -> Request 'RW Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> ByteString
forall a. ToJSON a => a -> ByteString
encode

deleteLabelR :: Text -> Text -> Text -> GenRequest 'MtUnit 'RW ()
deleteLabelR :: Text -> Text -> Text -> GenRequest 'MtUnit 'RW ()
deleteLabelR Text
user Text
repo Text
name =
    CommandMethod -> Paths -> ByteString -> GenRequest 'MtUnit 'RW ()
forall (mt :: MediaType *) a.
CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
Command CommandMethod
Delete [Text
"repos", Text
user, Text
repo, Text
"labels", Text
name] ByteString
forall a. Monoid a => a
mempty