{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : GitLab.Types
-- Description : Haskell records corresponding to JSON data from GitLab API calls
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.Types
  ( GitLab,
    GitLabState (..),
    GitLabServerConfig (..),
    defaultGitLabServer,
    ArchiveFormat (..),
    AccessLevel (..),
    SearchIn (..),
    Scope (..),
    SortBy (..),
    OrderBy (..),
    Member (..),
    SamlIdentity (..),
    Identity (..),
    Namespace (..),
    Links (..),
    Owner (..),
    Permissions (..),
    ProjectId,
    Project (..),
    Statistics (..),
    User (..),
    Milestone (..),
    MilestoneState (..),
    TimeStats (..),
    IssueId,
    Issue (..),
    Epic (..),
    Pipeline (..),
    Commit (..),
    CommitTodo (..),
    CommitStats (..),
    Contributor (..),
    Tag (..),
    Release (..),
    Diff (..),
    Repository (..),
    Job (..),
    Artifact (..),
    Group (..),
    GroupShare (..),
    Branch (..),
    RepositoryFile (..),
    RepositoryFileBlame (..),
    RepositoryFileSimple (..),
    MergeRequest (..),
    Todo (..),
    TodoProject (..),
    TodoAction (..),
    TodoTarget (..),
    TodoTargetType (..),
    TodoType (..),
    TodoState (..),
    Version (..),
    URL,
    EditIssueReq (..),
    Discussion (..),
    CommitNote (..),
    Note (..),
    CommandsChanges (..),
    IssueStatistics (..),
    IssueStats (..),
    IssueCounts (..),
    IssueBoard (..),
    BoardIssue (..),
    BoardIssueLabel (..),
    Visibility (..),
    TestReport (..),
    TestSuite (..),
    TestCase (..),
    TimeEstimate (..),
    TaskCompletionStatus (..),
    References (..),
    Change (..),
    DiffRefs (..),
    DetailedStatus (..),
    License (..),
    ExpirationPolicy (..),
    RepositoryStorage (..),
    Starrer (..),
    ProjectAvatar (..),
    Email (..),
    Key (..),
    UserPrefs (..),
    UserStatus (..),
    UserCount (..),
    Event (..),
    EventActionName (..),
    EventTargetType (..),
    PushData (..),
  )
where

import Control.Monad.Trans.Reader
import Data.Aeson hiding (Key)
import Data.Aeson.TH
import Data.Aeson.Types hiding (Key)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock
import Network.HTTP.Conduit

-- | type synonym for all GitLab actions.
type GitLab a = ReaderT GitLabState IO a

-- | state used by GitLab actions, used internally.
data GitLabState = GitLabState
  { GitLabState -> GitLabServerConfig
serverCfg :: GitLabServerConfig,
    GitLabState -> Manager
httpManager :: Manager
  }

-- | configuration data specific to a GitLab server.
data GitLabServerConfig = GitLabServerConfig
  { GitLabServerConfig -> Text
url :: Text,
    -- | personal access token, see <https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html>
    GitLabServerConfig -> Text
token :: Text,
    -- | milliseconds
    GitLabServerConfig -> Int
timeout :: Int,
    -- | how many times to retry a HTTP request before giving up and returning an error.
    GitLabServerConfig -> Int
retries :: Int,
    -- | write system hook events to files in the system temporary
    -- directory.
    GitLabServerConfig -> Bool
debugSystemHooks :: Bool
  }

-- | default settings, the 'url' and 'token' values will need to be overwritten.
defaultGitLabServer :: GitLabServerConfig
defaultGitLabServer :: GitLabServerConfig
defaultGitLabServer =
  GitLabServerConfig :: Text -> Text -> Int -> Int -> Bool -> GitLabServerConfig
GitLabServerConfig
    { url :: Text
url = Text
"https://gitlab.com",
      token :: Text
token = Text
"",
      timeout :: Int
timeout = Int
15000000, -- 15 seconds
      retries :: Int
retries = Int
5,
      debugSystemHooks :: Bool
debugSystemHooks = Bool
False
    }

-- https://docs.gitlab.com/ee/api/repositories.html#get-file-archive
-- tar.gz, tar.bz2, tbz, tbz2, tb2, bz2, tar, and zip

-- | archive format for file archives of repositories.
-- See 'GitLab.API.Repositories.getFileArchive' in 'GitLab.API.Repositories'.
data ArchiveFormat
  = -- | ".tar.gz"
    TarGz
  | -- | ".tar.bz2"
    TarBz2
  | -- | ".tbz"
    Tbz
  | -- | ".tbz2"
    Tbz2
  | -- | ".tb2"
    Tb2
  | -- | ".bz2"
    Bz2
  | -- | ".tar"
    Tar
  | -- | ".zip"
    Zip

instance Show ArchiveFormat where
  show :: ArchiveFormat -> String
show ArchiveFormat
TarGz = String
".tar.gz"
  show ArchiveFormat
TarBz2 = String
".tar.bz2"
  show ArchiveFormat
Tbz = String
".tbz"
  show ArchiveFormat
Tbz2 = String
".tbz2"
  show ArchiveFormat
Tb2 = String
".tb2"
  show ArchiveFormat
Bz2 = String
".bz2"
  show ArchiveFormat
Tar = String
".tar"
  show ArchiveFormat
Zip = String
".zip"

-- | the access levels for project members. See <https://docs.gitlab.com/ee/user/permissions.html#project-members-permissions>
data AccessLevel
  = Guest
  | Reporter
  | Developer
  | Maintainer
  | Owner
  deriving (AccessLevel -> AccessLevel -> Bool
(AccessLevel -> AccessLevel -> Bool)
-> (AccessLevel -> AccessLevel -> Bool) -> Eq AccessLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessLevel -> AccessLevel -> Bool
$c/= :: AccessLevel -> AccessLevel -> Bool
== :: AccessLevel -> AccessLevel -> Bool
$c== :: AccessLevel -> AccessLevel -> Bool
Eq)

instance Show AccessLevel where
  show :: AccessLevel -> String
show AccessLevel
Guest = String
"10"
  show AccessLevel
Reporter = String
"20"
  show AccessLevel
Developer = String
"30"
  show AccessLevel
Maintainer = String
"40"
  show AccessLevel
Owner = String
"50"

-- | Where to filter a search within
data SearchIn
  = JustTitle
  | JustDescription
  | TitleAndDescription

instance Show SearchIn where
  show :: SearchIn -> String
show SearchIn
JustTitle = String
"title"
  show SearchIn
JustDescription = String
"description"
  show SearchIn
TitleAndDescription = String
"title,description"

-- | Scope of search results
data Scope
  = CreatedByMe
  | AssignedToMe
  | All

instance Show Scope where
  show :: Scope -> String
show Scope
CreatedByMe = String
"created_by_me"
  show Scope
AssignedToMe = String
"assigned_to_me"
  show Scope
All = String
"all"

-- | Sort objects in ascending or descending order
data SortBy
  = Ascending
  | Descending

instance Show SortBy where
  show :: SortBy -> String
show SortBy
Ascending = String
"asc"
  show SortBy
Descending = String
"desc"

-- | Ordering search results
data OrderBy
  = CreatedAt
  | UpdatedAt
  | Priority
  | DueDate
  | RelativePosition
  | LabelPriority
  | MilestoneDue
  | Popularity
  | Weight

instance Show OrderBy where
  show :: OrderBy -> String
show OrderBy
CreatedAt = String
"created_at"
  show OrderBy
UpdatedAt = String
"updated_at"
  show OrderBy
Priority = String
"priority"
  show OrderBy
DueDate = String
"due_date"
  show OrderBy
RelativePosition = String
"relative_position"
  show OrderBy
LabelPriority = String
"label_priority"
  show OrderBy
MilestoneDue = String
"milestone_due"
  show OrderBy
Popularity = String
"popularity"
  show OrderBy
Weight = String
"weight"

-- | member of a project.
data Member = Member
  { Member -> Int
member_id :: Int,
    Member -> Maybe Text
member_name :: Maybe Text,
    Member -> Maybe Text
member_email :: Maybe Text, --- TODO type for email address e.g. zhang@example.com
    Member -> Maybe Text
member_username :: Maybe Text,
    Member -> Maybe Text
member_state :: Maybe Text,
    Member -> Maybe Text
member_avatar_uri :: Maybe Text,
    Member -> Maybe Text
member_web_url :: Maybe Text,
    Member -> Maybe Int
member_access_level :: Maybe Int,
    Member -> Maybe SamlIdentity
member_group_saml_identity :: Maybe SamlIdentity,
    Member -> Maybe Text
member_expires_at :: Maybe Text,
    Member -> Maybe Bool
member_invited :: Maybe Bool,
    Member -> Maybe Bool
member_override :: Maybe Bool,
    Member -> Maybe Text
member_avatar_url :: Maybe Text, -- TODO type for  URL
    Member -> Maybe Bool
member_approved :: Maybe Bool,
    Member -> Maybe Text
member_membership_type :: Maybe Text, -- TODO type for "group_member"
    Member -> Maybe Text
member_last_activity_on :: Maybe Text, -- TODO type for "2021-01-27"
    Member -> Maybe UTCTime
member_created_at :: Maybe UTCTime,
    Member -> Maybe Bool
member_removable :: Maybe Bool,
    Member -> Maybe Text
member_membership_state :: Maybe Text -- type for "active"
  }
  deriving (Int -> Member -> ShowS
[Member] -> ShowS
Member -> String
(Int -> Member -> ShowS)
-> (Member -> String) -> ([Member] -> ShowS) -> Show Member
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Member] -> ShowS
$cshowList :: [Member] -> ShowS
show :: Member -> String
$cshow :: Member -> String
showsPrec :: Int -> Member -> ShowS
$cshowsPrec :: Int -> Member -> ShowS
Show, Member -> Member -> Bool
(Member -> Member -> Bool)
-> (Member -> Member -> Bool) -> Eq Member
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Member -> Member -> Bool
$c/= :: Member -> Member -> Bool
== :: Member -> Member -> Bool
$c== :: Member -> Member -> Bool
Eq)

-- TODO merge Identity and SamlIdentity into a single type.

-- | identity
data Identity = Identity
  { Identity -> Text
identity_extern_uid :: Text,
    Identity -> Text
identity_provider :: Text,
    Identity -> Maybe Int
identity_provider_id :: Maybe Int
  }
  deriving (Int -> Identity -> ShowS
[Identity] -> ShowS
Identity -> String
(Int -> Identity -> ShowS)
-> (Identity -> String) -> ([Identity] -> ShowS) -> Show Identity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identity] -> ShowS
$cshowList :: [Identity] -> ShowS
show :: Identity -> String
$cshow :: Identity -> String
showsPrec :: Int -> Identity -> ShowS
$cshowsPrec :: Int -> Identity -> ShowS
Show, Identity -> Identity -> Bool
(Identity -> Identity -> Bool)
-> (Identity -> Identity -> Bool) -> Eq Identity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identity -> Identity -> Bool
$c/= :: Identity -> Identity -> Bool
== :: Identity -> Identity -> Bool
$c== :: Identity -> Identity -> Bool
Eq)

-- | SAML identity
data SamlIdentity = SamlIdentity
  { SamlIdentity -> Text
saml_identity_extern_uid :: Text,
    SamlIdentity -> Text
saml_identity_provider :: Text,
    SamlIdentity -> Maybe Int
saml_identity_saml_provider_id :: Maybe Int
  }
  deriving (Int -> SamlIdentity -> ShowS
[SamlIdentity] -> ShowS
SamlIdentity -> String
(Int -> SamlIdentity -> ShowS)
-> (SamlIdentity -> String)
-> ([SamlIdentity] -> ShowS)
-> Show SamlIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamlIdentity] -> ShowS
$cshowList :: [SamlIdentity] -> ShowS
show :: SamlIdentity -> String
$cshow :: SamlIdentity -> String
showsPrec :: Int -> SamlIdentity -> ShowS
$cshowsPrec :: Int -> SamlIdentity -> ShowS
Show, SamlIdentity -> SamlIdentity -> Bool
(SamlIdentity -> SamlIdentity -> Bool)
-> (SamlIdentity -> SamlIdentity -> Bool) -> Eq SamlIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamlIdentity -> SamlIdentity -> Bool
$c/= :: SamlIdentity -> SamlIdentity -> Bool
== :: SamlIdentity -> SamlIdentity -> Bool
$c== :: SamlIdentity -> SamlIdentity -> Bool
Eq)

-- | namespaces.
data Namespace = Namespace
  { Namespace -> Int
namespace_id :: Int,
    Namespace -> Text
namespace_name :: Text,
    Namespace -> Text
namespace_path :: Text,
    Namespace -> Text
namespace_kind :: Text,
    Namespace -> Maybe Text
namespace_full_path :: Maybe Text,
    Namespace -> Maybe Text
namespace_avatar_url :: Maybe Text,
    Namespace -> Maybe Text
namespace_web_url :: Maybe Text,
    Namespace -> Maybe Int
namespace_parent_id :: Maybe Int
  }
  deriving (Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq)

-- | links.
data Links = Links
  { Links -> Text
links_self :: Text,
    Links -> Maybe Text
links_issues :: Maybe Text,
    Links -> Maybe Text
links_notes :: Maybe Text,
    Links -> Maybe Text
links_award_emoji :: Maybe Text,
    Links -> Maybe Text
links_project :: Maybe Text,
    Links -> Maybe Text
links_merge_requests :: Maybe Text,
    Links -> Maybe Text
links_repo_branches :: Maybe Text,
    Links -> Maybe Text
links_labels :: Maybe Text,
    Links -> Maybe Text
links_events :: Maybe Text,
    Links -> Maybe Text
links_members :: Maybe Text
  }
  deriving (Int -> Links -> ShowS
[Links] -> ShowS
Links -> String
(Int -> Links -> ShowS)
-> (Links -> String) -> ([Links] -> ShowS) -> Show Links
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Links] -> ShowS
$cshowList :: [Links] -> ShowS
show :: Links -> String
$cshow :: Links -> String
showsPrec :: Int -> Links -> ShowS
$cshowsPrec :: Int -> Links -> ShowS
Show, Links -> Links -> Bool
(Links -> Links -> Bool) -> (Links -> Links -> Bool) -> Eq Links
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Links -> Links -> Bool
$c/= :: Links -> Links -> Bool
== :: Links -> Links -> Bool
$c== :: Links -> Links -> Bool
Eq)

-- | owners.
data Owner = Ownwer
  { Owner -> Int
owner_id :: Int,
    Owner -> Text
owner_name :: Text,
    Owner -> Maybe Text
owner_username :: Maybe Text,
    Owner -> Maybe Text
owner_email :: Maybe Text,
    Owner -> Maybe Text
owner_state :: Maybe Text,
    Owner -> Maybe Text
owner_avatar_url :: Maybe Text,
    Owner -> Maybe Text
owner_web_url :: Maybe Text,
    Owner -> Maybe UTCTime
owner_created_at :: Maybe UTCTime
  }
  deriving (Int -> Owner -> ShowS
[Owner] -> ShowS
Owner -> String
(Int -> Owner -> ShowS)
-> (Owner -> String) -> ([Owner] -> ShowS) -> Show Owner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Owner] -> ShowS
$cshowList :: [Owner] -> ShowS
show :: Owner -> String
$cshow :: Owner -> String
showsPrec :: Int -> Owner -> ShowS
$cshowsPrec :: Int -> Owner -> ShowS
Show, Owner -> Owner -> Bool
(Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> Eq Owner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Owner -> Owner -> Bool
$c/= :: Owner -> Owner -> Bool
== :: Owner -> Owner -> Bool
$c== :: Owner -> Owner -> Bool
Eq)

-- | permissions.
data Permissions = Permissions
  { Permissions -> Maybe Value
permissions_project_access :: Maybe Value,
    Permissions -> Maybe Value
permissions_group_access :: Maybe Value
  }
  deriving (Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> String
(Int -> Permissions -> ShowS)
-> (Permissions -> String)
-> ([Permissions] -> ShowS)
-> Show Permissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Permissions] -> ShowS
$cshowList :: [Permissions] -> ShowS
show :: Permissions -> String
$cshow :: Permissions -> String
showsPrec :: Int -> Permissions -> ShowS
$cshowsPrec :: Int -> Permissions -> ShowS
Show, Permissions -> Permissions -> Bool
(Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool) -> Eq Permissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c== :: Permissions -> Permissions -> Bool
Eq)

