{-# LANGUAGE TemplateHaskell #-}
module GitHub.Types.Settings
  ( Label (..)
  , Ruleset (..)
  , RepoSettings (..)
  , Team (..)
  , TeamMembership (..)
  , OrgSettings (..)
  ) where

import           Data.Aeson          (Value)
import           Data.Aeson.TH       (Options (fieldLabelModifier),
                                      defaultOptions, deriveJSON)
import           Data.HashMap.Strict (HashMap)
import           Data.Text           (Text)
import           Text.Casing         (camel, quietSnake)

data Label = Label
  { Label -> Maybe Text
labelName        :: Maybe Text
  , Label -> Maybe Text
labelDescription :: Maybe Text
  , Label -> Text
labelColor       :: Text
  } deriving (Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq)
$(deriveJSON defaultOptions{fieldLabelModifier = quietSnake . drop (length "Label")} ''Label)

data Ruleset = Ruleset
  { Ruleset -> Maybe Int
rulesetId                   :: Maybe Int
  , Ruleset -> Maybe Text
rulesetName                 :: Maybe Text
  , Ruleset -> Text
rulesetTarget               :: Text
  , Ruleset -> Maybe Text
rulesetSourceType           :: Maybe Text
  , Ruleset -> Maybe Text
rulesetSource               :: Maybe Text
  , Ruleset -> Text
rulesetEnforcement          :: Text
  , Ruleset -> Maybe Text
rulesetNodeId               :: Maybe Text
  , Ruleset -> Maybe (HashMap Text Value)
rulesetConditions           :: Maybe (HashMap Text Value)
  , Ruleset -> Maybe [HashMap Text Value]
rulesetRules                :: Maybe [HashMap Text Value]
  , Ruleset -> Maybe Text
rulesetCreatedAt            :: Maybe Text
  , Ruleset -> Maybe Text
rulesetUpdatedAt            :: Maybe Text
  , Ruleset -> Maybe [HashMap Text Value]
rulesetBypassActors         :: Maybe [HashMap Text Value]
  , Ruleset -> Maybe Text
rulesetCurrentUserCanBypass :: Maybe Text
  , Ruleset -> Maybe (HashMap Text Value)
rulesetLinks                :: Maybe (HashMap Text Value)
  } deriving (Int -> Ruleset -> ShowS
[Ruleset] -> ShowS
Ruleset -> String
(Int -> Ruleset -> ShowS)
-> (Ruleset -> String) -> ([Ruleset] -> ShowS) -> Show Ruleset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ruleset] -> ShowS
$cshowList :: [Ruleset] -> ShowS
show :: Ruleset -> String
$cshow :: Ruleset -> String
showsPrec :: Int -> Ruleset -> ShowS
$cshowsPrec :: Int -> Ruleset -> ShowS
Show)
$(deriveJSON defaultOptions{fieldLabelModifier = quietSnake . drop (length "Ruleset")} ''Ruleset)

data RepoSettings = RepoSettings
  { RepoSettings -> Value
repoSettingsEditRepo :: Value
  , RepoSettings -> Maybe (HashMap Text Value)
repoSettingsBranches :: Maybe (HashMap Text Value)
  , RepoSettings -> Maybe (HashMap Text Ruleset)
repoSettingsRulesets :: Maybe (HashMap Text Ruleset)
  , RepoSettings -> HashMap Text Label
repoSettingsLabels   :: HashMap Text Label
  } deriving (Int -> RepoSettings -> ShowS
[RepoSettings] -> ShowS
RepoSettings -> String
(Int -> RepoSettings -> ShowS)
-> (RepoSettings -> String)
-> ([RepoSettings] -> ShowS)
-> Show RepoSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoSettings] -> ShowS
$cshowList :: [RepoSettings] -> ShowS
show :: RepoSettings -> String
$cshow :: RepoSettings -> String
showsPrec :: Int -> RepoSettings -> ShowS
$cshowsPrec :: Int -> RepoSettings -> ShowS
Show)
$(deriveJSON defaultOptions{fieldLabelModifier = camel . drop (length "RepoSettings")} ''RepoSettings)

data Team = Team
  { Team -> Maybe Int
teamId                  :: Maybe Int
  , Team -> Maybe Text
teamName                :: Maybe Text
  , Team -> Maybe Text
teamDescription         :: Maybe Text
  , Team -> Maybe Text
teamPrivacy             :: Maybe Text
  , Team -> Maybe Text
teamNotificationSetting :: Maybe Text
  , Team -> Maybe Team
teamParent              :: Maybe Team
  , Team -> Maybe Int
teamParentTeamId        :: Maybe Int
  , Team -> Maybe Text
teamPermission          :: Maybe Text
  , Team -> Maybe (HashMap Text Text)
teamMembers             :: Maybe (HashMap Text Text)
  } deriving (Int -> Team -> ShowS
[Team] -> ShowS
Team -> String
(Int -> Team -> ShowS)
-> (Team -> String) -> ([Team] -> ShowS) -> Show Team
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Team] -> ShowS
$cshowList :: [Team] -> ShowS
show :: Team -> String
$cshow :: Team -> String
showsPrec :: Int -> Team -> ShowS
$cshowsPrec :: Int -> Team -> ShowS
Show)
$(deriveJSON defaultOptions{fieldLabelModifier = quietSnake . drop (length "Team")} ''Team)

newtype TeamMembership = TeamMembership
  { TeamMembership -> Text
teamMembershipRole     :: Text
  } deriving (Int -> TeamMembership -> ShowS
[TeamMembership] -> ShowS
TeamMembership -> String
(Int -> TeamMembership -> ShowS)
-> (TeamMembership -> String)
-> ([TeamMembership] -> ShowS)
-> Show TeamMembership
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamMembership] -> ShowS
$cshowList :: [TeamMembership] -> ShowS
show :: TeamMembership -> String
$cshow :: TeamMembership -> String
showsPrec :: Int -> TeamMembership -> ShowS
$cshowsPrec :: Int -> TeamMembership -> ShowS
Show)
$(deriveJSON defaultOptions{fieldLabelModifier = quietSnake . drop (length "TeamMembership")} ''TeamMembership)

data OrgSettings = OrgSettings
  { OrgSettings -> Value
orgSettingsEditOrg :: Value
    -- ^ https://docs.github.com/en/rest/orgs/orgs?apiVersion=2022-11-28#update-an-organization
  , OrgSettings -> Text
orgSettingsLogin   :: Text
  , OrgSettings -> HashMap Text Team
orgSettingsTeams   :: HashMap Text Team
  } deriving (Int -> OrgSettings -> ShowS
[OrgSettings] -> ShowS
OrgSettings -> String
(Int -> OrgSettings -> ShowS)
-> (OrgSettings -> String)
-> ([OrgSettings] -> ShowS)
-> Show OrgSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgSettings] -> ShowS
$cshowList :: [OrgSettings] -> ShowS
show :: OrgSettings -> String
$cshow :: OrgSettings -> String
showsPrec :: Int -> OrgSettings -> ShowS
$cshowsPrec :: Int -> OrgSettings -> ShowS
Show)
$(deriveJSON defaultOptions{fieldLabelModifier = camel . drop (length "OrgSettings")} ''OrgSettings)