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

import           Data.Aeson            (Value, encode)
import           Data.Text             (Text)
import qualified Data.Text             as Text
import           Data.Vector           (Vector)
import           GitHub.Data.Request   (CommandMethod (Post, Put),
                                        FetchCount (FetchAll), RW (..), Request,
                                        command, pagedQuery)
import           GitHub.Types.Settings (Ruleset)

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

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

updateRulesetR :: Text -> Text -> Int -> Ruleset -> Request 'RW Value
updateRulesetR :: Text -> Text -> Int -> Ruleset -> Request 'RW Value
updateRulesetR Text
user Text
repo Int
rId =
    CommandMethod -> Paths -> ByteString -> Request 'RW Value
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Put [Text
"repos", Text
user, Text
repo, Text
"rulesets", String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
rId] (ByteString -> Request 'RW Value)
-> (Ruleset -> ByteString) -> Ruleset -> Request 'RW Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruleset -> ByteString
forall a. ToJSON a => a -> ByteString
encode