-- | projects.
data Project = Project
  { Project -> Int
project_id :: Int,
    Project -> Maybe Text
project_description :: Maybe Text,
    Project -> Text
project_name :: Text,
    Project -> Text
project_name_with_namespace :: Text,
    Project -> Text
project_path :: Text,
    Project -> Text
project_path_with_namespace :: Text,
    Project -> Maybe UTCTime
project_created_at :: Maybe UTCTime,
    Project -> Maybe Text
project_default_branch :: Maybe Text,
    Project -> Maybe [Text]
project_tag_list :: Maybe [Text], --  GitLab Docs: "deprecated, use `topics` instead"
    Project -> Maybe [Text]
project_topics :: Maybe [Text],
    Project -> Maybe Text
project_ssh_url_to_repo :: Maybe Text,
    Project -> Maybe Text
project_http_url_to_repo :: Maybe Text,
    Project -> Text
project_web_url :: Text,
    Project -> Maybe Text
project_readme_url :: Maybe Text, -- check
    Project -> Maybe Text
project_avatar_url :: Maybe Text,
    Project -> Maybe Text
project_license_url :: Maybe Text,
    Project -> Maybe License
project_license :: Maybe License,
    Project -> Maybe Int
project_star_count :: Maybe Int,
    Project -> Maybe Text
project_runners_token :: Maybe Text, -- "b8547b1dc37721d05889db52fa2f02"
    Project -> Maybe Int
project_ci_default_git_depth :: Maybe Int,
    Project -> Maybe Bool
project_ci_forward_deployment_enabled :: Maybe Bool,
    Project -> Maybe Int
project_forks_count :: Maybe Int,
    Project -> Maybe UTCTime
project_last_activity_at :: Maybe UTCTime,
    Project -> Maybe Namespace
project_namespace :: Maybe Namespace,
    Project -> Maybe Bool
project_archived :: Maybe Bool,
    Project -> Maybe Text
project_visibility :: Maybe Text,
    Project -> Maybe Owner
project_owner :: Maybe Owner,
    Project -> Maybe Bool
project_resolve_outdated_diff_discussions :: Maybe Bool,
    Project -> Maybe Bool
project_container_registry_enabled :: Maybe Bool,
    Project -> Maybe Text
project_container_registry_access_level :: Maybe Text, -- TODO
    Project -> Maybe ExpirationPolicy
project_container_expiration_policy :: Maybe ExpirationPolicy,
    -- type for "disabled"
    Project -> Maybe Bool
project_issues_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_merge_requests_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_wiki_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_jobs_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_snippets_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_can_create_merge_request_in :: Maybe Bool,
    Project -> Maybe Text
project_issues_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_repository_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_merge_requests_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_forking_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_analytics_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_wiki_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_builds_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_snippets_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_pages_access_level :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Bool
project_emails_disabled :: Maybe Bool, -- check
    Project -> Maybe Bool
project_shared_runners_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_lfs_enabled :: Maybe Bool,
    Project -> Maybe Int
project_creator_id :: Maybe Int,
    Project -> Maybe Project
project_forked_from_project :: Maybe Project,
    Project -> Maybe String
project_import_status :: Maybe String,
    Project -> Maybe Int
project_open_issues_count :: Maybe Int,
    Project -> Maybe Bool
project_public_jobs :: Maybe Bool,
    Project -> Maybe Int
project_build_timeout :: Maybe Int,
    Project -> Maybe Text
project_auto_cancel_pending_pipelines :: Maybe Text, -- TODO a type for "enabled"
    Project -> Maybe Text
project_ci_config_path :: Maybe Text, -- check null
    Project -> Maybe [GroupShare]
project_shared_with_groups :: Maybe [GroupShare],
    Project -> Maybe Bool
project_only_allow_merge_if_pipeline_succeeds :: Maybe Bool,
    Project -> Maybe Bool
project_allow_merge_on_skipped_pipeline :: Maybe Bool,
    Project -> Maybe Bool
project_restrict_user_defined_variables :: Maybe Bool,
    Project -> Maybe Bool
project_request_access_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,
    Project -> Maybe Bool
project_remove_source_branch_after_merge :: Maybe Bool,
    Project -> Maybe Bool
project_printing_merge_request_link_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_printing_merge_requests_link_enabled :: Maybe Bool,
    Project -> Maybe Text
project_merge_method :: Maybe Text, -- TODO type for "merge"
    Project -> Maybe Text
project_squash_option :: Maybe Text, -- TODO type for "default_on"
    Project -> Maybe Bool
project_autoclose_referenced_issues :: Maybe Bool,
    Project -> Maybe Text
project_suggestion_commit_message :: Maybe Text,
    Project -> Maybe Text
project_marked_for_deletion_at :: Maybe Text, -- TODO "2020-04-03"
    Project -> Maybe Text
project_marked_for_deletion_on :: Maybe Text, -- TODO "2020-04-03"
    Project -> Maybe [Text]
project_compliance_frameworks :: Maybe [Text],
    Project -> Maybe Statistics
project_statistics :: Maybe Statistics,
    Project -> Maybe Permissions
project_permissions :: Maybe Permissions,
    Project -> Maybe Text
project_container_registry_image_prefix :: Maybe Text,
    Project -> Maybe Links
project__links :: Maybe Links,
    Project -> Maybe Bool
project_mirror :: Maybe Bool,
    Project -> Maybe Bool
project_mirror_overwrites_diverged_branches :: Maybe Bool,
    Project -> Maybe Bool
project_mirror_trigger_builds :: Maybe Bool,
    Project -> Maybe Text
project_auto_devops_deploy_strategy :: Maybe Text,
    Project -> Maybe Bool
project_auto_devops_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_service_desk_enabled :: Maybe Bool,
    Project -> Maybe Int
project_approvals_before_merge :: Maybe Int,
    Project -> Maybe Int
project_mirror_user_id :: Maybe Int,
    Project -> Maybe Bool
project_packages_enabled :: Maybe Bool,
    Project -> Maybe Bool
project_empty_repo :: Maybe Bool,
    Project -> Maybe Bool
project_only_mirror_protected_branches :: Maybe Bool,
    Project -> Maybe Text
project_repository_storage :: Maybe Text -- TODO type for "default"
  }
  deriving (Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Project] -> ShowS
$cshowList :: [Project] -> ShowS
show :: Project -> String
$cshow :: Project -> String
showsPrec :: Int -> Project -> ShowS
$cshowsPrec :: Int -> Project -> ShowS
Show, Project -> Project -> Bool
(Project -> Project -> Bool)
-> (Project -> Project -> Bool) -> Eq Project
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Project -> Project -> Bool
$c/= :: Project -> Project -> Bool
== :: Project -> Project -> Bool
$c== :: Project -> Project -> Bool
Eq)

-- | Licenses.
data License = License
  { License -> Maybe Text
license_key :: Maybe Text,
    License -> Maybe Text
license_name :: Maybe Text,
    License -> Maybe Text
license_nickname :: Maybe Text,
    License -> Maybe Text
license_html_url :: Maybe Text,
    License -> Maybe Text
license_source_url :: Maybe Text
  }
  deriving (Int -> License -> ShowS
[License] -> ShowS
License -> String
(Int -> License -> ShowS)
-> (License -> String) -> ([License] -> ShowS) -> Show License
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [License] -> ShowS
$cshowList :: [License] -> ShowS
show :: License -> String
$cshow :: License -> String
showsPrec :: Int -> License -> ShowS
$cshowsPrec :: Int -> License -> ShowS
Show, License -> License -> Bool
(License -> License -> Bool)
-> (License -> License -> Bool) -> Eq License
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: License -> License -> Bool
$c/= :: License -> License -> Bool
== :: License -> License -> Bool
$c== :: License -> License -> Bool
Eq)

-- | Expiration policies.
data ExpirationPolicy = ExpirationPolicy
  { ExpirationPolicy -> Maybe Text
expiration_policy_cadence :: Maybe Text,
    ExpirationPolicy -> Maybe Bool
expiration_policy_enabled :: Maybe Bool,
    ExpirationPolicy -> Maybe Int
expiration_policy_keep_n :: Maybe Int,
    ExpirationPolicy -> Maybe Text
expiration_policy_older_than :: Maybe Text,
    ExpirationPolicy -> Maybe Text
expiration_policy_name_regex :: Maybe Text,
    ExpirationPolicy -> Maybe Value
expiration_policy_name_regex_delete :: Maybe Value, -- TODO
    ExpirationPolicy -> Maybe Value
expiration_policy_name_regex_keep :: Maybe Value, -- TODO
    ExpirationPolicy -> Maybe UTCTime
expiration_policy_next_run_at :: Maybe UTCTime
  }
  deriving (Int -> ExpirationPolicy -> ShowS
[ExpirationPolicy] -> ShowS
ExpirationPolicy -> String
(Int -> ExpirationPolicy -> ShowS)
-> (ExpirationPolicy -> String)
-> ([ExpirationPolicy] -> ShowS)
-> Show ExpirationPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpirationPolicy] -> ShowS
$cshowList :: [ExpirationPolicy] -> ShowS
show :: ExpirationPolicy -> String
$cshow :: ExpirationPolicy -> String
showsPrec :: Int -> ExpirationPolicy -> ShowS
$cshowsPrec :: Int -> ExpirationPolicy -> ShowS
Show, ExpirationPolicy -> ExpirationPolicy -> Bool
(ExpirationPolicy -> ExpirationPolicy -> Bool)
-> (ExpirationPolicy -> ExpirationPolicy -> Bool)
-> Eq ExpirationPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpirationPolicy -> ExpirationPolicy -> Bool
$c/= :: ExpirationPolicy -> ExpirationPolicy -> Bool
== :: ExpirationPolicy -> ExpirationPolicy -> Bool
$c== :: ExpirationPolicy -> ExpirationPolicy -> Bool
Eq)

-- | Information about repository storage.
data RepositoryStorage = RepositoryStorage
  { RepositoryStorage -> Int
repository_storage_project_id :: Int,
    RepositoryStorage -> Maybe Text
repository_storage_disk_path :: Maybe Text,
    RepositoryStorage -> Maybe UTCTime
repository_storage_created_at :: Maybe UTCTime,
    RepositoryStorage -> Maybe Text
repository_storage_repository_storage :: Maybe Text
  }
  deriving (Int -> RepositoryStorage -> ShowS
[RepositoryStorage] -> ShowS
RepositoryStorage -> String
(Int -> RepositoryStorage -> ShowS)
-> (RepositoryStorage -> String)
-> ([RepositoryStorage] -> ShowS)
-> Show RepositoryStorage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryStorage] -> ShowS
$cshowList :: [RepositoryStorage] -> ShowS
show :: RepositoryStorage -> String
$cshow :: RepositoryStorage -> String
showsPrec :: Int -> RepositoryStorage -> ShowS
$cshowsPrec :: Int -> RepositoryStorage -> ShowS
Show, RepositoryStorage -> RepositoryStorage -> Bool
(RepositoryStorage -> RepositoryStorage -> Bool)
-> (RepositoryStorage -> RepositoryStorage -> Bool)
-> Eq RepositoryStorage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryStorage -> RepositoryStorage -> Bool
$c/= :: RepositoryStorage -> RepositoryStorage -> Bool
== :: RepositoryStorage -> RepositoryStorage -> Bool
$c== :: RepositoryStorage -> RepositoryStorage -> Bool
Eq)

-- | project statistics.
data Statistics = Statistics
  { Statistics -> Maybe Int
statistics_commit_count :: Maybe Int,
    Statistics -> Int
statistics_storage_size :: Int,
    Statistics -> Int
statistics_repository_size :: Int,
    Statistics -> Maybe Int
statistics_wiki_size :: Maybe Int,
    Statistics -> Maybe Int
statistics_lfs_objects_size :: Maybe Int,
    Statistics -> Maybe Int
statistics_job_artifacts_size :: Maybe Int,
    Statistics -> Maybe Int
statistics_packages_size :: Maybe Int,
    Statistics -> Maybe Int
statistics_uploads_size :: Maybe Int,
    Statistics -> Maybe Int
statistics_snippets_size :: Maybe Int,
    Statistics -> Maybe Int
statistics_pipeline_artifacts_size :: Maybe Int
  }
  deriving (Int -> Statistics -> ShowS
[Statistics] -> ShowS
Statistics -> String
(Int -> Statistics -> ShowS)
-> (Statistics -> String)
-> ([Statistics] -> ShowS)
-> Show Statistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statistics] -> ShowS
$cshowList :: [Statistics] -> ShowS
show :: Statistics -> String
$cshow :: Statistics -> String
showsPrec :: Int -> Statistics -> ShowS
$cshowsPrec :: Int -> Statistics -> ShowS
Show, Statistics -> Statistics -> Bool
(Statistics -> Statistics -> Bool)
-> (Statistics -> Statistics -> Bool) -> Eq Statistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statistics -> Statistics -> Bool
$c/= :: Statistics -> Statistics -> Bool
== :: Statistics -> Statistics -> Bool
$c== :: Statistics -> Statistics -> Bool
Eq)

-- | registered users.
data User = User
  { User -> Int
user_id :: Int,
    User -> Text
user_username :: Text,
    User -> Maybe Text
user_bio :: Maybe Text,
    User -> Maybe Bool
user_two_factor_enabled :: Maybe Bool,
    User -> Maybe UTCTime
user_last_sign_in_at :: Maybe UTCTime,
    User -> Maybe UTCTime
user_current_sign_in_at :: Maybe UTCTime,
    User -> Maybe Text
user_last_activity_on :: Maybe Text, -- test current-user has '2012-05-23'
    User -> Maybe Text
user_skype :: Maybe Text,
    User -> Maybe Text
user_twitter :: Maybe Text,
    User -> Maybe Text
user_website_url :: Maybe Text,
    User -> Maybe Int
user_theme_id :: Maybe Int,
    User -> Maybe Int
user_color_scheme_id :: Maybe Int,
    User -> Maybe Bool
user_external :: Maybe Bool,
    User -> Maybe Bool
user_private_profile :: Maybe Bool,
    User -> Maybe Int
user_projects_limit :: Maybe Int,
    User -> Maybe Bool
user_can_create_group :: Maybe Bool,
    User -> Maybe Bool
user_can_create_project :: Maybe Bool,
    User -> Maybe Text
user_public_email :: Maybe Text,
    User -> Maybe Text
user_organization :: Maybe Text,
    User -> Maybe Text
user_job_title :: Maybe Text,
    User -> Maybe Text
user_linkedin :: Maybe Text,
    User -> Maybe UTCTime
user_confirmed_at :: Maybe UTCTime,
    User -> Maybe [Identity]
user_identities :: Maybe [Identity],
    User -> Text
user_name :: Text,
    User -> Maybe Text
user_email :: Maybe Text,
    User -> Maybe Int
user_followers :: Maybe Int,
    User -> Maybe Bool
user_bot :: Maybe Bool,
    User -> Maybe Int
user_following :: Maybe Int,
    User -> Text
user_state :: Text,
    User -> Maybe Text
user_avatar_url :: Maybe Text,
    User -> Maybe Text
user_web_url :: Maybe Text,
    User -> Maybe Bool
user_discussion_locked :: Maybe Bool, -- only for author of 'TODO' type
    User -> Maybe UTCTime
user_created_at :: Maybe UTCTime
  }
  deriving (Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq)

-- | milestone state.
data MilestoneState
  = MSActive
  | MSClosed
  deriving (Int -> MilestoneState -> ShowS
[MilestoneState] -> ShowS
MilestoneState -> String
(Int -> MilestoneState -> ShowS)
-> (MilestoneState -> String)
-> ([MilestoneState] -> ShowS)
-> Show MilestoneState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MilestoneState] -> ShowS
$cshowList :: [MilestoneState] -> ShowS
show :: MilestoneState -> String
$cshow :: MilestoneState -> String
showsPrec :: Int -> MilestoneState -> ShowS
$cshowsPrec :: Int -> MilestoneState -> ShowS
Show, MilestoneState -> MilestoneState -> Bool
(MilestoneState -> MilestoneState -> Bool)
-> (MilestoneState -> MilestoneState -> Bool) -> Eq MilestoneState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MilestoneState -> MilestoneState -> Bool
$c/= :: MilestoneState -> MilestoneState -> Bool
== :: MilestoneState -> MilestoneState -> Bool
$c== :: MilestoneState -> MilestoneState -> Bool
Eq)

instance FromJSON MilestoneState where
  parseJSON :: Value -> Parser MilestoneState
parseJSON (String Text
"active") = MilestoneState -> Parser MilestoneState
forall (m :: * -> *) a. Monad m => a -> m a
return MilestoneState
MSActive
  parseJSON (String Text
"closed") = MilestoneState -> Parser MilestoneState
forall (m :: * -> *) a. Monad m => a -> m a
return MilestoneState
MSClosed
  parseJSON Value
x = Value -> Parser MilestoneState
forall a. Value -> Parser a
unexpected Value
x

-- | milestones.
data Milestone = Milestone
  { Milestone -> Maybe Int
milestone_project_id :: Maybe Int,
    Milestone -> Maybe Int
milestone_group_id :: Maybe Int,
    Milestone -> Maybe Text
milestone_description :: Maybe Text,
    Milestone -> Maybe MilestoneState
milestone_state :: Maybe MilestoneState,
    Milestone -> Maybe Text
milestone_due_date :: Maybe Text,
    Milestone -> Maybe Text
milestone_start_date :: Maybe Text,
    Milestone -> Maybe Int
milestone_iid :: Maybe Int,
    Milestone -> Maybe UTCTime
milestone_created_at :: Maybe UTCTime,
    Milestone -> Maybe UTCTime
milestone_closed_at :: Maybe UTCTime,
    Milestone -> Text
milestone_title :: Text,
    Milestone -> Int
milestone_id :: Int,
    Milestone -> Maybe UTCTime
milestone_updated_at :: Maybe UTCTime,
    Milestone -> Maybe Text
milestone_web_url :: Maybe URL
  }
  deriving (Int -> Milestone -> ShowS
[Milestone] -> ShowS
Milestone -> String
(Int -> Milestone -> ShowS)
-> (Milestone -> String)
-> ([Milestone] -> ShowS)
-> Show Milestone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Milestone] -> ShowS
$cshowList :: [Milestone] -> ShowS
show :: Milestone -> String
$cshow :: Milestone -> String
showsPrec :: Int -> Milestone -> ShowS
$cshowsPrec :: Int -> Milestone -> ShowS
Show, Milestone -> Milestone -> Bool
(Milestone -> Milestone -> Bool)
-> (Milestone -> Milestone -> Bool) -> Eq Milestone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Milestone -> Milestone -> Bool
$c/= :: Milestone -> Milestone -> Bool
== :: Milestone -> Milestone -> Bool
$c== :: Milestone -> Milestone -> Bool
Eq)

-- instance FromJSON Milestone where
--   parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = drop 10})

-- | time stats.
data TimeStats = TimeStats
  { TimeStats -> Int
time_stats_time_estimate :: Int,
    TimeStats -> Int
time_stats_total_time_spent :: Int,
    TimeStats -> Maybe Int
time_stats_human_time_estimate :: Maybe Int,
    TimeStats -> Maybe Int
time_stats_human_total_time_spent :: Maybe Int
  }
  deriving (Int -> TimeStats -> ShowS
[TimeStats] -> ShowS
TimeStats -> String
(Int -> TimeStats -> ShowS)
-> (TimeStats -> String)
-> ([TimeStats] -> ShowS)
-> Show TimeStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeStats] -> ShowS
$cshowList :: [TimeStats] -> ShowS
show :: TimeStats -> String
$cshow :: TimeStats -> String
showsPrec :: Int -> TimeStats -> ShowS
$cshowsPrec :: Int -> TimeStats -> ShowS
Show, TimeStats -> TimeStats -> Bool
(TimeStats -> TimeStats -> Bool)
-> (TimeStats -> TimeStats -> Bool) -> Eq TimeStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeStats -> TimeStats -> Bool
$c/= :: TimeStats -> TimeStats -> Bool
== :: TimeStats -> TimeStats -> Bool
$c== :: TimeStats -> TimeStats -> Bool
Eq)

-- | alias for project id
type ProjectId = Int

-- | alias for issue id
type IssueId = Int

-- | project issues.
data Issue = Issue
  { Issue -> Text
issue_state :: Text,
    Issue -> Maybe Text
issue_description :: Maybe Text,
    Issue -> Maybe Text
issue_health_status :: Maybe Text, -- TODO type for "on_track"
    Issue -> Maybe User
issue_author :: Maybe User,
    Issue -> Maybe Milestone
issue_milestone :: Maybe Milestone,
    Issue -> Maybe Int
issue_project_id :: Maybe ProjectId,
    Issue -> Maybe [User]
issue_assignees :: Maybe [User],
    Issue -> Maybe User
issue_assignee :: Maybe User,
    Issue -> Maybe UTCTime
issue_updated_at :: Maybe UTCTime,
    Issue -> Maybe Text
issue_closed_at :: Maybe Text,
    Issue -> Maybe User
issue_closed_by :: Maybe User,
    Issue -> Int
issue_id :: IssueId,
    Issue -> Text
issue_title :: Text,
    Issue -> Maybe UTCTime
issue_created_at :: Maybe UTCTime,
    Issue -> Int
issue_iid :: Int,
    -- TODO: what is the difference between the two below?
    Issue -> Maybe Text
issue_type :: Maybe Text, -- type for this e.g. "ISSUE"
    Issue -> Maybe Text
issue_issue_type :: Maybe Text, -- type for this e.g. "issue"
    Issue -> Maybe [Text]
issue_labels :: Maybe [Text],
    Issue -> Int
issue_upvotes :: Int,
    Issue -> Int
issue_downvotes :: Int,
    Issue -> Maybe Int
issue_merge_requests_count :: Maybe Int,
    Issue -> Maybe Int
issue_user_notes_count :: Maybe Int,
    Issue -> Maybe Text
issue_due_date :: Maybe Text,
    Issue -> Text
issue_web_url :: Text,
    Issue -> Maybe References
issue_references :: Maybe References,
    Issue -> Maybe Bool
issue_confidential :: Maybe Bool,
    Issue -> Maybe Text
issue_weight :: Maybe Text, -- Int?
    Issue -> Maybe Epic
issue_epic :: Maybe Epic, -- Int?
    Issue -> Maybe Bool
issue_discussion_locked :: Maybe Bool,
    Issue -> Maybe TimeStats
issue_time_stats :: Maybe TimeStats,
    Issue -> Maybe Bool
issue_has_tasks :: Maybe Bool,
    Issue -> Maybe Text
issue_task_status :: Maybe Text,
    Issue -> Maybe Links
issue__links :: Maybe Links,
    Issue -> Maybe TaskCompletionStatus
issue_task_completion_status :: Maybe TaskCompletionStatus,
    Issue -> Maybe Int
issue_blocking_issues_count :: Maybe Int,
    Issue -> Maybe Bool
issue_subscribed :: Maybe Bool,
    Issue -> Maybe Text
issue_service_desk_reply_to :: Maybe Text
  }
  deriving (Int -> Issue -> ShowS
[Issue] -> ShowS
Issue -> String
(Int -> Issue -> ShowS)
-> (Issue -> String) -> ([Issue] -> ShowS) -> Show Issue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue] -> ShowS
$cshowList :: [Issue] -> ShowS
show :: Issue -> String
$cshow :: Issue -> String
showsPrec :: Int -> Issue -> ShowS
$cshowsPrec :: Int -> Issue -> ShowS
Show, Issue -> Issue -> Bool
(Issue -> Issue -> Bool) -> (Issue -> Issue -> Bool) -> Eq Issue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue -> Issue -> Bool
$c/= :: Issue -> Issue -> Bool
== :: Issue -> Issue -> Bool
$c== :: Issue -> Issue -> Bool
Eq)

-- | GitLab epic.
data Epic = Epic
  { Epic -> Int
epic_id :: Int,
    Epic -> Int
epic_iid :: Int,
    Epic -> Text
epic_title :: Text,
    Epic -> Text
epic_url :: Text,
    Epic -> Int
epic_group_id :: Int
  }
  deriving (Int -> Epic -> ShowS
[Epic] -> ShowS
Epic -> String
(Int -> Epic -> ShowS)
-> (Epic -> String) -> ([Epic] -> ShowS) -> Show Epic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Epic] -> ShowS
$cshowList :: [Epic] -> ShowS
show :: Epic -> String
$cshow :: Epic -> String
showsPrec :: Int -> Epic -> ShowS
$cshowsPrec :: Int -> Epic -> ShowS
Show, Epic -> Epic -> Bool
(Epic -> Epic -> Bool) -> (Epic -> Epic -> Bool) -> Eq Epic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Epic -> Epic -> Bool
$c/= :: Epic -> Epic -> Bool
== :: Epic -> Epic -> Bool
$c== :: Epic -> Epic -> Bool
Eq)

-- | project pipelines
data Pipeline = Pipeline
  { Pipeline -> Int
pipeline_id :: Int,
    Pipeline -> Maybe Int
pipeline_iid :: Maybe Int,
    Pipeline -> Maybe Int
pipeline_project_id :: Maybe Int,
    Pipeline -> Text
pipeline_sha :: Text,
    Pipeline -> Text
pipeline_ref :: Text,
    Pipeline -> Text
pipeline_status :: Text,
    Pipeline -> Maybe Text
pipeline_web_url :: Maybe Text,
    Pipeline -> Maybe Text
pipeline_before_sha :: Maybe Text,
    Pipeline -> Maybe Bool
pipeline_tag :: Maybe Bool,
    Pipeline -> Maybe Text
pipeline_yaml_errors :: Maybe Text,
    Pipeline -> Maybe User
pipeline_user :: Maybe User,
    Pipeline -> Maybe UTCTime
pipeline_created_at :: Maybe UTCTime,
    Pipeline -> Maybe UTCTime
pipeline_updated_at :: Maybe UTCTime,
    Pipeline -> Maybe UTCTime
pipeline_started_at :: Maybe UTCTime,
    Pipeline -> Maybe UTCTime
pipeline_finished_at :: Maybe UTCTime,
    Pipeline -> Maybe UTCTime
pipelined_committed_at :: Maybe UTCTime,
    Pipeline -> Maybe Int
pipeline_duration :: Maybe Int,
    Pipeline -> Maybe Double
pipeline_queued_duration :: Maybe Double,
    Pipeline -> Maybe Text
pipeline_coverage :: Maybe Text,
    Pipeline -> Maybe DetailedStatus
pipeline_detailed_status :: Maybe DetailedStatus
  }
  deriving (Int -> Pipeline -> ShowS
[Pipeline] -> ShowS
Pipeline -> String
(Int -> Pipeline -> ShowS)
-> (Pipeline -> String) -> ([Pipeline] -> ShowS) -> Show Pipeline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pipeline] -> ShowS
$cshowList :: [Pipeline] -> ShowS
show :: Pipeline -> String
$cshow :: Pipeline -> String
showsPrec :: Int -> Pipeline -> ShowS
$cshowsPrec :: Int -> Pipeline -> ShowS
Show, Pipeline -> Pipeline -> Bool
(Pipeline -> Pipeline -> Bool)
-> (Pipeline -> Pipeline -> Bool) -> Eq Pipeline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pipeline -> Pipeline -> Bool
$c/= :: Pipeline -> Pipeline -> Bool
== :: Pipeline -> Pipeline -> Bool
$c== :: Pipeline -> Pipeline -> Bool
Eq)

-- | project pipelines
data DetailedStatus = DetailedStatus
  { DetailedStatus -> Maybe Text
detailed_status_icon :: Maybe Text, -- "status_pending"
    DetailedStatus -> Maybe Text
detailed_status_text :: Maybe Text,
    DetailedStatus -> Maybe Text
detailed_status_label :: Maybe Text,
    DetailedStatus -> Maybe Text
detailed_status_group :: Maybe Text,
    DetailedStatus -> Maybe Text
detailed_status_tooltip :: Maybe Text,
    DetailedStatus -> Maybe Bool
detailed_status_has_details :: Maybe Bool,
    DetailedStatus -> Maybe Text
detailed_status_details_path :: Maybe Text,
    DetailedStatus -> Maybe Text
detailed_status_illustration :: Maybe Text,
    DetailedStatus -> Maybe Text
detailed_status_favicon :: Maybe Text
  }
  deriving (Int -> DetailedStatus -> ShowS
[DetailedStatus] -> ShowS
DetailedStatus -> String
(Int -> DetailedStatus -> ShowS)
-> (DetailedStatus -> String)
-> ([DetailedStatus] -> ShowS)
-> Show DetailedStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetailedStatus] -> ShowS
$cshowList :: [DetailedStatus] -> ShowS
show :: DetailedStatus -> String
$cshow :: DetailedStatus -> String
showsPrec :: Int -> DetailedStatus -> ShowS
$cshowsPrec :: Int -> DetailedStatus -> ShowS
Show, DetailedStatus -> DetailedStatus -> Bool
(DetailedStatus -> DetailedStatus -> Bool)
-> (DetailedStatus -> DetailedStatus -> Bool) -> Eq DetailedStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetailedStatus -> DetailedStatus -> Bool
$c/= :: DetailedStatus -> DetailedStatus -> Bool
== :: DetailedStatus -> DetailedStatus -> Bool
$c== :: DetailedStatus -> DetailedStatus -> Bool
Eq)

-- | code commits.
data Commit = Commit
  { Commit -> Text
commit_id :: Text,
    Commit -> Text
commit_short_id :: Text,
    Commit -> Text
commit_title :: Text,
    Commit -> Text
commit_author_name :: Text,
    Commit -> Text
commit_author_email :: Text,
    Commit -> Maybe Text
commit_authored_date :: Maybe Text, -- ZonedTime ?
    Commit -> Maybe Text
commit_committer_name :: Maybe Text,
    Commit -> Maybe Text
commit_committer_email :: Maybe Text,
    Commit -> Maybe Text
commit_committed_date :: Maybe Text, -- ZonedTime ?
    Commit -> Maybe Text
commit_created_at :: Maybe Text, -- ZonedTime ?
    Commit -> Text
commit_message :: Text,
    Commit -> Maybe [String]
commit_parent_ids :: Maybe [String],
    Commit -> Maybe Pipeline
commit_last_pipeline :: Maybe Pipeline,
    Commit -> Maybe CommitStats
commit_stats :: Maybe CommitStats,
    Commit -> Maybe Text
commit_status :: Maybe Text,
    Commit -> Maybe Text
commit_web_url :: Maybe Text
  }
  deriving (Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> String
(Int -> Commit -> ShowS)
-> (Commit -> String) -> ([Commit] -> ShowS) -> Show Commit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commit] -> ShowS
$cshowList :: [Commit] -> ShowS
show :: Commit -> String
$cshow :: Commit -> String
showsPrec :: Int -> Commit -> ShowS
$cshowsPrec :: Int -> Commit -> ShowS
Show, Commit -> Commit -> Bool
(Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool) -> Eq Commit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commit -> Commit -> Bool
$c/= :: Commit -> Commit -> Bool
== :: Commit -> Commit -> Bool
$c== :: Commit -> Commit -> Bool
Eq)

-- | summary of a code commit for TODOs.
data CommitTodo = CommitTodo
  { CommitTodo -> Text
commit_todo_id :: Text,
    CommitTodo -> Text
commit_todo_short_id :: Text,
    CommitTodo -> UTCTime
commit_todo_created_at :: UTCTime,
    CommitTodo -> Maybe [String]
commit_todo_parent_ids :: Maybe [String]
  }
  deriving (Int -> CommitTodo -> ShowS
[CommitTodo] -> ShowS
CommitTodo -> String
(Int -> CommitTodo -> ShowS)
-> (CommitTodo -> String)
-> ([CommitTodo] -> ShowS)
-> Show CommitTodo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitTodo] -> ShowS
$cshowList :: [CommitTodo] -> ShowS
show :: CommitTodo -> String
$cshow :: CommitTodo -> String
showsPrec :: Int -> CommitTodo -> ShowS
$cshowsPrec :: Int -> CommitTodo -> ShowS
Show, CommitTodo -> CommitTodo -> Bool
(CommitTodo -> CommitTodo -> Bool)
-> (CommitTodo -> CommitTodo -> Bool) -> Eq CommitTodo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitTodo -> CommitTodo -> Bool
$c/= :: CommitTodo -> CommitTodo -> Bool
== :: CommitTodo -> CommitTodo -> Bool
$c== :: CommitTodo -> CommitTodo -> Bool
Eq)

-- | repository contributors.
data Contributor = Contributor
  { Contributor -> Text
contributor_name :: Text,
    Contributor -> Text
contributor_email :: Text,
    Contributor -> Int
contributor_commits :: Int,
    Contributor -> Int
contributor_additions :: Int,
    Contributor -> Int
contributor_deletions :: Int
  }
  deriving (Int -> Contributor -> ShowS
[Contributor] -> ShowS
Contributor -> String
(Int -> Contributor -> ShowS)
-> (Contributor -> String)
-> ([Contributor] -> ShowS)
-> Show Contributor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contributor] -> ShowS
$cshowList :: [Contributor] -> ShowS
show :: Contributor -> String
$cshow :: Contributor -> String
showsPrec :: Int -> Contributor -> ShowS
$cshowsPrec :: Int -> Contributor -> ShowS
Show, Contributor -> Contributor -> Bool
(Contributor -> Contributor -> Bool)
-> (Contributor -> Contributor -> Bool) -> Eq Contributor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contributor -> Contributor -> Bool
$c/= :: Contributor -> Contributor -> Bool
== :: Contributor -> Contributor -> Bool
$c== :: Contributor -> Contributor -> Bool
Eq)

-- | commit stats.
data CommitStats = CommitStats
  { CommitStats -> Int
commitstats_additions :: Int,
    CommitStats -> Int
commitstats_deletions :: Int,
    CommitStats -> Int
commitstats_total :: Int
  }
  deriving (Int -> CommitStats -> ShowS
[CommitStats] -> ShowS
CommitStats -> String
(Int -> CommitStats -> ShowS)
-> (CommitStats -> String)
-> ([CommitStats] -> ShowS)
-> Show CommitStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitStats] -> ShowS
$cshowList :: [CommitStats] -> ShowS
show :: CommitStats -> String
$cshow :: CommitStats -> String
showsPrec :: Int -> CommitStats -> ShowS
$cshowsPrec :: Int -> CommitStats -> ShowS
Show, CommitStats -> CommitStats -> Bool
(CommitStats -> CommitStats -> Bool)
-> (CommitStats -> CommitStats -> Bool) -> Eq CommitStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitStats -> CommitStats -> Bool
$c/= :: CommitStats -> CommitStats -> Bool
== :: CommitStats -> CommitStats -> Bool
$c== :: CommitStats -> CommitStats -> Bool
Eq)

-- | tags.
data Tag = Tag
  { Tag -> Commit
tag_commit :: Commit,
    Tag -> Maybe Release
tag_release :: Maybe Release,
    Tag -> Text
tag_name :: Text,
    Tag -> Text
tag_target :: Text,
    Tag -> Maybe Text
tag_message :: Maybe Text,
    Tag -> Bool
tag_protected :: Bool
  }
  deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq)

-- | Release associated with a tag
data Release = Release
  { Release -> Text
release_tag_name :: Text,
    Release -> Text
release_description :: Text
  }
  deriving (Int -> Release -> ShowS
[Release] -> ShowS
Release -> String
(Int -> Release -> ShowS)
-> (Release -> String) -> ([Release] -> ShowS) -> Show Release
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Release] -> ShowS
$cshowList :: [Release] -> ShowS
show :: Release -> String
$cshow :: Release -> String
showsPrec :: Int -> Release -> ShowS
$cshowsPrec :: Int -> Release -> ShowS
Show, Release -> Release -> Bool
(Release -> Release -> Bool)
-> (Release -> Release -> Bool) -> Eq Release
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Release -> Release -> Bool
$c/= :: Release -> Release -> Bool
== :: Release -> Release -> Bool
$c== :: Release -> Release -> Bool
Eq)

-- | diff between two commits.
data Diff = Diff
  { Diff -> Text
diff_diff :: Text,
    Diff -> Text
diff_new_path :: Text,
    Diff -> Text
diff_old_path :: Text,
    Diff -> Maybe Text
diff_a_mode :: Maybe Text,
    Diff -> Maybe Text
diff_b_mode :: Maybe Text,
    Diff -> Bool
diff_new_file :: Bool,
    Diff -> Bool
diff_renamed_file :: Bool,
    Diff -> Bool
diff_deleted_file :: Bool
  }
  deriving (Int -> Diff -> ShowS
[Diff] -> ShowS
Diff -> String
(Int -> Diff -> ShowS)
-> (Diff -> String) -> ([Diff] -> ShowS) -> Show Diff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diff] -> ShowS
$cshowList :: [Diff] -> ShowS
show :: Diff -> String
$cshow :: Diff -> String
showsPrec :: Int -> Diff -> ShowS
$cshowsPrec :: Int -> Diff -> ShowS
Show, Diff -> Diff -> Bool
(Diff -> Diff -> Bool) -> (Diff -> Diff -> Bool) -> Eq Diff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diff -> Diff -> Bool
$c/= :: Diff -> Diff -> Bool
== :: Diff -> Diff -> Bool
$c== :: Diff -> Diff -> Bool
Eq)

-- | repositories.
data Repository = Repository
  { Repository -> Text
repository_id :: Text,
    Repository -> Text
repository_name :: Text,
    Repository -> Text
repository_type :: Text,
    Repository -> Text
repository_path :: Text,
    Repository -> Text
repository_mode :: Text
  }
  deriving (Int -> Repository -> ShowS
[Repository] -> ShowS
Repository -> String
(Int -> Repository -> ShowS)
-> (Repository -> String)
-> ([Repository] -> ShowS)
-> Show Repository
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repository] -> ShowS
$cshowList :: [Repository] -> ShowS
show :: Repository -> String
$cshow :: Repository -> String
showsPrec :: Int -> Repository -> ShowS
$cshowsPrec :: Int -> Repository -> ShowS
Show, Repository -> Repository -> Bool
(Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool) -> Eq Repository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repository -> Repository -> Bool
$c/= :: Repository -> Repository -> Bool
== :: Repository -> Repository -> Bool
$c== :: Repository -> Repository -> Bool
Eq)

-- | artifacts.
data Artifact = Artifact
  { Artifact -> Maybe Text
artifact_file_type :: Maybe Text,
    Artifact -> Int
artifact_size :: Int,
    Artifact -> Text
artifact_filename :: Text,
    Artifact -> Maybe Text
artifact_file_format :: Maybe Text
  }
  deriving (Int -> Artifact -> ShowS
[Artifact] -> ShowS
Artifact -> String
(Int -> Artifact -> ShowS)
-> (Artifact -> String) -> ([Artifact] -> ShowS) -> Show Artifact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Artifact] -> ShowS
$cshowList :: [Artifact] -> ShowS
show :: Artifact -> String
$cshow :: Artifact -> String
showsPrec :: Int -> Artifact -> ShowS
$cshowsPrec :: Int -> Artifact -> ShowS
Show, Artifact -> Artifact -> Bool
(Artifact -> Artifact -> Bool)
-> (Artifact -> Artifact -> Bool) -> Eq Artifact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Artifact -> Artifact -> Bool
$c/= :: Artifact -> Artifact -> Bool
== :: Artifact -> Artifact -> Bool
$c== :: Artifact -> Artifact -> Bool
Eq)

-- | groups.
data Group = Group
  { Group -> Int
group_id :: Int,
    Group -> Text
group_name :: Text,
    Group -> Maybe Text
group_path :: Maybe Text,
    Group -> Maybe Text
group_description :: Maybe Text,
    Group -> Maybe Text
group_visibility :: Maybe Text,
    Group -> Maybe Bool
group_share_with_group_lock :: Maybe Bool,
    Group -> Maybe Bool
group_require_two_factor_authentication :: Maybe Bool,
    Group -> Maybe Int
group_two_factor_grace_period :: Maybe Int,
    Group -> Maybe Text
group_project_creation_level :: Maybe Text, -- TODO type for "developer"
    Group -> Maybe Bool
group_auto_devops_enabled :: Maybe Bool,
    Group -> Maybe Text
group_subgroup_creation_level :: Maybe Text, -- TODO type for "owner"
    Group -> Maybe Bool
group_emails_disabled :: Maybe Bool,
    Group -> Maybe Bool
group_mentions_disabled :: Maybe Bool,
    Group -> Maybe Int
group_default_branch_protection :: Maybe Int,
    Group -> Maybe Bool
group_lfs_enabled :: Maybe Bool,
    Group -> Maybe Text
group_avatar_url :: Maybe Text,
    Group -> Maybe Text
group_web_url :: Maybe Text,
    Group -> Maybe Bool
group_request_access_enabled :: Maybe Bool,
    Group -> Maybe Text
group_full_name :: Maybe Text,
    Group -> Maybe Text
group_full_path :: Maybe Text,
    Group -> Maybe Text
group_runners_token :: Maybe Text,
    Group -> Maybe Int
group_file_template_project_id :: Maybe Int,
    Group -> Maybe Int
group_parent_id :: Maybe Int,
    Group -> Maybe UTCTime
group_created_at :: Maybe UTCTime,
    Group -> Maybe Statistics
group_statistics :: Maybe Statistics,
    Group -> Maybe [GroupShare]
group_shared_with_groups :: Maybe [GroupShare],
    Group -> Maybe Bool
group_prevent_sharing_groups_outside_hierarchy :: Maybe Bool
  }
  deriving (Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show, Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq)

-- | response to sharing a project with a group.
data GroupShare = GroupShare
  { GroupShare -> Maybe Int
groupshare_id :: Maybe Int,
    GroupShare -> Maybe Int
groupshare_project_id :: Maybe Int,
    GroupShare -> Int
groupshare_group_id :: Int,
    GroupShare -> Maybe Text
groupshare_group_name :: Maybe Text,
    GroupShare -> Maybe Text
groupshare_group_full_path :: Maybe Text,
    GroupShare -> Int
groupshare_group_access_level :: Int, -- TODO change this to 'AccessLevel'
    GroupShare -> Maybe Text
groupshare_expires_at :: Maybe Text
  }
  deriving (Int -> GroupShare -> ShowS
[GroupShare] -> ShowS
GroupShare -> String
(Int -> GroupShare -> ShowS)
-> (GroupShare -> String)
-> ([GroupShare] -> ShowS)
-> Show GroupShare
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupShare] -> ShowS
$cshowList :: [GroupShare] -> ShowS
show :: GroupShare -> String
$cshow :: GroupShare -> String
showsPrec :: Int -> GroupShare -> ShowS
$cshowsPrec :: Int -> GroupShare -> ShowS
Show, GroupShare -> GroupShare -> Bool
(GroupShare -> GroupShare -> Bool)
-> (GroupShare -> GroupShare -> Bool) -> Eq GroupShare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupShare -> GroupShare -> Bool
$c/= :: GroupShare -> GroupShare -> Bool
== :: GroupShare -> GroupShare -> Bool
$c== :: GroupShare -> GroupShare -> Bool
Eq)

-- | code branches.
data Branch = Branch
  { Branch -> Text
branch_name :: Text,
    Branch -> Bool
branch_merged :: Bool,
    Branch -> Bool
branch_protected :: Bool,
    Branch -> Bool
branch_default :: Bool,
    Branch -> Bool
branch_developers_can_push :: Bool,
    Branch -> Bool
branch_developers_can_merge :: Bool,
    Branch -> Bool
branch_can_push :: Bool,
    Branch -> Maybe Text
branch_web_url :: Maybe Text,
    Branch -> Commit
branch_commit :: Commit
  }
  deriving (Int -> Branch -> ShowS
[Branch] -> ShowS
Branch -> String
(Int -> Branch -> ShowS)
-> (Branch -> String) -> ([Branch] -> ShowS) -> Show Branch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Branch] -> ShowS
$cshowList :: [Branch] -> ShowS
show :: Branch -> String
$cshow :: Branch -> String
showsPrec :: Int -> Branch -> ShowS
$cshowsPrec :: Int -> Branch -> ShowS
Show, Branch -> Branch -> Bool
(Branch -> Branch -> Bool)
-> (Branch -> Branch -> Bool) -> Eq Branch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Branch -> Branch -> Bool
$c/= :: Branch -> Branch -> Bool
== :: Branch -> Branch -> Bool
$c== :: Branch -> Branch -> Bool
Eq)

-- | files in a repository.
data RepositoryFile = RepositoryFile
  { RepositoryFile -> Text
repository_file_file_name :: Text,
    RepositoryFile -> Text
repository_file_file_path :: Text,
    RepositoryFile -> Int
repository_file_size :: Int,
    RepositoryFile -> Text
repository_file_encoding :: Text,
    RepositoryFile -> Text
repository_file_content :: Text,
    RepositoryFile -> Text
repository_file_content_sha256 :: Text,
    RepositoryFile -> Text
repository_file_ref :: Text,
    RepositoryFile -> Text
repository_file_blob_id :: Text,
    RepositoryFile -> Text
repository_file_commit_id :: Text,
    RepositoryFile -> Text
repository_file_last_commit_id :: Text,
    RepositoryFile -> Maybe Bool
repository_file_execute_filemode :: Maybe Bool
  }
  deriving (Int -> RepositoryFile -> ShowS
[RepositoryFile] -> ShowS
RepositoryFile -> String
(Int -> RepositoryFile -> ShowS)
-> (RepositoryFile -> String)
-> ([RepositoryFile] -> ShowS)
-> Show RepositoryFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryFile] -> ShowS
$cshowList :: [RepositoryFile] -> ShowS
show :: RepositoryFile -> String
$cshow :: RepositoryFile -> String
showsPrec :: Int -> RepositoryFile -> ShowS
$cshowsPrec :: Int -> RepositoryFile -> ShowS
Show, RepositoryFile -> RepositoryFile -> Bool
(RepositoryFile -> RepositoryFile -> Bool)
-> (RepositoryFile -> RepositoryFile -> Bool) -> Eq RepositoryFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryFile -> RepositoryFile -> Bool
$c/= :: RepositoryFile -> RepositoryFile -> Bool
== :: RepositoryFile -> RepositoryFile -> Bool
$c== :: RepositoryFile -> RepositoryFile -> Bool
Eq)

-- | files in a repository.
data RepositoryFileSimple = RepositoryFileSimple
  { RepositoryFileSimple -> Text
repository_file_simple_file_path :: Text,
    RepositoryFileSimple -> Text
repository_file_simple_branch :: Text
  }
  deriving (Int -> RepositoryFileSimple -> ShowS
[RepositoryFileSimple] -> ShowS
RepositoryFileSimple -> String
(Int -> RepositoryFileSimple -> ShowS)
-> (RepositoryFileSimple -> String)
-> ([RepositoryFileSimple] -> ShowS)
-> Show RepositoryFileSimple
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryFileSimple] -> ShowS
$cshowList :: [RepositoryFileSimple] -> ShowS
show :: RepositoryFileSimple -> String
$cshow :: RepositoryFileSimple -> String
showsPrec :: Int -> RepositoryFileSimple -> ShowS
$cshowsPrec :: Int -> RepositoryFileSimple -> ShowS
Show, RepositoryFileSimple -> RepositoryFileSimple -> Bool
(RepositoryFileSimple -> RepositoryFileSimple -> Bool)
-> (RepositoryFileSimple -> RepositoryFileSimple -> Bool)
-> Eq RepositoryFileSimple
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryFileSimple -> RepositoryFileSimple -> Bool
$c/= :: RepositoryFileSimple -> RepositoryFileSimple -> Bool
== :: RepositoryFileSimple -> RepositoryFileSimple -> Bool
$c== :: RepositoryFileSimple -> RepositoryFileSimple -> Bool
Eq)

-- | files in a repository.
data RepositoryFileBlame = RepositoryFileBlame
  { RepositoryFileBlame -> Commit
repository_file_blame_commit :: Commit,
    RepositoryFileBlame -> [Text]
repository_file_blame_lines :: [Text]
  }
  deriving (Int -> RepositoryFileBlame -> ShowS
[RepositoryFileBlame] -> ShowS
RepositoryFileBlame -> String
(Int -> RepositoryFileBlame -> ShowS)
-> (RepositoryFileBlame -> String)
-> ([RepositoryFileBlame] -> ShowS)
-> Show RepositoryFileBlame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryFileBlame] -> ShowS
$cshowList :: [RepositoryFileBlame] -> ShowS
show :: RepositoryFileBlame -> String
$cshow :: RepositoryFileBlame -> String
showsPrec :: Int -> RepositoryFileBlame -> ShowS
$cshowsPrec :: Int -> RepositoryFileBlame -> ShowS
Show, RepositoryFileBlame -> RepositoryFileBlame -> Bool
(RepositoryFileBlame -> RepositoryFileBlame -> Bool)
-> (RepositoryFileBlame -> RepositoryFileBlame -> Bool)
-> Eq RepositoryFileBlame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepositoryFileBlame -> RepositoryFileBlame -> Bool
$c/= :: RepositoryFileBlame -> RepositoryFileBlame -> Bool
== :: RepositoryFileBlame -> RepositoryFileBlame -> Bool
$c== :: RepositoryFileBlame -> RepositoryFileBlame -> Bool
Eq)

-- | project merge requests.
data MergeRequest = MergeRequest
  { MergeRequest -> Int
merge_request_id :: Int,
    MergeRequest -> Int
merge_request_iid :: Int,
    MergeRequest -> Int
merge_request_project_id :: Int,
    MergeRequest -> Text
merge_request_title :: Text,
    MergeRequest -> Text
merge_request_description :: Text,
    MergeRequest -> Text
merge_request_state :: Text, -- TODO make a type e.g. 'reopened'
    MergeRequest -> UTCTime
merge_request_created_at :: UTCTime,
    MergeRequest -> UTCTime
merge_request_updated_at :: UTCTime,
    MergeRequest -> Text
merge_request_target_branch :: Text,
    MergeRequest -> Text
merge_request_source_branch :: Text,
    MergeRequest -> Int
merge_request_upvotes :: Int,
    MergeRequest -> Int
merge_request_downvotes :: Int,
    MergeRequest -> User
merge_request_author :: User,
    MergeRequest -> Maybe User
merge_request_assignee :: Maybe User,
    MergeRequest -> Maybe [User]
merge_request_assignees :: Maybe [User],
    MergeRequest -> Maybe [User]
merge_request_reviewers :: Maybe [User],
    MergeRequest -> Int
merge_request_source_project_id :: Int,
    MergeRequest -> Int
merge_request_target_project_id :: Int,
    MergeRequest -> [Text]
merge_request_labels :: [Text],
    MergeRequest -> Maybe Bool
merge_request_draft :: Maybe Bool,
    MergeRequest -> Bool
merge_request_work_in_progress :: Bool,
    MergeRequest -> Maybe Milestone
merge_request_milestone :: Maybe Milestone,
    MergeRequest -> Bool
merge_request_merge_when_pipeline_succeeds :: Bool,
    MergeRequest -> Text
merge_request_merge_status :: Text, -- create type e.g. for "can_be_merged"
    MergeRequest -> Maybe Text
merge_request_merge_error :: Maybe Text,
    MergeRequest -> Maybe Text
merge_request_sha :: Maybe Text,
    MergeRequest -> Maybe Text
merge_request_merge_commit_sha :: Maybe Text,
    MergeRequest -> Maybe Text
merge_request_squash_commit_sha :: Maybe Text,
    MergeRequest -> Int
merge_request_user_notes_count :: Int,
    MergeRequest -> Maybe Bool
merge_request_discussion_locked :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_should_remove_source_branch :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_force_remove_source_branch :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_allow_collaboration :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_allow_maintainer_to_push :: Maybe Bool,
    MergeRequest -> Maybe Text
merge_request_web_url :: Maybe Text,
    MergeRequest -> Maybe TimeStats
merge_request_time_stats :: Maybe TimeStats,
    MergeRequest -> Maybe Bool
merge_request_squash :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_subscribed :: Maybe Bool,
    MergeRequest -> Maybe String
merge_request_changes_count :: Maybe String,
    MergeRequest -> Maybe User
merge_request_merged_by :: Maybe User,
    MergeRequest -> Maybe UTCTime
merge_request_merged_at :: Maybe UTCTime,
    MergeRequest -> Maybe User
merge_request_closed_by :: Maybe User,
    MergeRequest -> Maybe UTCTime
merge_request_closed_at :: Maybe UTCTime,
    MergeRequest -> Maybe UTCTime
merge_request_latest_build_started_at :: Maybe UTCTime,
    MergeRequest -> Maybe UTCTime
merge_request_latest_build_finished_at :: Maybe UTCTime,
    MergeRequest -> Maybe UTCTime
merge_request_first_deployed_to_production_at :: Maybe UTCTime,
    MergeRequest -> Maybe Pipeline
merge_request_pipeline :: Maybe Pipeline,
    MergeRequest -> Maybe Pipeline
merge_request_head_pipeline :: Maybe Pipeline,
    MergeRequest -> Maybe Int
merge_request_diverged_commits_count :: Maybe Int,
    MergeRequest -> Maybe Bool
merge_request_rebase_in_progress :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_first_contribution :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_has_conflicts :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_blocking_discussions_resolved :: Maybe Bool,
    MergeRequest -> Maybe Int
merge_request_approvals_before_merge :: Maybe Int,
    MergeRequest -> Maybe Bool
merge_request_mirror :: Maybe Bool,
    MergeRequest -> Maybe TaskCompletionStatus
merge_request_task_completion_status :: Maybe TaskCompletionStatus,
    MergeRequest -> Maybe Text
merge_request_reference :: Maybe Text,
    MergeRequest -> Maybe References
merge_request_references :: Maybe References,
    MergeRequest -> Maybe [Change]
merge_request_changes :: Maybe [Change],
    MergeRequest -> Maybe Bool
merge_request_overflow :: Maybe Bool,
    MergeRequest -> Maybe DiffRefs
merge_request_diff_refs :: Maybe DiffRefs
  }
  deriving (Int -> MergeRequest -> ShowS
[MergeRequest] -> ShowS
MergeRequest -> String
(Int -> MergeRequest -> ShowS)
-> (MergeRequest -> String)
-> ([MergeRequest] -> ShowS)
-> Show MergeRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeRequest] -> ShowS
$cshowList :: [MergeRequest] -> ShowS
show :: MergeRequest -> String
$cshow :: MergeRequest -> String
showsPrec :: Int -> MergeRequest -> ShowS
$cshowsPrec :: Int -> MergeRequest -> ShowS
Show, MergeRequest -> MergeRequest -> Bool
(MergeRequest -> MergeRequest -> Bool)
-> (MergeRequest -> MergeRequest -> Bool) -> Eq MergeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeRequest -> MergeRequest -> Bool
$c/= :: MergeRequest -> MergeRequest -> Bool
== :: MergeRequest -> MergeRequest -> Bool
$c== :: MergeRequest -> MergeRequest -> Bool
Eq)

-- | monitors a task completion status.
data TaskCompletionStatus = TaskCompletionStatus
  { TaskCompletionStatus -> Int
task_completion_status_count :: Int,
    TaskCompletionStatus -> Maybe Int
task_completion_status_completed_count :: Maybe Int
  }
  deriving (Int -> TaskCompletionStatus -> ShowS
[TaskCompletionStatus] -> ShowS
TaskCompletionStatus -> String
(Int -> TaskCompletionStatus -> ShowS)
-> (TaskCompletionStatus -> String)
-> ([TaskCompletionStatus] -> ShowS)
-> Show TaskCompletionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaskCompletionStatus] -> ShowS
$cshowList :: [TaskCompletionStatus] -> ShowS
show :: TaskCompletionStatus -> String
$cshow :: TaskCompletionStatus -> String
showsPrec :: Int -> TaskCompletionStatus -> ShowS
$cshowsPrec :: Int -> TaskCompletionStatus -> ShowS
Show, TaskCompletionStatus -> TaskCompletionStatus -> Bool
(TaskCompletionStatus -> TaskCompletionStatus -> Bool)
-> (TaskCompletionStatus -> TaskCompletionStatus -> Bool)
-> Eq TaskCompletionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TaskCompletionStatus -> TaskCompletionStatus -> Bool
$c/= :: TaskCompletionStatus -> TaskCompletionStatus -> Bool
== :: TaskCompletionStatus -> TaskCompletionStatus -> Bool
$c== :: TaskCompletionStatus -> TaskCompletionStatus -> Bool
Eq)

-- | references.
data References = References
  { References -> Text
references_short :: Text,
    References -> Text
references_relative :: Text,
    References -> Text
references_full :: Text
  }
  deriving (Int -> References -> ShowS
[References] -> ShowS
References -> String
(Int -> References -> ShowS)
-> (References -> String)
-> ([References] -> ShowS)
-> Show References
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [References] -> ShowS
$cshowList :: [References] -> ShowS
show :: References -> String
$cshow :: References -> String
showsPrec :: Int -> References -> ShowS
$cshowsPrec :: Int -> References -> ShowS
Show, References -> References -> Bool
(References -> References -> Bool)
-> (References -> References -> Bool) -> Eq References
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: References -> References -> Bool
$c/= :: References -> References -> Bool
== :: References -> References -> Bool
$c== :: References -> References -> Bool
Eq)

-- | Change between commits.
data Change = Change
  { Change -> Text
change_old_path :: Text,
    Change -> Text
change_new_path :: Text,
    Change -> Text
change_a_mode :: Text, -- find type for "100644"
    Change -> Text
change_b_mode :: Text, -- find type for "100644"
    Change -> Text
change_diff :: Text, -- find type for "--- a/VERSION\\ +++ b/VERSION\\ @@ -1 +1 @@\\ -1.9.7\\ +1.9.8"
    Change -> Bool
change_new_file :: Bool,
    Change -> Bool
change_renamed_file :: Bool,
    Change -> Bool
change_deleted_file :: Bool
  }
  deriving (Int -> Change -> ShowS
[Change] -> ShowS
Change -> String
(Int -> Change -> ShowS)
-> (Change -> String) -> ([Change] -> ShowS) -> Show Change
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Change] -> ShowS
$cshowList :: [Change] -> ShowS
show :: Change -> String
$cshow :: Change -> String
showsPrec :: Int -> Change -> ShowS
$cshowsPrec :: Int -> Change -> ShowS
Show, Change -> Change -> Bool
(Change -> Change -> Bool)
-> (Change -> Change -> Bool) -> Eq Change
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Change -> Change -> Bool
$c/= :: Change -> Change -> Bool
== :: Change -> Change -> Bool
$c== :: Change -> Change -> Bool
Eq)

-- | diff references.
data DiffRefs = DiffRefs
  { DiffRefs -> Text
diff_refs_base_sha :: Text,
    DiffRefs -> Text
diff_refs_head_sha :: Text,
    DiffRefs -> Text
diff_refs_start_sha :: Text
  }
  deriving (Int -> DiffRefs -> ShowS
[DiffRefs] -> ShowS
DiffRefs -> String
(Int -> DiffRefs -> ShowS)
-> (DiffRefs -> String) -> ([DiffRefs] -> ShowS) -> Show DiffRefs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiffRefs] -> ShowS
$cshowList :: [DiffRefs] -> ShowS
show :: DiffRefs -> String
$cshow :: DiffRefs -> String
showsPrec :: Int -> DiffRefs -> ShowS
$cshowsPrec :: Int -> DiffRefs -> ShowS
Show, DiffRefs -> DiffRefs -> Bool
(DiffRefs -> DiffRefs -> Bool)
-> (DiffRefs -> DiffRefs -> Bool) -> Eq DiffRefs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiffRefs -> DiffRefs -> Bool
$c/= :: DiffRefs -> DiffRefs -> Bool
== :: DiffRefs -> DiffRefs -> Bool
$c== :: DiffRefs -> DiffRefs -> Bool
Eq)

{- TODO for MergeRequest

  "references": {
    "short": "!1",
    "relative": "!1",
    "full": "my-group/my-project!1"
  },

  "changes": [
    {
    "old_path": "VERSION",
    "new_path": "VERSION",
    "a_mode": "100644",
    "b_mode": "100644",
    "diff": "--- a/VERSION\\ +++ b/VERSION\\ @@ -1 +1 @@\\ -1.9.7\\ +1.9.8",
    "new_file": false,
    "renamed_file": false,
    "deleted_file": false
    }

  "overflow": false

  "diff_refs": {
    "base_sha": "c380d3acebd181f13629a25d2e2acca46ffe1e00",
    "head_sha": "2be7ddb704c7b6b83732fdd5b9f09d5a397b5f8f",
    "start_sha": "c380d3acebd181f13629a25d2e2acca46ffe1e00"
  },

-}

-- | TODO action.
data TodoAction
  = TAAssigned
  | TAMentioned
  | TABuildFailed
  | TAMarked
  | TAApprovalRequired
  | TAUnmergeable
  | TADirectlyAddressed
  deriving (Int -> TodoAction -> ShowS
[TodoAction] -> ShowS
TodoAction -> String
(Int -> TodoAction -> ShowS)
-> (TodoAction -> String)
-> ([TodoAction] -> ShowS)
-> Show TodoAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoAction] -> ShowS
$cshowList :: [TodoAction] -> ShowS
show :: TodoAction -> String
$cshow :: TodoAction -> String
showsPrec :: Int -> TodoAction -> ShowS
$cshowsPrec :: Int -> TodoAction -> ShowS
Show, TodoAction -> TodoAction -> Bool
(TodoAction -> TodoAction -> Bool)
-> (TodoAction -> TodoAction -> Bool) -> Eq TodoAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoAction -> TodoAction -> Bool
$c/= :: TodoAction -> TodoAction -> Bool
== :: TodoAction -> TodoAction -> Bool
$c== :: TodoAction -> TodoAction -> Bool
Eq)

instance FromJSON TodoAction where
  parseJSON :: Value -> Parser TodoAction
parseJSON (String Text
"assigned") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TAAssigned
  parseJSON (String Text
"mentioned") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TAMentioned
  parseJSON (String Text
"build_failed") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TABuildFailed
  parseJSON (String Text
"marked") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TAMarked
  parseJSON (String Text
"approval_required") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TAApprovalRequired
  parseJSON (String Text
"unmergeable") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TAUnmergeable
  parseJSON (String Text
"directly_addressed") = TodoAction -> Parser TodoAction
forall (m :: * -> *) a. Monad m => a -> m a
return TodoAction
TADirectlyAddressed
  parseJSON Value
x = Value -> Parser TodoAction
forall a. Value -> Parser a
unexpected Value
x

-- | TODO targets.
data TodoTarget
  = TTIssue Issue
  | TTMergeRequest MergeRequest
  | TTCommit CommitTodo
  deriving (Int -> TodoTarget -> ShowS
[TodoTarget] -> ShowS
TodoTarget -> String
(Int -> TodoTarget -> ShowS)
-> (TodoTarget -> String)
-> ([TodoTarget] -> ShowS)
-> Show TodoTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoTarget] -> ShowS
$cshowList :: [TodoTarget] -> ShowS
show :: TodoTarget -> String
$cshow :: TodoTarget -> String
showsPrec :: Int -> TodoTarget -> ShowS
$cshowsPrec :: Int -> TodoTarget -> ShowS
Show, TodoTarget -> TodoTarget -> Bool
(TodoTarget -> TodoTarget -> Bool)
-> (TodoTarget -> TodoTarget -> Bool) -> Eq TodoTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoTarget -> TodoTarget -> Bool
$c/= :: TodoTarget -> TodoTarget -> Bool
== :: TodoTarget -> TodoTarget -> Bool
$c== :: TodoTarget -> TodoTarget -> Bool
Eq)

-- | URL is a synonym for 'Text'.
type URL = Text

-- | TODO states.
data TodoState
  = TSPending
  | TSDone
  deriving (Int -> TodoState -> ShowS
[TodoState] -> ShowS
TodoState -> String
(Int -> TodoState -> ShowS)
-> (TodoState -> String)
-> ([TodoState] -> ShowS)
-> Show TodoState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoState] -> ShowS
$cshowList :: [TodoState] -> ShowS
show :: TodoState -> String
$cshow :: TodoState -> String
showsPrec :: Int -> TodoState -> ShowS
$cshowsPrec :: Int -> TodoState -> ShowS
Show, TodoState -> TodoState -> Bool
(TodoState -> TodoState -> Bool)
-> (TodoState -> TodoState -> Bool) -> Eq TodoState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoState -> TodoState -> Bool
$c/= :: TodoState -> TodoState -> Bool
== :: TodoState -> TodoState -> Bool
$c== :: TodoState -> TodoState -> Bool
Eq)

-- | A project TODO.
data TodoProject = TodoProject
  { TodoProject -> Int
todo_project_id :: Int,
    TodoProject -> Maybe Text
todo_project_description :: Maybe Text,
    TodoProject -> Text
todo_project_name :: Text,
    TodoProject -> Text
todo_project_name_with_namespace :: Text,
    TodoProject -> Text
todo_project_path :: Text,
    TodoProject -> Text
todo_project_path_with_namespace :: Text,
    TodoProject -> Maybe UTCTime
todo_project_created_at :: Maybe UTCTime
  }
  deriving (Int -> TodoProject -> ShowS
[TodoProject] -> ShowS
TodoProject -> String
(Int -> TodoProject -> ShowS)
-> (TodoProject -> String)
-> ([TodoProject] -> ShowS)
-> Show TodoProject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoProject] -> ShowS
$cshowList :: [TodoProject] -> ShowS
show :: TodoProject -> String
$cshow :: TodoProject -> String
showsPrec :: Int -> TodoProject -> ShowS
$cshowsPrec :: Int -> TodoProject -> ShowS
Show, TodoProject -> TodoProject -> Bool
(TodoProject -> TodoProject -> Bool)
-> (TodoProject -> TodoProject -> Bool) -> Eq TodoProject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoProject -> TodoProject -> Bool
$c/= :: TodoProject -> TodoProject -> Bool
== :: TodoProject -> TodoProject -> Bool
$c== :: TodoProject -> TodoProject -> Bool
Eq)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "todo_project_"), omitNothingFields = True} ''TodoProject)

-- | TODOs.
data Todo = Todo
  { Todo -> Int
todo_id :: Int,
    Todo -> TodoProject
todo_project :: TodoProject,
    Todo -> User
todo_author :: User,
    Todo -> TodoAction
todo_action_name :: TodoAction,
    Todo -> TodoTargetType
todo_target_type :: TodoTargetType,
    Todo -> TodoTarget
todo_target :: TodoTarget,
    Todo -> Text
todo_target_url :: URL,
    Todo -> Text
todo_body :: Text,
    Todo -> TodoState
todo_state :: TodoState,
    Todo -> UTCTime
todo_created_at :: UTCTime,
    Todo -> Maybe UTCTime
todo_updated_at :: Maybe UTCTime
  }
  deriving (Int -> Todo -> ShowS
[Todo] -> ShowS
Todo -> String
(Int -> Todo -> ShowS)
-> (Todo -> String) -> ([Todo] -> ShowS) -> Show Todo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Todo] -> ShowS
$cshowList :: [Todo] -> ShowS
show :: Todo -> String
$cshow :: Todo -> String
showsPrec :: Int -> Todo -> ShowS
$cshowsPrec :: Int -> Todo -> ShowS
Show, Todo -> Todo -> Bool
(Todo -> Todo -> Bool) -> (Todo -> Todo -> Bool) -> Eq Todo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Todo -> Todo -> Bool
$c/= :: Todo -> Todo -> Bool
== :: Todo -> Todo -> Bool
$c== :: Todo -> Todo -> Bool
Eq)

-- | Target type of a TODO.
data TodoTargetType
  = MergeRequestTarget
  | IssueTarget
  | CommitTarget
  deriving (Int -> TodoTargetType -> ShowS
[TodoTargetType] -> ShowS
TodoTargetType -> String
(Int -> TodoTargetType -> ShowS)
-> (TodoTargetType -> String)
-> ([TodoTargetType] -> ShowS)
-> Show TodoTargetType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TodoTargetType] -> ShowS
$cshowList :: [TodoTargetType] -> ShowS
show :: TodoTargetType -> String
$cshow :: TodoTargetType -> String
showsPrec :: Int -> TodoTargetType -> ShowS
$cshowsPrec :: Int -> TodoTargetType -> ShowS
Show, TodoTargetType -> TodoTargetType -> Bool
(TodoTargetType -> TodoTargetType -> Bool)
-> (TodoTargetType -> TodoTargetType -> Bool) -> Eq TodoTargetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TodoTargetType -> TodoTargetType -> Bool
$c/= :: TodoTargetType -> TodoTargetType -> Bool
== :: TodoTargetType -> TodoTargetType -> Bool
$c== :: TodoTargetType -> TodoTargetType -> Bool
Eq)

-- | Type of a TODO.
data TodoType
  = TodoTypeIssue
  | TodoTypeMergeRequest
  | TodoTypeCommit
  | TodoTypeEpic
  | TodoTypeDesign
  | TodoTypeAlert

instance Show TodoType where
  show :: TodoType -> String
show TodoType
TodoTypeIssue = String
"Issue"
  show TodoType
TodoTypeMergeRequest = String
"MergeRequest"
  show TodoType
TodoTypeCommit = String
"Commit"
  show TodoType
TodoTypeEpic = String
"Epic"
  show TodoType
TodoTypeDesign = String
"DesignManagement::Design"
  show TodoType
TodoTypeAlert = String
"AlertManagement::Alert"

-- | version of the GitLab instance.
data Version = Version
  { Version -> Text
version_version :: Text,
    Version -> Text
version_revision :: Text
  }
  deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq)

-- | An edit issue request.
data EditIssueReq = EditIssueReq
  { EditIssueReq -> Int
edit_issue_id :: ProjectId,
    EditIssueReq -> Int
edit_issue_issue_iid :: IssueId,
    EditIssueReq -> Maybe Text
edit_issue_title :: Maybe Text,
    EditIssueReq -> Maybe Text
edit_issue_description :: Maybe Text,
    EditIssueReq -> Maybe Bool
edit_issue_confidential :: Maybe Bool,
    EditIssueReq -> Maybe [Int]
edit_issue_assignee_ids :: Maybe [Int],
    EditIssueReq -> Maybe Int
edit_issue_milestone_id :: Maybe Int,
    EditIssueReq -> Maybe [Text]
edit_issue_labels :: Maybe [Text],
    EditIssueReq -> Maybe Text
edit_issue_state_event :: Maybe Text,
    EditIssueReq -> Maybe UTCTime
edit_issue_updated_at :: Maybe UTCTime,
    EditIssueReq -> Maybe Text
edit_issue_due_date :: Maybe Text,
    EditIssueReq -> Maybe Int
edit_issue_weight :: Maybe Int,
    EditIssueReq -> Maybe Bool
edit_issue_discussion_locked :: Maybe Bool,
    EditIssueReq -> Maybe Int
edit_issue_epic_id :: Maybe Int,
    EditIssueReq -> Maybe Int
edit_issue_epic_iid :: Maybe Int
  }
  deriving (Int -> EditIssueReq -> ShowS
[EditIssueReq] -> ShowS
EditIssueReq -> String
(Int -> EditIssueReq -> ShowS)
-> (EditIssueReq -> String)
-> ([EditIssueReq] -> ShowS)
-> Show EditIssueReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditIssueReq] -> ShowS
$cshowList :: [EditIssueReq] -> ShowS
show :: EditIssueReq -> String
$cshow :: EditIssueReq -> String
showsPrec :: Int -> EditIssueReq -> ShowS
$cshowsPrec :: Int -> EditIssueReq -> ShowS
Show)

-- | Discussions https://docs.gitlab.com/ee/api/discussions.html
data Discussion = Discussion
  { Discussion -> Text
discussion_id :: Text,
    Discussion -> Bool
discussion_individual_note :: Bool,
    Discussion -> [Note]
discussion_notes :: [Note]
  }
  deriving (Int -> Discussion -> ShowS
[Discussion] -> ShowS
Discussion -> String
(Int -> Discussion -> ShowS)
-> (Discussion -> String)
-> ([Discussion] -> ShowS)
-> Show Discussion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Discussion] -> ShowS
$cshowList :: [Discussion] -> ShowS
show :: Discussion -> String
$cshow :: Discussion -> String
showsPrec :: Int -> Discussion -> ShowS
$cshowsPrec :: Int -> Discussion -> ShowS
Show, Discussion -> Discussion -> Bool
(Discussion -> Discussion -> Bool)
-> (Discussion -> Discussion -> Bool) -> Eq Discussion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Discussion -> Discussion -> Bool
$c/= :: Discussion -> Discussion -> Bool
== :: Discussion -> Discussion -> Bool
$c== :: Discussion -> Discussion -> Bool
Eq)

-- | Note attached to a commit.
data CommitNote = CommitNote
  { CommitNote -> Text
commitnote_note :: Text,
    CommitNote -> User
commitnote_author :: User
  }
  deriving (Int -> CommitNote -> ShowS
[CommitNote] -> ShowS
CommitNote -> String
(Int -> CommitNote -> ShowS)
-> (CommitNote -> String)
-> ([CommitNote] -> ShowS)
-> Show CommitNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitNote] -> ShowS
$cshowList :: [CommitNote] -> ShowS
show :: CommitNote -> String
$cshow :: CommitNote -> String
showsPrec :: Int -> CommitNote -> ShowS
$cshowsPrec :: Int -> CommitNote -> ShowS
Show, CommitNote -> CommitNote -> Bool
(CommitNote -> CommitNote -> Bool)
-> (CommitNote -> CommitNote -> Bool) -> Eq CommitNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitNote -> CommitNote -> Bool
$c/= :: CommitNote -> CommitNote -> Bool
== :: CommitNote -> CommitNote -> Bool
$c== :: CommitNote -> CommitNote -> Bool
Eq)

-- | Notes
data Note = Note
  { Note -> Int
note_id :: Int,
    Note -> Maybe Text
note_title :: Maybe Text, -- for snippets
    Note -> Maybe Text
note_file_name :: Maybe Text, -- for snippets
    -- https://docs.gitlab.com/ee/api/discussions.html#list-project-commit-discussion-items
    Note -> Maybe Text
note_type :: Maybe Text, -- TODO create type for this, e.g. from "DiscussionNote"
    Note -> Maybe Text
note_body :: Maybe Text,
    Note -> Maybe Text
note_attachment :: Maybe Text,
    Note -> Owner
note_author :: Owner,
    Note -> UTCTime
note_created_at :: UTCTime,
    Note -> Maybe UTCTime
note_updated_at :: Maybe UTCTime,
    Note -> Maybe Bool
note_system :: Maybe Bool,
    Note -> Maybe Int
note_noteable_id :: Maybe Int,
    Note -> Maybe Text
note_noteable_type :: Maybe Text, -- create type e.g. from "Commit"
    Note -> Maybe Int
note_noteable_iid :: Maybe Int,
    Note -> Maybe CommandsChanges
note_commands_changes :: Maybe CommandsChanges,
    Note -> Maybe Bool
note_resolved :: Maybe Bool,
    Note -> Maybe Bool
note_resolvable :: Maybe Bool,
    Note -> Maybe Bool
note_confidential :: Maybe Bool,
    Note -> Maybe User
note_resolved_by :: Maybe User -- TODO check
  }
  deriving (Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
(Int -> Note -> ShowS)
-> (Note -> String) -> ([Note] -> ShowS) -> Show Note
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show, Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq)

-- | has a change been promoted to an epic.
newtype CommandsChanges = CommanandsChanges
  { CommandsChanges -> Bool
commands_changes_promote_to_epic :: Bool
  }
  deriving (Int -> CommandsChanges -> ShowS
[CommandsChanges] -> ShowS
CommandsChanges -> String
(Int -> CommandsChanges -> ShowS)
-> (CommandsChanges -> String)
-> ([CommandsChanges] -> ShowS)
-> Show CommandsChanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandsChanges] -> ShowS
$cshowList :: [CommandsChanges] -> ShowS
show :: CommandsChanges -> String
$cshow :: CommandsChanges -> String
showsPrec :: Int -> CommandsChanges -> ShowS
$cshowsPrec :: Int -> CommandsChanges -> ShowS
Show, CommandsChanges -> CommandsChanges -> Bool
(CommandsChanges -> CommandsChanges -> Bool)
-> (CommandsChanges -> CommandsChanges -> Bool)
-> Eq CommandsChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandsChanges -> CommandsChanges -> Bool
$c/= :: CommandsChanges -> CommandsChanges -> Bool
== :: CommandsChanges -> CommandsChanges -> Bool
$c== :: CommandsChanges -> CommandsChanges -> Bool
Eq)

-- | Statistics and an issue
newtype IssueStatistics = IssueStatistics
  { IssueStatistics -> IssueStats
issue_statistics_stats :: IssueStats
  }
  deriving (Int -> IssueStatistics -> ShowS
[IssueStatistics] -> ShowS
IssueStatistics -> String
(Int -> IssueStatistics -> ShowS)
-> (IssueStatistics -> String)
-> ([IssueStatistics] -> ShowS)
-> Show IssueStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueStatistics] -> ShowS
$cshowList :: [IssueStatistics] -> ShowS
show :: IssueStatistics -> String
$cshow :: IssueStatistics -> String
showsPrec :: Int -> IssueStatistics -> ShowS
$cshowsPrec :: Int -> IssueStatistics -> ShowS
Show, IssueStatistics -> IssueStatistics -> Bool
(IssueStatistics -> IssueStatistics -> Bool)
-> (IssueStatistics -> IssueStatistics -> Bool)
-> Eq IssueStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueStatistics -> IssueStatistics -> Bool
$c/= :: IssueStatistics -> IssueStatistics -> Bool
== :: IssueStatistics -> IssueStatistics -> Bool
$c== :: IssueStatistics -> IssueStatistics -> Bool
Eq)

-- | Issue statistics
newtype IssueStats = IssueStats
  { IssueStats -> IssueCounts
issue_stats_issue_counts :: IssueCounts
  }
  deriving (Int -> IssueStats -> ShowS
[IssueStats] -> ShowS
IssueStats -> String
(Int -> IssueStats -> ShowS)
-> (IssueStats -> String)
-> ([IssueStats] -> ShowS)
-> Show IssueStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueStats] -> ShowS
$cshowList :: [IssueStats] -> ShowS
show :: IssueStats -> String
$cshow :: IssueStats -> String
showsPrec :: Int -> IssueStats -> ShowS
$cshowsPrec :: Int -> IssueStats -> ShowS
Show, IssueStats -> IssueStats -> Bool
(IssueStats -> IssueStats -> Bool)
-> (IssueStats -> IssueStats -> Bool) -> Eq IssueStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueStats -> IssueStats -> Bool
$c/= :: IssueStats -> IssueStats -> Bool
== :: IssueStats -> IssueStats -> Bool
$c== :: IssueStats -> IssueStats -> Bool
Eq)

-- | A count of all, open and closed issues against a project
data IssueCounts = IssueCounts
  { IssueCounts -> Int
issue_counts__all :: Int,
    IssueCounts -> Int
issue_counts_closed :: Int,
    IssueCounts -> Int
issue_counts_opened :: Int
  }
  deriving (Int -> IssueCounts -> ShowS
[IssueCounts] -> ShowS
IssueCounts -> String
(Int -> IssueCounts -> ShowS)
-> (IssueCounts -> String)
-> ([IssueCounts] -> ShowS)
-> Show IssueCounts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueCounts] -> ShowS
$cshowList :: [IssueCounts] -> ShowS
show :: IssueCounts -> String
$cshow :: IssueCounts -> String
showsPrec :: Int -> IssueCounts -> ShowS
$cshowsPrec :: Int -> IssueCounts -> ShowS
Show, IssueCounts -> IssueCounts -> Bool
(IssueCounts -> IssueCounts -> Bool)
-> (IssueCounts -> IssueCounts -> Bool) -> Eq IssueCounts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueCounts -> IssueCounts -> Bool
$c/= :: IssueCounts -> IssueCounts -> Bool
== :: IssueCounts -> IssueCounts -> Bool
$c== :: IssueCounts -> IssueCounts -> Bool
Eq)

-- | Project issue boards https://docs.gitlab.com/ee/user/project/issue_board.html
data IssueBoard = IssueBoard
  { IssueBoard -> Int
board_id :: Int,
    IssueBoard -> Text
board_name :: Text,
    IssueBoard -> Project
board_project :: Project,
    IssueBoard -> Maybe Milestone
board_milestone :: Maybe Milestone,
    IssueBoard -> [BoardIssue]
board_lists :: [BoardIssue],
    IssueBoard -> Maybe Text
board_group :: Maybe Text, -- not sure, documentation doesn't indicate type
    IssueBoard -> Maybe Owner
board_assignee :: Maybe Owner,
    IssueBoard -> Maybe [BoardIssueLabel]
board_labels :: Maybe [BoardIssueLabel],
    IssueBoard -> Maybe Int
board_weight :: Maybe Int
  }
  deriving (Int -> IssueBoard -> ShowS
[IssueBoard] -> ShowS
IssueBoard -> String
(Int -> IssueBoard -> ShowS)
-> (IssueBoard -> String)
-> ([IssueBoard] -> ShowS)
-> Show IssueBoard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueBoard] -> ShowS
$cshowList :: [IssueBoard] -> ShowS
show :: IssueBoard -> String
$cshow :: IssueBoard -> String
showsPrec :: Int -> IssueBoard -> ShowS
$cshowsPrec :: Int -> IssueBoard -> ShowS
Show, IssueBoard -> IssueBoard -> Bool
(IssueBoard -> IssueBoard -> Bool)
-> (IssueBoard -> IssueBoard -> Bool) -> Eq IssueBoard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueBoard -> IssueBoard -> Bool
$c/= :: IssueBoard -> IssueBoard -> Bool
== :: IssueBoard -> IssueBoard -> Bool
$c== :: IssueBoard -> IssueBoard -> Bool
Eq)

-- | Issues associated with a project issue board
data BoardIssue = BoardIssue
  { BoardIssue -> Int
board_issue_id :: Int,
    BoardIssue -> BoardIssueLabel
board_issue_label :: BoardIssueLabel,
    BoardIssue -> Int
board_issue_position :: Int,
    BoardIssue -> Int
board_issue_max_issue_count :: Int,
    BoardIssue -> Int
board_issue_max_issue_weight :: Int,
    -- TODO, the docs don't say what type this should be
    BoardIssue -> Maybe Int
board_issue_limit_metric :: Maybe Int
  }
  deriving (Int -> BoardIssue -> ShowS
[BoardIssue] -> ShowS
BoardIssue -> String
(Int -> BoardIssue -> ShowS)
-> (BoardIssue -> String)
-> ([BoardIssue] -> ShowS)
-> Show BoardIssue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoardIssue] -> ShowS
$cshowList :: [BoardIssue] -> ShowS
show :: BoardIssue -> String
$cshow :: BoardIssue -> String
showsPrec :: Int -> BoardIssue -> ShowS
$cshowsPrec :: Int -> BoardIssue -> ShowS
Show, BoardIssue -> BoardIssue -> Bool
(BoardIssue -> BoardIssue -> Bool)
-> (BoardIssue -> BoardIssue -> Bool) -> Eq BoardIssue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoardIssue -> BoardIssue -> Bool
$c/= :: BoardIssue -> BoardIssue -> Bool
== :: BoardIssue -> BoardIssue -> Bool
$c== :: BoardIssue -> BoardIssue -> Bool
Eq)

-- | Label of an issues for a project issue board
data BoardIssueLabel = BoardIssueLabel
  { BoardIssueLabel -> Maybe Int
board_issue_label_id :: Maybe Int,
    BoardIssueLabel -> Text
board_issue_label_name :: Text,
    BoardIssueLabel -> Text
board_issue_label_color :: Text, -- parse into type from e.g. "#F0AD4E"
    BoardIssueLabel -> Maybe Text
board_issue_label_description :: Maybe Text
  }
  deriving (Int -> BoardIssueLabel -> ShowS
[BoardIssueLabel] -> ShowS
BoardIssueLabel -> String
(Int -> BoardIssueLabel -> ShowS)
-> (BoardIssueLabel -> String)
-> ([BoardIssueLabel] -> ShowS)
-> Show BoardIssueLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoardIssueLabel] -> ShowS
$cshowList :: [BoardIssueLabel] -> ShowS
show :: BoardIssueLabel -> String
$cshow :: BoardIssueLabel -> String
showsPrec :: Int -> BoardIssueLabel -> ShowS
$cshowsPrec :: Int -> BoardIssueLabel -> ShowS
Show, BoardIssueLabel -> BoardIssueLabel -> Bool
(BoardIssueLabel -> BoardIssueLabel -> Bool)
-> (BoardIssueLabel -> BoardIssueLabel -> Bool)
-> Eq BoardIssueLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoardIssueLabel -> BoardIssueLabel -> Bool
$c/= :: BoardIssueLabel -> BoardIssueLabel -> Bool
== :: BoardIssueLabel -> BoardIssueLabel -> Bool
$c== :: BoardIssueLabel -> BoardIssueLabel -> Bool
Eq)

-- |  Project visibility.
data Visibility
  = Public
  | Private
  | Internal
  deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show, Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq)

instance FromJSON Visibility where
  parseJSON :: Value -> Parser Visibility
parseJSON (String Text
"public") = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Public
  parseJSON (String Text
"private") = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Private
  parseJSON (String Text
"internal") = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Internal
  parseJSON (Number Scientific
0) = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Private
  parseJSON (Number Scientific
10) = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Internal
  parseJSON (Number Scientific
20) = Visibility -> Parser Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Public
  parseJSON Value
n = String -> Parser Visibility
forall a. HasCallStack => String -> a
error (Value -> String
forall a. Show a => a -> String
show Value
n)

-- | Unit test reports for a CI pipeline https://docs.gitlab.com/ee/ci/unit_test_reports.html
data TestReport = TestReport
  { TestReport -> Double
test_report_total_time :: Double,
    TestReport -> Int
test_report_total_count :: Int,
    TestReport -> Int
test_report_success_count :: Int,
    TestReport -> Int
test_report_failed_count :: Int,
    TestReport -> Int
test_report_skipped_count :: Int,
    TestReport -> Int
test_report_error_count :: Int,
    TestReport -> [TestSuite]
test_report_test_suites :: [TestSuite]
  }
  deriving (Int -> TestReport -> ShowS
[TestReport] -> ShowS
TestReport -> String
(Int -> TestReport -> ShowS)
-> (TestReport -> String)
-> ([TestReport] -> ShowS)
-> Show TestReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestReport] -> ShowS
$cshowList :: [TestReport] -> ShowS
show :: TestReport -> String
$cshow :: TestReport -> String
showsPrec :: Int -> TestReport -> ShowS
$cshowsPrec :: Int -> TestReport -> ShowS
Show, TestReport -> TestReport -> Bool
(TestReport -> TestReport -> Bool)
-> (TestReport -> TestReport -> Bool) -> Eq TestReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestReport -> TestReport -> Bool
$c/= :: TestReport -> TestReport -> Bool
== :: TestReport -> TestReport -> Bool
$c== :: TestReport -> TestReport -> Bool
Eq)

-- | Testsuites associated with a test report
data TestSuite = TestSuite
  { TestSuite -> Text
testsuite_name :: Text,
    TestSuite -> Double
testsuite_total_time :: Double,
    TestSuite -> Int
testsuite_success_count :: Int,
    TestSuite -> Int
testsuite_failed_count :: Int,
    TestSuite -> Int
testsuite_skipped_count :: Int,
    TestSuite -> Int
testsuite_error_count :: Int,
    TestSuite -> [TestCase]
testsuite_test_cases :: [TestCase]
  }
  deriving (Int -> TestSuite -> ShowS
[TestSuite] -> ShowS
TestSuite -> String
(Int -> TestSuite -> ShowS)
-> (TestSuite -> String)
-> ([TestSuite] -> ShowS)
-> Show TestSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestSuite] -> ShowS
$cshowList :: [TestSuite] -> ShowS
show :: TestSuite -> String
$cshow :: TestSuite -> String
showsPrec :: Int -> TestSuite -> ShowS
$cshowsPrec :: Int -> TestSuite -> ShowS
Show, TestSuite -> TestSuite -> Bool
(TestSuite -> TestSuite -> Bool)
-> (TestSuite -> TestSuite -> Bool) -> Eq TestSuite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestSuite -> TestSuite -> Bool
$c/= :: TestSuite -> TestSuite -> Bool
== :: TestSuite -> TestSuite -> Bool
$c== :: TestSuite -> TestSuite -> Bool
Eq)

-- | Test case associated with a testsuite
data TestCase = TestCase
  { TestCase -> Text
testcase_status :: Text, -- could turn this into a type e.g. for "success"
    TestCase -> Text
testcase_name :: Text,
    TestCase -> Text
testcase_classname :: Text,
    TestCase -> Double
testcase_execution_time :: Double,
    TestCase -> Maybe Text
testcase_system_output :: Maybe Text,
    TestCase -> Maybe Text
testcase_stack_trace :: Maybe Text
  }
  deriving (Int -> TestCase -> ShowS
[TestCase] -> ShowS
TestCase -> String
(Int -> TestCase -> ShowS)
-> (TestCase -> String) -> ([TestCase] -> ShowS) -> Show TestCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestCase] -> ShowS
$cshowList :: [TestCase] -> ShowS
show :: TestCase -> String
$cshow :: TestCase -> String
showsPrec :: Int -> TestCase -> ShowS
$cshowsPrec :: Int -> TestCase -> ShowS
Show, TestCase -> TestCase -> Bool
(TestCase -> TestCase -> Bool)
-> (TestCase -> TestCase -> Bool) -> Eq TestCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestCase -> TestCase -> Bool
$c/= :: TestCase -> TestCase -> Bool
== :: TestCase -> TestCase -> Bool
$c== :: TestCase -> TestCase -> Bool
Eq)

-- | Estimated humand and total time spent.
data TimeEstimate = TimeEstimate
  { TimeEstimate -> Maybe Text
time_estimate_human_time_estimate :: Maybe Text,
    TimeEstimate -> Maybe Text
time_estimate_human_total_time_spent :: Maybe Text,
    TimeEstimate -> Maybe Int
time_estimate_time_estimate :: Maybe Int,
    TimeEstimate -> Maybe Int
time_estimate_total_time_spent :: Maybe Int
  }
  deriving (Int -> TimeEstimate -> ShowS
[TimeEstimate] -> ShowS
TimeEstimate -> String
(Int -> TimeEstimate -> ShowS)
-> (TimeEstimate -> String)
-> ([TimeEstimate] -> ShowS)
-> Show TimeEstimate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeEstimate] -> ShowS
$cshowList :: [TimeEstimate] -> ShowS
show :: TimeEstimate -> String
$cshow :: TimeEstimate -> String
showsPrec :: Int -> TimeEstimate -> ShowS
$cshowsPrec :: Int -> TimeEstimate -> ShowS
Show, TimeEstimate -> TimeEstimate -> Bool
(TimeEstimate -> TimeEstimate -> Bool)
-> (TimeEstimate -> TimeEstimate -> Bool) -> Eq TimeEstimate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeEstimate -> TimeEstimate -> Bool
$c/= :: TimeEstimate -> TimeEstimate -> Bool
== :: TimeEstimate -> TimeEstimate -> Bool
$c== :: TimeEstimate -> TimeEstimate -> Bool
Eq)

-- | Email information.
data Email = Email
  { Email -> Int
email_id :: Int,
    Email -> Text
email_email :: Text,
    Email -> Maybe UTCTime
email_confirmed_at :: Maybe UTCTime
  }
  deriving (Int -> Email -> ShowS
[Email] -> ShowS
Email -> String
(Int -> Email -> ShowS)
-> (Email -> String) -> ([Email] -> ShowS) -> Show Email
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Email] -> ShowS
$cshowList :: [Email] -> ShowS
show :: Email -> String
$cshow :: Email -> String
showsPrec :: Int -> Email -> ShowS
$cshowsPrec :: Int -> Email -> ShowS
Show, Email -> Email -> Bool
(Email -> Email -> Bool) -> (Email -> Email -> Bool) -> Eq Email
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c== :: Email -> Email -> Bool
Eq)

-- | User preferences.
data UserPrefs = UserPrefs
  { UserPrefs -> Int
user_prefs_id :: Int,
    UserPrefs -> Int
user_prefs_user_id :: Int,
    UserPrefs -> Bool
user_prefs_view_diffs_file_by_file :: Bool,
    UserPrefs -> Bool
user_prefs_show_whitespace_in_diffs :: Bool
  }
  deriving (Int -> UserPrefs -> ShowS
[UserPrefs] -> ShowS
UserPrefs -> String
(Int -> UserPrefs -> ShowS)
-> (UserPrefs -> String)
-> ([UserPrefs] -> ShowS)
-> Show UserPrefs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPrefs] -> ShowS
$cshowList :: [UserPrefs] -> ShowS
show :: UserPrefs -> String
$cshow :: UserPrefs -> String
showsPrec :: Int -> UserPrefs -> ShowS
$cshowsPrec :: Int -> UserPrefs -> ShowS
Show, UserPrefs -> UserPrefs -> Bool
(UserPrefs -> UserPrefs -> Bool)
-> (UserPrefs -> UserPrefs -> Bool) -> Eq UserPrefs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPrefs -> UserPrefs -> Bool
$c/= :: UserPrefs -> UserPrefs -> Bool
== :: UserPrefs -> UserPrefs -> Bool
$c== :: UserPrefs -> UserPrefs -> Bool
Eq)

-- | SSH key information.
data Key = Key
  { Key -> Maybe Int
key_id :: Maybe Int,
    Key -> Maybe Text
key_title :: Maybe Text,
    Key -> Text
key_key :: Text,
    Key -> Maybe UTCTime
key_created_at :: Maybe UTCTime,
    Key -> Maybe UTCTime
key_expires_at :: Maybe UTCTime
  }
  deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq)

-- | User status.
data UserStatus = UserStatus
  { UserStatus -> Maybe Text
user_status_emoji :: Maybe Text, -- TODO type for "coffee"
    UserStatus -> Maybe Text
user_status_availability :: Maybe Text, -- TODO type for "busy"
    UserStatus -> Maybe Text
user_status_message :: Maybe Text,
    UserStatus -> Maybe Text
user_status_message_html :: Maybe Text, -- TODO type for HTML content
    UserStatus -> Maybe UTCTime
user_status_clear_status_at :: Maybe UTCTime
  }
  deriving (Int -> UserStatus -> ShowS
[UserStatus] -> ShowS
UserStatus -> String
(Int -> UserStatus -> ShowS)
-> (UserStatus -> String)
-> ([UserStatus] -> ShowS)
-> Show UserStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserStatus] -> ShowS
$cshowList :: [UserStatus] -> ShowS
show :: UserStatus -> String
$cshow :: UserStatus -> String
showsPrec :: Int -> UserStatus -> ShowS
$cshowsPrec :: Int -> UserStatus -> ShowS
Show, UserStatus -> UserStatus -> Bool
(UserStatus -> UserStatus -> Bool)
-> (UserStatus -> UserStatus -> Bool) -> Eq UserStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserStatus -> UserStatus -> Bool
$c/= :: UserStatus -> UserStatus -> Bool
== :: UserStatus -> UserStatus -> Bool
$c== :: UserStatus -> UserStatus -> Bool
Eq)

-- | Tracks counts for a user's activity.
data UserCount = UserCount
  { UserCount -> Int
user_count_merge_requests :: Int, -- TODO type for "coffee"
    UserCount -> Int
user_count_assigned_issues :: Int, -- TODO type for "busy"
    UserCount -> Int
user_count_assigned_merge_requests :: Int,
    UserCount -> Int
user_count_review_requested_merge_requests :: Int, -- TODO type for HTML content
    UserCount -> Int
user_count_todos :: Int
  }
  deriving (Int -> UserCount -> ShowS
[UserCount] -> ShowS
UserCount -> String
(Int -> UserCount -> ShowS)
-> (UserCount -> String)
-> ([UserCount] -> ShowS)
-> Show UserCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserCount] -> ShowS
$cshowList :: [UserCount] -> ShowS
show :: UserCount -> String
$cshow :: UserCount -> String
showsPrec :: Int -> UserCount -> ShowS
$cshowsPrec :: Int -> UserCount -> ShowS
Show, UserCount -> UserCount -> Bool
(UserCount -> UserCount -> Bool)
-> (UserCount -> UserCount -> Bool) -> Eq UserCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserCount -> UserCount -> Bool
$c/= :: UserCount -> UserCount -> Bool
== :: UserCount -> UserCount -> Bool
$c== :: UserCount -> UserCount -> Bool
Eq)

-- TODO this data type could be improved to remove redundant Maybe
-- values. E.g. the push_data field will only be populated for the
-- "pushed" action_name, but would be Nothing for all action_name
-- values. Same for 'commented on' and the existence of a 'event_note'
-- field value.

-- | Events https://docs.gitlab.com/ee/api/events.html
data Event = Event
  { Event -> Int
event_id :: Int,
    Event -> Maybe Text
event_title :: Maybe Text,
    Event -> Int
event_project_id :: Int,
    Event -> EventActionName
event_action_name :: EventActionName,
    Event -> Maybe Int
event_target_id :: Maybe Int,
    Event -> Maybe Int
event_target_iid :: Maybe Int,
    Event -> Maybe EventTargetType
event_target_type :: Maybe EventTargetType,
    Event -> Int
event_author_id :: Int,
    Event -> Maybe Text
event_target_title :: Maybe Text,
    Event -> Maybe UTCTime
event_created_at :: Maybe UTCTime,
    Event -> User
event_author :: User,
    Event -> Text
event_author_username :: Text,
    Event -> Maybe PushData
event_push_data :: Maybe PushData,
    Event -> Maybe Note
event_note :: Maybe Note
  }
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

-- | Information about a git push.
data PushData = PushData
  { PushData -> Int
push_data_commit_count :: Int,
    PushData -> EventActionName
push_data_action :: EventActionName,
    PushData -> Text
push_data_ref_type :: Text, -- TODO type for "branch"
    PushData -> Text
push_data_commit_from :: Text, -- sha hash
    PushData -> Text
push_data_commit_to :: Text, -- sha hash
    PushData -> Text
push_data_ref :: Text,
    PushData -> Text
push_data_commit_title :: Text
  }
  deriving (Int -> PushData -> ShowS
[PushData] -> ShowS
PushData -> String
(Int -> PushData -> ShowS)
-> (PushData -> String) -> ([PushData] -> ShowS) -> Show PushData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushData] -> ShowS
$cshowList :: [PushData] -> ShowS
show :: PushData -> String
$cshow :: PushData -> String
showsPrec :: Int -> PushData -> ShowS
$cshowsPrec :: Int -> PushData -> ShowS
Show, PushData -> PushData -> Bool
(PushData -> PushData -> Bool)
-> (PushData -> PushData -> Bool) -> Eq PushData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushData -> PushData -> Bool
$c/= :: PushData -> PushData -> Bool
== :: PushData -> PushData -> Bool
$c== :: PushData -> PushData -> Bool
Eq)

-- | Tracks whether an action is open, closed, pushed or commented on.
data EventActionName
  = ANOpened
  | ANClosed
  | ANPushed
  | ANCommentedOn
  deriving (Int -> EventActionName -> ShowS
[EventActionName] -> ShowS
EventActionName -> String
(Int -> EventActionName -> ShowS)
-> (EventActionName -> String)
-> ([EventActionName] -> ShowS)
-> Show EventActionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventActionName] -> ShowS
$cshowList :: [EventActionName] -> ShowS
show :: EventActionName -> String
$cshow :: EventActionName -> String
showsPrec :: Int -> EventActionName -> ShowS
$cshowsPrec :: Int -> EventActionName -> ShowS
Show, EventActionName -> EventActionName -> Bool
(EventActionName -> EventActionName -> Bool)
-> (EventActionName -> EventActionName -> Bool)
-> Eq EventActionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventActionName -> EventActionName -> Bool
$c/= :: EventActionName -> EventActionName -> Bool
== :: EventActionName -> EventActionName -> Bool
$c== :: EventActionName -> EventActionName -> Bool
Eq)

instance ToJSON EventActionName where
  toJSON :: EventActionName -> Value
toJSON EventActionName
ANOpened = Text -> Value
String Text
"opened"
  toJSON EventActionName
ANClosed = Text -> Value
String Text
"closed"
  toJSON EventActionName
ANPushed = Text -> Value
String Text
"pushed"
  toJSON EventActionName
ANCommentedOn = Text -> Value
String Text
"commented on"

instance FromJSON EventActionName where
  parseJSON :: Value -> Parser EventActionName
parseJSON (String Text
"opened") = EventActionName -> Parser EventActionName
forall (m :: * -> *) a. Monad m => a -> m a
return EventActionName
ANOpened
  parseJSON (String Text
"closed") = EventActionName -> Parser EventActionName
forall (m :: * -> *) a. Monad m => a -> m a
return EventActionName
ANClosed
  parseJSON (String Text
"pushed") = EventActionName -> Parser EventActionName
forall (m :: * -> *) a. Monad m => a -> m a
return EventActionName
ANPushed
  parseJSON (String Text
"commented on") = EventActionName -> Parser EventActionName
forall (m :: * -> *) a. Monad m => a -> m a
return EventActionName
ANCommentedOn
  parseJSON Value
x = Value -> Parser EventActionName
forall a. Value -> Parser a
unexpected Value
x

-- | Associates an event with a particular target.
data EventTargetType
  = ETTIssue
  | ETTMilestone
  | ETTMergeRequest
  | ETTNote
  | ETTProject
  | ETTSnippet
  | ETTUser
  deriving (Int -> EventTargetType -> ShowS
[EventTargetType] -> ShowS
EventTargetType -> String
(Int -> EventTargetType -> ShowS)
-> (EventTargetType -> String)
-> ([EventTargetType] -> ShowS)
-> Show EventTargetType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventTargetType] -> ShowS
$cshowList :: [EventTargetType] -> ShowS
show :: EventTargetType -> String
$cshow :: EventTargetType -> String
showsPrec :: Int -> EventTargetType -> ShowS
$cshowsPrec :: Int -> EventTargetType -> ShowS
Show, EventTargetType -> EventTargetType -> Bool
(EventTargetType -> EventTargetType -> Bool)
-> (EventTargetType -> EventTargetType -> Bool)
-> Eq EventTargetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventTargetType -> EventTargetType -> Bool
$c/= :: EventTargetType -> EventTargetType -> Bool
== :: EventTargetType -> EventTargetType -> Bool
$c== :: EventTargetType -> EventTargetType -> Bool
Eq)

instance ToJSON EventTargetType where
  toJSON :: EventTargetType -> Value
toJSON EventTargetType
ETTIssue = Text -> Value
String Text
"Issue"
  toJSON EventTargetType
ETTMilestone = Text -> Value
String Text
"Milestone"
  toJSON EventTargetType
ETTMergeRequest = Text -> Value
String Text
"MergeRequest"
  toJSON EventTargetType
ETTNote = Text -> Value
String Text
"Note"
  toJSON EventTargetType
ETTProject = Text -> Value
String Text
"Project"
  toJSON EventTargetType
ETTSnippet = Text -> Value
String Text
"Snippet"
  toJSON EventTargetType
ETTUser = Text -> Value
String Text
"User"

instance FromJSON EventTargetType where
  parseJSON :: Value -> Parser EventTargetType
parseJSON (String Text
"Issue") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTIssue
  parseJSON (String Text
"Milestone") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTMilestone
  parseJSON (String Text
"MergeRequest") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTMergeRequest
  parseJSON (String Text
"Note") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTNote
  parseJSON (String Text
"Project") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTProject
  parseJSON (String Text
"Snippet") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTSnippet
  parseJSON (String Text
"User") = EventTargetType -> Parser EventTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return EventTargetType
ETTUser
  parseJSON Value
x = Value -> Parser EventTargetType
forall a. Value -> Parser a
unexpected Value
x

-- | Events https://docs.gitlab.com/ee/api/events.html
data Job = Job
  { Job -> Commit
job_commit :: Commit,
    Job -> Maybe Text
job_coverage :: Maybe Text, -- ??
    Job -> Bool
job_allow_failure :: Bool,
    Job -> UTCTime
job_created_at :: UTCTime,
    Job -> Maybe UTCTime
job_started_at :: Maybe UTCTime,
    Job -> Maybe UTCTime
job_finished_at :: Maybe UTCTime,
    Job -> Maybe Double
job_duration :: Maybe Double,
    Job -> Double
job_queued_duration :: Double,
    Job -> Maybe Artifact
job_artifacts_file :: Maybe Artifact,
    Job -> Maybe [Artifact]
job_artifacts :: Maybe [Artifact],
    Job -> Maybe UTCTime
job_artifacts_expire_at :: Maybe UTCTime,
    Job -> Maybe [Text]
job_tag_list :: Maybe [Text],
    Job -> Int
job_id :: Int,
    Job -> Text
job_name :: Text,
    Job -> Maybe Pipeline
job_pipeline :: Maybe Pipeline,
    Job -> Text
job_ref :: Text,
    Job -> Maybe Text
job_stage :: Maybe Text,
    Job -> Text
job_status :: Text, -- TODO type for "failed" and others
    Job -> Maybe Text
job_failure_reason :: Maybe Text, -- TODO type for "script_failure" and others
    Job -> Bool
job_tag :: Bool,
    Job -> Text
job_web_url :: Text, -- TODO type for URL like "https://example.com/foo/bar/-/jobs/7"
    Job -> Maybe User
job_user :: Maybe User,
    Job -> Maybe Pipeline
job_downstream_pipeline :: Maybe Pipeline
  }
  deriving (Int -> Job -> ShowS
[Job] -> ShowS
Job -> String
(Int -> Job -> ShowS)
-> (Job -> String) -> ([Job] -> ShowS) -> Show Job
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Job] -> ShowS
$cshowList :: [Job] -> ShowS
show :: Job -> String
$cshow :: Job -> String
showsPrec :: Int -> Job -> ShowS
$cshowsPrec :: Int -> Job -> ShowS
Show, Job -> Job -> Bool
(Job -> Job -> Bool) -> (Job -> Job -> Bool) -> Eq Job
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Job -> Job -> Bool
$c/= :: Job -> Job -> Bool
== :: Job -> Job -> Bool
$c== :: Job -> Job -> Bool
Eq)

-----------------------------
-- JSON GitLab parsers below
-----------------------------

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "time_stats_"), omitNothingFields = True} ''TimeStats)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "saml_identity_"), omitNothingFields = True} ''SamlIdentity)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "identity_"), omitNothingFields = True} ''Identity)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "user_"), omitNothingFields = True} ''User)

instance ToJSON MilestoneState where
  toJSON :: MilestoneState -> Value
toJSON MilestoneState
MSActive = Text -> Value
String Text
"active"
  toJSON MilestoneState
MSClosed = Text -> Value
String Text
"closed"

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "milestone_"), omitNothingFields = True} ''Milestone)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "references_"), omitNothingFields = True} ''References)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "epic_"), omitNothingFields = True} ''Epic)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "links_"), omitNothingFields = True} ''Links)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "task_completion_status_"), omitNothingFields = True} ''TaskCompletionStatus)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "issue_"), omitNothingFields = True} ''Issue)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "detailed_status_"), omitNothingFields = True} ''DetailedStatus)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "pipeline_"), omitNothingFields = True} ''Pipeline)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "commitstats_"), omitNothingFields = True} ''CommitStats)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "commit_"), omitNothingFields = True} ''Commit)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "release_"), omitNothingFields = True} ''Release)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "tag_"), omitNothingFields = True} ''Tag)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "contributor_"), omitNothingFields = True} ''Contributor)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "member_"), omitNothingFields = True} ''Member)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "permissions_"), omitNothingFields = True} ''Permissions)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "owner_"), omitNothingFields = True} ''Owner)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "namespace_"), omitNothingFields = True} ''Namespace)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "expiration_policy_"), omitNothingFields = True} ''ExpirationPolicy)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "license_"), omitNothingFields = True} ''License)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "groupshare_"), omitNothingFields = True} ''GroupShare)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "statistics_"), omitNothingFields = True} ''Statistics)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "project_"), omitNothingFields = True} ''Project)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "repository_"), omitNothingFields = True} ''Repository)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "artifact_"), omitNothingFields = True} ''Artifact)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "job_"), omitNothingFields = True} ''Job)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "branch_"), omitNothingFields = True} ''Branch)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "repository_file_"), omitNothingFields = True} ''RepositoryFile)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "repository_file_simple_"), omitNothingFields = True} ''RepositoryFileSimple)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "repository_file_blame_"), omitNothingFields = True} ''RepositoryFileBlame)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "change_"), omitNothingFields = True} ''Change)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "diff_refs_"), omitNothingFields = True} ''DiffRefs)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "merge_request_"), omitNothingFields = True} ''MergeRequest)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "diff_"), omitNothingFields = True} ''Diff)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "version_"), omitNothingFields = True} ''Version)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "edit_issue_"), omitNothingFields = True} ''EditIssueReq)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "commands_changes_"), omitNothingFields = True} ''CommandsChanges)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "note_"), omitNothingFields = True} ''Note)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "discussion_"), omitNothingFields = True} ''Discussion)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "issue_counts_"), omitNothingFields = True} ''IssueCounts)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "issue_stats_"), omitNothingFields = True} ''IssueStats)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "issue_statistics_"), omitNothingFields = True} ''IssueStatistics)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "board_issue_label_"), omitNothingFields = True} ''BoardIssueLabel)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "board_issue_"), omitNothingFields = True} ''BoardIssue)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "board_"), omitNothingFields = True} ''IssueBoard)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "testcase_"), omitNothingFields = True} ''TestCase)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "testsuite_"), omitNothingFields = True} ''TestSuite)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "test_report_"), omitNothingFields = True} ''TestReport)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "time_estimate_"), omitNothingFields = True} ''TimeEstimate)

instance ToJSON TodoAction where
  toJSON :: TodoAction -> Value
toJSON TodoAction
TAAssigned = Text -> Value
String Text
"assigned"
  toJSON TodoAction
TAMentioned = Text -> Value
String Text
"mentioned"
  toJSON TodoAction
TABuildFailed = Text -> Value
String Text
"build_build"
  toJSON TodoAction
TAMarked = Text -> Value
String Text
"marked"
  toJSON TodoAction
TAApprovalRequired = Text -> Value
String Text
"approval_required"
  toJSON TodoAction
TAUnmergeable = Text -> Value
String Text
"unmergeable"
  toJSON TodoAction
TADirectlyAddressed = Text -> Value
String Text
"directly_addressed"

instance FromJSON TodoState where
  parseJSON :: Value -> Parser TodoState
parseJSON (String Text
"pending") = TodoState -> Parser TodoState
forall (m :: * -> *) a. Monad m => a -> m a
return TodoState
TSPending
  parseJSON (String Text
"done") = TodoState -> Parser TodoState
forall (m :: * -> *) a. Monad m => a -> m a
return TodoState
TSDone
  parseJSON Value
x = Value -> Parser TodoState
forall a. Value -> Parser a
unexpected Value
x

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "commit_todo_"), omitNothingFields = True} ''CommitTodo)

instance FromJSON TodoTargetType where
  parseJSON :: Value -> Parser TodoTargetType
parseJSON (String Text
"MergeRequest") = TodoTargetType -> Parser TodoTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return TodoTargetType
MergeRequestTarget
  parseJSON (String Text
"Issue") = TodoTargetType -> Parser TodoTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return TodoTargetType
IssueTarget
  parseJSON (String Text
"Commit") = TodoTargetType -> Parser TodoTargetType
forall (m :: * -> *) a. Monad m => a -> m a
return TodoTargetType
CommitTarget
  parseJSON Value
x = Value -> Parser TodoTargetType
forall a. Value -> Parser a
unexpected Value
x

instance FromJSON Todo where
  parseJSON :: Value -> Parser Todo
parseJSON = String -> (Object -> Parser Todo) -> Value -> Parser Todo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Todo" ((Object -> Parser Todo) -> Value -> Parser Todo)
-> (Object -> Parser Todo) -> Value -> Parser Todo
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Int
-> TodoProject
-> User
-> TodoAction
-> TodoTargetType
-> TodoTarget
-> Text
-> Text
-> TodoState
-> UTCTime
-> Maybe UTCTime
-> Todo
Todo
      (Int
 -> TodoProject
 -> User
 -> TodoAction
 -> TodoTargetType
 -> TodoTarget
 -> Text
 -> Text
 -> TodoState
 -> UTCTime
 -> Maybe UTCTime
 -> Todo)
-> Parser Int
-> Parser
     (TodoProject
      -> User
      -> TodoAction
      -> TodoTargetType
      -> TodoTarget
      -> Text
      -> Text
      -> TodoState
      -> UTCTime
      -> Maybe UTCTime
      -> Todo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (TodoProject
   -> User
   -> TodoAction
   -> TodoTargetType
   -> TodoTarget
   -> Text
   -> Text
   -> TodoState
   -> UTCTime
   -> Maybe UTCTime
   -> Todo)
-> Parser TodoProject
-> Parser
     (User
      -> TodoAction
      -> TodoTargetType
      -> TodoTarget
      -> Text
      -> Text
      -> TodoState
      -> UTCTime
      -> Maybe UTCTime
      -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser TodoProject
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"
      Parser
  (User
   -> TodoAction
   -> TodoTargetType
   -> TodoTarget
   -> Text
   -> Text
   -> TodoState
   -> UTCTime
   -> Maybe UTCTime
   -> Todo)
-> Parser User
-> Parser
     (TodoAction
      -> TodoTargetType
      -> TodoTarget
      -> Text
      -> Text
      -> TodoState
      -> UTCTime
      -> Maybe UTCTime
      -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author"
      Parser
  (TodoAction
   -> TodoTargetType
   -> TodoTarget
   -> Text
   -> Text
   -> TodoState
   -> UTCTime
   -> Maybe UTCTime
   -> Todo)
-> Parser TodoAction
-> Parser
     (TodoTargetType
      -> TodoTarget
      -> Text
      -> Text
      -> TodoState
      -> UTCTime
      -> Maybe UTCTime
      -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser TodoAction
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action_name"
      Parser
  (TodoTargetType
   -> TodoTarget
   -> Text
   -> Text
   -> TodoState
   -> UTCTime
   -> Maybe UTCTime
   -> Todo)
-> Parser TodoTargetType
-> Parser
     (TodoTarget
      -> Text -> Text -> TodoState -> UTCTime -> Maybe UTCTime -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser TodoTargetType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_type"
      Parser
  (TodoTarget
   -> Text -> Text -> TodoState -> UTCTime -> Maybe UTCTime -> Todo)
-> Parser TodoTarget
-> Parser
     (Text -> Text -> TodoState -> UTCTime -> Maybe UTCTime -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_type" Parser Text -> (Text -> Parser TodoTarget) -> Parser TodoTarget
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Text
"MergeRequest" -> MergeRequest -> TodoTarget
TTMergeRequest (MergeRequest -> TodoTarget)
-> Parser MergeRequest -> Parser TodoTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MergeRequest
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target"
              Text
"Issue" -> Issue -> TodoTarget
TTIssue (Issue -> TodoTarget) -> Parser Issue -> Parser TodoTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Issue
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target"
              Text
"Commit" -> CommitTodo -> TodoTarget
TTCommit (CommitTodo -> TodoTarget)
-> Parser CommitTodo -> Parser TodoTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser CommitTodo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target"
              (Text
_ :: Text) -> String -> Parser TodoTarget
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
          )
      Parser
  (Text -> Text -> TodoState -> UTCTime -> Maybe UTCTime -> Todo)
-> Parser Text
-> Parser (Text -> TodoState -> UTCTime -> Maybe UTCTime -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_url"
      Parser (Text -> TodoState -> UTCTime -> Maybe UTCTime -> Todo)
-> Parser Text
-> Parser (TodoState -> UTCTime -> Maybe UTCTime -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
      Parser (TodoState -> UTCTime -> Maybe UTCTime -> Todo)
-> Parser TodoState -> Parser (UTCTime -> Maybe UTCTime -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser TodoState
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      Parser (UTCTime -> Maybe UTCTime -> Todo)
-> Parser UTCTime -> Parser (Maybe UTCTime -> Todo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      Parser (Maybe UTCTime -> Todo)
-> Parser (Maybe UTCTime) -> Parser Todo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at"

$(deriveToJSON defaultOptions {fieldLabelModifier = drop (T.length "todo_"), omitNothingFields = True} ''Todo)

instance ToJSON TodoTargetType where
  toJSON :: TodoTargetType -> Value
toJSON TodoTargetType
MergeRequestTarget = Text -> Value
String Text
"MergeRequest"
  toJSON TodoTargetType
IssueTarget = Text -> Value
String Text
"Issue"
  toJSON TodoTargetType
CommitTarget = Text -> Value
String Text
"Commit"

instance ToJSON TodoState where
  toJSON :: TodoState -> Value
toJSON TodoState
TSPending = Text -> Value
String Text
"pending"
  toJSON TodoState
TSDone = Text -> Value
String Text
"done"

instance ToJSON TodoTarget where
  toJSON :: TodoTarget -> Value
toJSON (TTIssue Issue
x) = Issue -> Value
forall a. ToJSON a => a -> Value
toJSON Issue
x
  toJSON (TTMergeRequest MergeRequest
x) = MergeRequest -> Value
forall a. ToJSON a => a -> Value
toJSON MergeRequest
x
  toJSON (TTCommit CommitTodo
x) = CommitTodo -> Value
forall a. ToJSON a => a -> Value
toJSON CommitTodo
x

-- | User who is the starrer of a project.
data Starrer = Starrer
  { Starrer -> UTCTime
starrer_starred_since :: UTCTime,
    Starrer -> User
starrer_user :: User
  }
  deriving (Int -> Starrer -> ShowS
[Starrer] -> ShowS
Starrer -> String
(Int -> Starrer -> ShowS)
-> (Starrer -> String) -> ([Starrer] -> ShowS) -> Show Starrer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Starrer] -> ShowS
$cshowList :: [Starrer] -> ShowS
show :: Starrer -> String
$cshow :: Starrer -> String
showsPrec :: Int -> Starrer -> ShowS
$cshowsPrec :: Int -> Starrer -> ShowS
Show, Starrer -> Starrer -> Bool
(Starrer -> Starrer -> Bool)
-> (Starrer -> Starrer -> Bool) -> Eq Starrer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Starrer -> Starrer -> Bool
$c/= :: Starrer -> Starrer -> Bool
== :: Starrer -> Starrer -> Bool
$c== :: Starrer -> Starrer -> Bool
Eq)

-- | Avatar for a project.
newtype ProjectAvatar = ProjectAvatar
  { ProjectAvatar -> Text
project_avatar_avatar_url :: Text
  }
  deriving (Int -> ProjectAvatar -> ShowS
[ProjectAvatar] -> ShowS
ProjectAvatar -> String
(Int -> ProjectAvatar -> ShowS)
-> (ProjectAvatar -> String)
-> ([ProjectAvatar] -> ShowS)
-> Show ProjectAvatar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectAvatar] -> ShowS
$cshowList :: [ProjectAvatar] -> ShowS
show :: ProjectAvatar -> String
$cshow :: ProjectAvatar -> String
showsPrec :: Int -> ProjectAvatar -> ShowS
$cshowsPrec :: Int -> ProjectAvatar -> ShowS
Show, ProjectAvatar -> ProjectAvatar -> Bool
(ProjectAvatar -> ProjectAvatar -> Bool)
-> (ProjectAvatar -> ProjectAvatar -> Bool) -> Eq ProjectAvatar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectAvatar -> ProjectAvatar -> Bool
$c/= :: ProjectAvatar -> ProjectAvatar -> Bool
== :: ProjectAvatar -> ProjectAvatar -> Bool
$c== :: ProjectAvatar -> ProjectAvatar -> Bool
Eq)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "repository_storage_"), omitNothingFields = True} ''RepositoryStorage)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "starrer_"), omitNothingFields = True} ''Starrer)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "project_avatar_"), omitNothingFields = True} ''ProjectAvatar)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "group_"), omitNothingFields = True} ''Group)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "commitnote_"), omitNothingFields = True} ''CommitNote)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "email_"), omitNothingFields = True} ''Email)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "key_"), omitNothingFields = True} ''Key)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "user_prefs_"), omitNothingFields = True} ''UserPrefs)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "user_status_"), omitNothingFields = True} ''UserStatus)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "user_count_"), omitNothingFields = True} ''UserCount)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "push_data_"), omitNothingFields = True} ''PushData)

$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "event_"), omitNothingFields = True} ''Event)