{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

-- |
-- 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 (..),
    Member (..),
    Namespace (..),
    Links (..),
    Owner (..),
    Permissions (..),
    ProjectId,
    Project (..),
    ProjectStats (..),
    User (..),
    Milestone (..),
    MilestoneState (..),
    TimeStats (..),
    IssueId,
    Issue (..),
    Pipeline (..),
    Commit (..),
    CommitTodo (..),
    CommitStats (..),
    Tag (..),
    Release (..),
    Diff (..),
    Repository (..),
    Job (..),
    Artifact (..),
    Group (..),
    GroupShare (..),
    Branch (..),
    RepositoryFile (..),
    MergeRequest (..),
    Todo (..),
    TodoProject (..),
    TodoAction (..),
    TodoTarget (..),
    TodoState (..),
    Version (..),
    URL,
    EditIssueReq (..),
    Discussion (..),
    Note (..),
    IssueStatistics (..),
    IssueStats (..),
    IssueCounts (..),
    IssueBoard (..),
    BoardIssue (..),
    BoardIssueLabel (..),
    ProjectBoard (..),
    Visibility (..),
    TestReport (..),
    TestSuite (..),
    TestCase (..),
  )
where

import Control.Monad.Trans.Reader
import Data.Aeson
import Data.Aeson.Types
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock
import GHC.Generics
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"

-- | member of a project.
data Member = Member
  { Member -> Int
member_id :: Int,
    Member -> Text
member_name :: Text,
    Member -> Text
member_username :: Text,
    Member -> Text
member_state :: Text,
    Member -> Maybe Text
member_avatar_uri :: Maybe Text,
    Member -> Maybe Text
member_web_url :: Maybe Text,
    Member -> Int
access_level :: Int,
    Member -> Maybe Text
expires_at :: Maybe Text
  }
  deriving ((forall x. Member -> Rep Member x)
-> (forall x. Rep Member x -> Member) -> Generic Member
forall x. Rep Member x -> Member
forall x. Member -> Rep Member x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Member x -> Member
$cfrom :: forall x. Member -> Rep Member x
Generic, 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)

-- | namespaces.
data Namespace = Namespace
  { Namespace -> Int
namespace_id :: Int,
    Namespace -> Text
namespace_name :: Text,
    Namespace -> Text
namespace_path :: Text,
    Namespace -> Text
kind :: Text,
    Namespace -> Text
full_path :: Text,
    Namespace -> Maybe Int
parent_id :: Maybe Int
  }
  deriving ((forall x. Namespace -> Rep Namespace x)
-> (forall x. Rep Namespace x -> Namespace) -> Generic Namespace
forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Namespace x -> Namespace
$cfrom :: forall x. Namespace -> Rep Namespace x
Generic, 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)

-- | links.
data Links = Links
  { Links -> Text
self :: Text,
    Links -> Maybe Text
issues :: Maybe Text,
    Links -> Maybe Text
merge_requests :: Maybe Text,
    Links -> Text
repo_branches :: Text,
    Links -> Text
link_labels :: Text,
    Links -> Text
link_events :: Text,
    Links -> Text
members :: Text
  }
  deriving ((forall x. Links -> Rep Links x)
-> (forall x. Rep Links x -> Links) -> Generic Links
forall x. Rep Links x -> Links
forall x. Links -> Rep Links x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Links x -> Links
$cfrom :: forall x. Links -> Rep Links x
Generic, 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)

-- | owners.
data Owner = Ownwer
  { Owner -> Int
owner_id :: Int,
    Owner -> Text
owner_name :: Text,
    Owner -> Text
owner_username :: Text,
    Owner -> Text
state :: Text,
    Owner -> Maybe Text
owner_avatar_url :: Maybe Text,
    Owner -> Text
owner_web_url :: Text
  }
  deriving ((forall x. Owner -> Rep Owner x)
-> (forall x. Rep Owner x -> Owner) -> Generic Owner
forall x. Rep Owner x -> Owner
forall x. Owner -> Rep Owner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Owner x -> Owner
$cfrom :: forall x. Owner -> Rep Owner x
Generic, 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 Object
project_access :: Maybe Object,
    Permissions -> Maybe Object
group_access :: Maybe Object
  }
  deriving ((forall x. Permissions -> Rep Permissions x)
-> (forall x. Rep Permissions x -> Permissions)
-> Generic Permissions
forall x. Rep Permissions x -> Permissions
forall x. Permissions -> Rep Permissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Permissions x -> Permissions
$cfrom :: forall x. Permissions -> Rep Permissions x
Generic, 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)

-- | projects.
data Project = Project
  { Project -> Int
project_id :: Int,
    Project -> Maybe Text
description :: Maybe Text,
    Project -> Text
project_name :: Text,
    Project -> Text
name_with_namespace :: Text,
    Project -> Text
project_path :: Text,
    Project -> Text
project_path_with_namespace :: Text,
    Project -> Text
project_created_at :: Text,
    Project -> Maybe Text
default_branch :: Maybe Text,
    Project -> [Text]
tag_list :: [Text], -- check
    Project -> Text
ssh_url_to_repo :: Text,
    Project -> Text
http_url_to_repo :: Text,
    Project -> Text
project_web_url :: Text,
    Project -> Maybe Text
readme_url :: Maybe Text, -- check
    Project -> Maybe Text
project_avatar_url :: Maybe Text, -- check
    Project -> Int
star_count :: Int,
    Project -> Int
forks_count :: Int,
    Project -> Text
last_activity_at :: Text,
    Project -> Namespace
namespace :: Namespace,
    Project -> Maybe Links
_links :: Maybe Links,
    Project -> Maybe Bool
archived :: Maybe Bool,
    Project -> Maybe Text
visibility :: Maybe Text,
    Project -> Maybe Owner
owner :: Maybe Owner,
    Project -> Maybe Bool
resolve_outdated_diff_discussions :: Maybe Bool,
    Project -> Maybe Bool
container_registry_enabled :: Maybe Bool,
    Project -> Maybe Bool
issues_enabled :: Maybe Bool,
    Project -> Maybe Bool
merge_requests_enabled :: Maybe Bool,
    Project -> Maybe Bool
wiki_enabled :: Maybe Bool,
    Project -> Maybe Bool
jobs_enabled :: Maybe Bool,
    Project -> Maybe Bool
snippets_enabled :: Maybe Bool,
    Project -> Maybe Bool
shared_runners_enabled :: Maybe Bool,
    Project -> Maybe Bool
lfs_enabled :: Maybe Bool,
    Project -> Maybe Int
creator_id :: Maybe Int,
    Project -> Maybe Project
forked_from_project :: Maybe Project,
    Project -> Maybe String
import_status :: Maybe String,
    Project -> Maybe Int
open_issues_count :: Maybe Int,
    Project -> Maybe Bool
public_jobs :: Maybe Bool,
    Project -> Maybe Text
ci_config_path :: Maybe Text, -- check null
    Project -> Maybe [Object]
shared_with_groups :: Maybe [Object],
    Project -> Maybe Bool
only_allow_merge_if_pipeline_succeeds :: Maybe Bool,
    Project -> Maybe Bool
request_access_enabled :: Maybe Bool,
    Project -> Maybe Bool
only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,
    Project -> Maybe Bool
printing_merge_request_link_enabled :: Maybe Bool,
    Project -> Maybe Text
merge_method :: Maybe Text,
    Project -> Maybe Permissions
permissions :: Maybe Permissions,
    Project -> Maybe ProjectStats
project_stats :: Maybe ProjectStats
  }
  deriving ((forall x. Project -> Rep Project x)
-> (forall x. Rep Project x -> Project) -> Generic Project
forall x. Rep Project x -> Project
forall x. Project -> Rep Project x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Project x -> Project
$cfrom :: forall x. Project -> Rep Project x
Generic, 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 statistics.
data ProjectStats = ProjectStats
  { ProjectStats -> Int
commit_count :: Int,
    ProjectStats -> Int
storage_size :: Int,
    ProjectStats -> Int
repository_size :: Int,
    ProjectStats -> Maybe Int
wiki_size :: Maybe Int,
    ProjectStats -> Maybe Int
lfs_objects_size :: Maybe Int,
    ProjectStats -> Maybe Int
job_artifacts_size :: Maybe Int,
    ProjectStats -> Maybe Int
packages_size :: Maybe Int
  }
  deriving ((forall x. ProjectStats -> Rep ProjectStats x)
-> (forall x. Rep ProjectStats x -> ProjectStats)
-> Generic ProjectStats
forall x. Rep ProjectStats x -> ProjectStats
forall x. ProjectStats -> Rep ProjectStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectStats x -> ProjectStats
$cfrom :: forall x. ProjectStats -> Rep ProjectStats x
Generic, Int -> ProjectStats -> ShowS
[ProjectStats] -> ShowS
ProjectStats -> String
(Int -> ProjectStats -> ShowS)
-> (ProjectStats -> String)
-> ([ProjectStats] -> ShowS)
-> Show ProjectStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectStats] -> ShowS
$cshowList :: [ProjectStats] -> ShowS
show :: ProjectStats -> String
$cshow :: ProjectStats -> String
showsPrec :: Int -> ProjectStats -> ShowS
$cshowsPrec :: Int -> ProjectStats -> ShowS
Show)

-- | registered users.
data User = User
  { User -> Int
user_id :: Int,
    User -> Text
user_username :: Text,
    User -> Text
user_name :: Text,
    User -> Text
user_state :: Text,
    User -> Maybe Text
user_avatar_uri :: Maybe Text,
    User -> Maybe Text
user_web_url :: Maybe Text
  }
  deriving ((forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic, 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)

-- | 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 Int
milestone_iid :: Maybe Int,
    Milestone -> Maybe UTCTime
milestone_created_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 ((forall x. Milestone -> Rep Milestone x)
-> (forall x. Rep Milestone x -> Milestone) -> Generic Milestone
forall x. Rep Milestone x -> Milestone
forall x. Milestone -> Rep Milestone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Milestone x -> Milestone
$cfrom :: forall x. Milestone -> Rep Milestone x
Generic, 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 :: Value -> Parser Milestone
parseJSON = Options -> Value -> Parser Milestone
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
10})

-- | time stats.
data TimeStats = TimeStats
  { TimeStats -> Int
time_estimate :: Int,
    TimeStats -> Int
total_time_spent :: Int,
    TimeStats -> Maybe Int
human_time_estimate :: Maybe Int,
    TimeStats -> Maybe Int
human_total_time_spent :: Maybe Int
  }
  deriving ((forall x. TimeStats -> Rep TimeStats x)
-> (forall x. Rep TimeStats x -> TimeStats) -> Generic TimeStats
forall x. Rep TimeStats x -> TimeStats
forall x. TimeStats -> Rep TimeStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeStats x -> TimeStats
$cfrom :: forall x. TimeStats -> Rep TimeStats x
Generic, 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)

-- | 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 -> User
issue_author :: User,
    Issue -> Maybe Milestone
milestone :: Maybe Milestone,
    Issue -> Int
issue_project_id :: ProjectId,
    Issue -> Maybe [User]
assignees :: Maybe [User],
    Issue -> Maybe User
assignee :: Maybe User,
    Issue -> Text
updated_at :: Text,
    Issue -> Maybe Text
closed_at :: Maybe Text,
    Issue -> Maybe User
closed_by :: Maybe User,
    Issue -> Int
issue_id :: IssueId,
    Issue -> Text
issue_title :: Text,
    Issue -> Text
issue_created_at :: Text,
    Issue -> Int
iid :: Int,
    Issue -> [Text]
issue_labels :: [Text],
    Issue -> Int
upvotes :: Int,
    Issue -> Int
downvotes :: Int,
    Issue -> Int
user_notes_count :: Int,
    Issue -> Maybe Text
issue_due_date :: Maybe Text,
    Issue -> Text
issue_web_url :: Text,
    Issue -> Bool
confidential :: Bool,
    Issue -> Maybe Text
weight :: Maybe Text, -- Int?
    Issue -> Maybe Bool
discussion_locked :: Maybe Bool,
    Issue -> TimeStats
time_stats :: TimeStats
  }
  deriving ((forall x. Issue -> Rep Issue x)
-> (forall x. Rep Issue x -> Issue) -> Generic Issue
forall x. Rep Issue x -> Issue
forall x. Issue -> Rep Issue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Issue x -> Issue
$cfrom :: forall x. Issue -> Rep Issue x
Generic, 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)

-- | project pipelines
data Pipeline = Pipeline
  { Pipeline -> Int
pipeline_id :: Int,
    Pipeline -> Text
sha :: Text,
    Pipeline -> Text
pipeline_ref :: Text,
    Pipeline -> Text
pipeline_status :: Text,
    Pipeline -> Maybe Text
pipeline_web_url :: Maybe Text
  }
  deriving ((forall x. Pipeline -> Rep Pipeline x)
-> (forall x. Rep Pipeline x -> Pipeline) -> Generic Pipeline
forall x. Rep Pipeline x -> Pipeline
forall x. Pipeline -> Rep Pipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pipeline x -> Pipeline
$cfrom :: forall x. Pipeline -> Rep Pipeline x
Generic, 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)

-- | code commits.
data Commit = Commit
  { Commit -> Text
commit_id :: Text,
    Commit -> Text
short_id :: Text,
    Commit -> Text
title :: Text,
    Commit -> Text
author_name :: Text,
    Commit -> Text
author_email :: Text,
    Commit -> Text
authored_date :: Text,
    Commit -> Text
committer_name :: Text,
    Commit -> Text
committer_email :: Text,
    Commit -> Text
committed_date :: Text,
    Commit -> Text
commit_created_at :: Text,
    Commit -> Text
message :: Text,
    Commit -> Maybe [String]
commit_parent_ids :: Maybe [String],
    Commit -> Maybe Pipeline
last_pipeline :: Maybe Pipeline,
    Commit -> Maybe CommitStats
commit_stats :: Maybe CommitStats,
    Commit -> Maybe Text
commit_status :: Maybe Text
  }
  deriving ((forall x. Commit -> Rep Commit x)
-> (forall x. Rep Commit x -> Commit) -> Generic Commit
forall x. Rep Commit x -> Commit
forall x. Commit -> Rep Commit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Commit x -> Commit
$cfrom :: forall x. Commit -> Rep Commit x
Generic, 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)

-- | summary of a code commit for TODOs.
data CommitTodo = CommitTodo
  { CommitTodo -> Text
todo_commit_id :: Text,
    CommitTodo -> Text
todo_commit_short_id :: Text,
    CommitTodo -> Text
todo_commit_created_at :: Text,
    CommitTodo -> Maybe [String]
todo_parent_ids :: Maybe [String]
  }
  deriving ((forall x. CommitTodo -> Rep CommitTodo x)
-> (forall x. Rep CommitTodo x -> CommitTodo) -> Generic CommitTodo
forall x. Rep CommitTodo x -> CommitTodo
forall x. CommitTodo -> Rep CommitTodo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommitTodo x -> CommitTodo
$cfrom :: forall x. CommitTodo -> Rep CommitTodo x
Generic, 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)

-- | commit stats.
data CommitStats = Stats
  { CommitStats -> Int
additions :: Int,
    CommitStats -> Int
deletions :: Int,
    CommitStats -> Int
total :: Int
  }
  deriving ((forall x. CommitStats -> Rep CommitStats x)
-> (forall x. Rep CommitStats x -> CommitStats)
-> Generic CommitStats
forall x. Rep CommitStats x -> CommitStats
forall x. CommitStats -> Rep CommitStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommitStats x -> CommitStats
$cfrom :: forall x. CommitStats -> Rep CommitStats x
Generic, 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)

-- | 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 ((forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
Generic, 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)

-- | Release associated with a tag
data Release = Release
  { Release -> Text
release_tag_name :: Text,
    Release -> Text
release_description :: Text
  }
  deriving ((forall x. Release -> Rep Release x)
-> (forall x. Rep Release x -> Release) -> Generic Release
forall x. Rep Release x -> Release
forall x. Release -> Rep Release x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Release x -> Release
$cfrom :: forall x. Release -> Rep Release x
Generic, 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)

-- | diff between two commits.
data Diff = Diff
  { Diff -> Text
diff :: Text,
    Diff -> Text
new_path :: Text,
    Diff -> Text
old_path :: Text,
    Diff -> Maybe Text
a_mode :: Maybe Text,
    Diff -> Maybe Text
b_mode :: Maybe Text,
    Diff -> Bool
new_file :: Bool,
    Diff -> Bool
renamed_file :: Bool,
    Diff -> Bool
deleted_file :: Bool
  }
  deriving ((forall x. Diff -> Rep Diff x)
-> (forall x. Rep Diff x -> Diff) -> Generic Diff
forall x. Rep Diff x -> Diff
forall x. Diff -> Rep Diff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Diff x -> Diff
$cfrom :: forall x. Diff -> Rep Diff x
Generic, 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)

-- | 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
mode :: Text
  }
  deriving ((forall x. Repository -> Rep Repository x)
-> (forall x. Rep Repository x -> Repository) -> Generic Repository
forall x. Rep Repository x -> Repository
forall x. Repository -> Rep Repository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repository x -> Repository
$cfrom :: forall x. Repository -> Rep Repository x
Generic, 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)

-- | jobs.
data Job = Job
  { Job -> Commit
job_commit :: Commit,
    Job -> Maybe Text
job_coverage :: Maybe Text, -- ?
    Job -> Text
job_created_at :: Text,
    Job -> Text
job_started_at :: Text,
    Job -> Text
job_finished_at :: Text,
    Job -> Double
job_duration :: Double,
    Job -> Maybe Text
job_artifacts_expire_at :: Maybe Text,
    Job -> Int
job_id :: Int,
    Job -> Text
job_name :: Text,
    Job -> Pipeline
job_pipeline :: Pipeline,
    Job -> Text
job_ref :: Text,
    Job -> [Artifact]
job_artifacts :: [Artifact],
    -- , runner :: Maybe Text
    Job -> Text
job_stage :: Text,
    Job -> Text
job_status :: Text,
    Job -> Bool
job_tag :: Bool,
    Job -> Text
job_web_url :: Text,
    Job -> User
job_user :: User
  }
  deriving ((forall x. Job -> Rep Job x)
-> (forall x. Rep Job x -> Job) -> Generic Job
forall x. Rep Job x -> Job
forall x. Job -> Rep Job x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Job x -> Job
$cfrom :: forall x. Job -> Rep Job x
Generic, 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)

-- | artifacts.
data Artifact = Artifact
  { Artifact -> Text
file_type :: Text,
    Artifact -> Int
size :: Int,
    Artifact -> Text
filename :: Text,
    Artifact -> Maybe Text
file_format :: Maybe Text
  }
  deriving ((forall x. Artifact -> Rep Artifact x)
-> (forall x. Rep Artifact x -> Artifact) -> Generic Artifact
forall x. Rep Artifact x -> Artifact
forall x. Artifact -> Rep Artifact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Artifact x -> Artifact
$cfrom :: forall x. Artifact -> Rep Artifact x
Generic, 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)

-- | groups.
data Group = Group
  { Group -> Int
group_id :: Int,
    Group -> Text
group_name :: Text,
    Group -> Text
group_path :: Text,
    Group -> Text
group_description :: Text,
    Group -> Text
group_visibility :: Text,
    Group -> Bool
group_lfs_enabled :: Bool,
    Group -> Maybe Text
group_avatar_url :: Maybe Text,
    Group -> Text
group_web_url :: Text,
    Group -> Bool
group_request_access_enabled :: Bool,
    Group -> Text
group_full_name :: Text,
    Group -> Text
group_full_path :: Text,
    Group -> Maybe Int
group_file_template_project_id :: Maybe Int,
    Group -> Maybe Int
group_parent_id :: Maybe Int
  }
  deriving ((forall x. Group -> Rep Group x)
-> (forall x. Rep Group x -> Group) -> Generic Group
forall x. Rep Group x -> Group
forall x. Group -> Rep Group x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Group x -> Group
$cfrom :: forall x. Group -> Rep Group x
Generic, 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)

-- | response to sharing a project with a group.
data GroupShare = GroupShare
  { GroupShare -> Int
share_id :: Int,
    GroupShare -> Int
share_project_id :: Int,
    GroupShare -> Int
share_group_id :: Int,
    GroupShare -> Int
share_group_access :: Int,
    GroupShare -> Maybe Text
share_expires_at :: Maybe Text
  }
  deriving ((forall x. GroupShare -> Rep GroupShare x)
-> (forall x. Rep GroupShare x -> GroupShare) -> Generic GroupShare
forall x. Rep GroupShare x -> GroupShare
forall x. GroupShare -> Rep GroupShare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupShare x -> GroupShare
$cfrom :: forall x. GroupShare -> Rep GroupShare x
Generic, 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)

-- | code branches.
data Branch = Branch
  { Branch -> Text
branch_name :: Text,
    Branch -> Bool
merged :: Bool,
    Branch -> Bool
protected :: Bool,
    Branch -> Bool
branch_default :: Bool,
    Branch -> Bool
developers_can_push :: Bool,
    Branch -> Bool
developers_can_merge :: Bool,
    Branch -> Bool
can_push :: Bool,
    Branch -> Commit
branch_commit :: Commit
  }
  deriving ((forall x. Branch -> Rep Branch x)
-> (forall x. Rep Branch x -> Branch) -> Generic Branch
forall x. Rep Branch x -> Branch
forall x. Branch -> Rep Branch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Branch x -> Branch
$cfrom :: forall x. Branch -> Rep Branch x
Generic, 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)

-- | 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
encoding :: Text,
    RepositoryFile -> Text
content :: Text,
    RepositoryFile -> Text
content_sha256 :: Text,
    RepositoryFile -> Text
ref :: Text,
    RepositoryFile -> Text
blob_id :: Text,
    RepositoryFile -> Text
repository_file_commit_id :: Text,
    RepositoryFile -> Text
last_commit_id :: Text
  }
  deriving ((forall x. RepositoryFile -> Rep RepositoryFile x)
-> (forall x. Rep RepositoryFile x -> RepositoryFile)
-> Generic RepositoryFile
forall x. Rep RepositoryFile x -> RepositoryFile
forall x. RepositoryFile -> Rep RepositoryFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepositoryFile x -> RepositoryFile
$cfrom :: forall x. RepositoryFile -> Rep RepositoryFile x
Generic, 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)

-- | 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,
    MergeRequest -> Maybe User
merge_request_merged_by :: Maybe User,
    MergeRequest -> Maybe Text
merge_request_merged_at :: Maybe Text,
    MergeRequest -> Maybe User
merge_request_closed_by :: Maybe User,
    MergeRequest -> Maybe Text
merge_request_closed_at :: Maybe Text,
    MergeRequest -> Text
merge_request_created_at :: Text,
    MergeRequest -> Text
merge_request_updated_at :: Text,
    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 -> Int
merge_request_source_project_id :: Int,
    MergeRequest -> Int
merge_request_target_project_id :: Int,
    MergeRequest -> [Text]
merge_request_labels :: [Text],
    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,
    MergeRequest -> Text
merge_request_sha :: Text,
    MergeRequest -> Maybe Text
merge_request_merge_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 -> Text
merge_request_web_url :: Text,
    MergeRequest -> TimeStats
merge_request_time_stats :: TimeStats,
    MergeRequest -> Bool
merge_request_squash :: Bool,
    MergeRequest -> Maybe String
merge_request_changes_count :: Maybe String,
    MergeRequest -> Maybe Pipeline
merge_request_pipeline :: Maybe Pipeline,
    MergeRequest -> Maybe Int
merge_request_diverged_commits_count :: Maybe Int,
    MergeRequest -> Maybe Bool
merge_request_rebase_in_progress :: Maybe Bool,
    MergeRequest -> Bool
merge_request_has_conflicts :: Bool,
    MergeRequest -> Maybe Bool
merge_request_blocking_discussions_resolved :: Maybe Bool,
    MergeRequest -> Maybe Bool
merge_request_approvals_before_merge :: Maybe Bool -- ?
  }
  deriving ((forall x. MergeRequest -> Rep MergeRequest x)
-> (forall x. Rep MergeRequest x -> MergeRequest)
-> Generic MergeRequest
forall x. Rep MergeRequest x -> MergeRequest
forall x. MergeRequest -> Rep MergeRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergeRequest x -> MergeRequest
$cfrom :: forall x. MergeRequest -> Rep MergeRequest x
Generic, 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)

-- | TODO actions.
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)

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)

-- | 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)

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

-- | A project TODO.
data TodoProject = TP
  { TodoProject -> Int
tp_id :: Int,
    TodoProject -> Text
tp_description :: Text,
    TodoProject -> Text
tp_name :: Text,
    TodoProject -> Text
tp_name_with_namespace :: Text,
    TodoProject -> Text
tp_path :: Text,
    TodoProject -> Text
tp_path_with_namespace :: Text,
    TodoProject -> UTCTime
tp_created_at :: UTCTime
  }
  deriving ((forall x. TodoProject -> Rep TodoProject x)
-> (forall x. Rep TodoProject x -> TodoProject)
-> Generic TodoProject
forall x. Rep TodoProject x -> TodoProject
forall x. TodoProject -> Rep TodoProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TodoProject x -> TodoProject
$cfrom :: forall x. TodoProject -> Rep TodoProject x
Generic, 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)

instance FromJSON TodoProject where
  parseJSON :: Value -> Parser TodoProject
parseJSON = Options -> Value -> Parser TodoProject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3})

-- | 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 -> 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
  }
  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)

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
-> TodoTarget
-> Text
-> Text
-> TodoState
-> UTCTime
-> Todo
Todo
      (Int
 -> TodoProject
 -> User
 -> TodoAction
 -> TodoTarget
 -> Text
 -> Text
 -> TodoState
 -> UTCTime
 -> Todo)
-> Parser Int
-> Parser
     (TodoProject
      -> User
      -> TodoAction
      -> TodoTarget
      -> Text
      -> Text
      -> TodoState
      -> 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
   -> TodoTarget
   -> Text
   -> Text
   -> TodoState
   -> UTCTime
   -> Todo)
-> Parser TodoProject
-> Parser
     (User
      -> TodoAction
      -> TodoTarget
      -> Text
      -> Text
      -> TodoState
      -> 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
   -> TodoTarget
   -> Text
   -> Text
   -> TodoState
   -> UTCTime
   -> Todo)
-> Parser User
-> Parser
     (TodoAction
      -> TodoTarget -> Text -> Text -> TodoState -> 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
   -> TodoTarget -> Text -> Text -> TodoState -> UTCTime -> Todo)
-> Parser TodoAction
-> Parser
     (TodoTarget -> Text -> Text -> TodoState -> 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 (TodoTarget -> Text -> Text -> TodoState -> UTCTime -> Todo)
-> Parser TodoTarget
-> Parser (Text -> Text -> TodoState -> 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 -> Todo)
-> Parser Text -> Parser (Text -> TodoState -> 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 -> Todo)
-> Parser Text -> Parser (TodoState -> 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 -> Todo)
-> Parser TodoState -> Parser (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 -> Todo) -> Parser UTCTime -> Parser 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"

-- | version of the GitLab instance.
data Version = Version
  { Version -> Text
version :: Text,
    Version -> Text
revision :: Text
  }
  deriving ((forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic, 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)

-- | 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 Text
edit_issue_updated_at :: Maybe Text,
    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 ((forall x. EditIssueReq -> Rep EditIssueReq x)
-> (forall x. Rep EditIssueReq x -> EditIssueReq)
-> Generic EditIssueReq
forall x. Rep EditIssueReq x -> EditIssueReq
forall x. EditIssueReq -> Rep EditIssueReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditIssueReq x -> EditIssueReq
$cfrom :: forall x. EditIssueReq -> Rep EditIssueReq x
Generic, 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 ((forall x. Discussion -> Rep Discussion x)
-> (forall x. Rep Discussion x -> Discussion) -> Generic Discussion
forall x. Rep Discussion x -> Discussion
forall x. Discussion -> Rep Discussion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Discussion x -> Discussion
$cfrom :: forall x. Discussion -> Rep Discussion x
Generic, 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)

-- | Notes
data Note = Note
  { Note -> Int
note_id :: Int,
    -- 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 -> Text
note_body :: Text,
    Note -> Maybe Text
note_attachment :: Maybe Text,
    Note -> Owner
note_author :: Owner,
    --  -- TODO parse these as date type
    Note -> Text
note_created_at :: Text,
    Note -> Text
note_updated_at :: Text,
    Note -> Bool
note_system :: 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 -> Bool
note_resolvable :: Bool
  }
  deriving ((forall x. Note -> Rep Note x)
-> (forall x. Rep Note x -> Note) -> Generic Note
forall x. Rep Note x -> Note
forall x. Note -> Rep Note x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Note x -> Note
$cfrom :: forall x. Note -> Rep Note x
Generic, 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)

-- | Statistics and an issue
newtype IssueStatistics = IssueStatistics
  { IssueStatistics -> IssueStats
issues_statistics :: IssueStats
  }
  deriving ((forall x. IssueStatistics -> Rep IssueStatistics x)
-> (forall x. Rep IssueStatistics x -> IssueStatistics)
-> Generic IssueStatistics
forall x. Rep IssueStatistics x -> IssueStatistics
forall x. IssueStatistics -> Rep IssueStatistics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IssueStatistics x -> IssueStatistics
$cfrom :: forall x. IssueStatistics -> Rep IssueStatistics x
Generic, 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)

-- | Issue statistics
newtype IssueStats = IssueStats
  { IssueStats -> IssueCounts
issues_counts :: IssueCounts
  }
  deriving ((forall x. IssueStats -> Rep IssueStats x)
-> (forall x. Rep IssueStats x -> IssueStats) -> Generic IssueStats
forall x. Rep IssueStats x -> IssueStats
forall x. IssueStats -> Rep IssueStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IssueStats x -> IssueStats
$cfrom :: forall x. IssueStats -> Rep IssueStats x
Generic, 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)

-- | A count of all, open and closed issues against a project
data IssueCounts = IssueCounts
  { IssueCounts -> Int
issues_all :: Int,
    IssueCounts -> Int
issues_closed :: Int,
    IssueCounts -> Int
issues_opened :: Int
  }
  deriving ((forall x. IssueCounts -> Rep IssueCounts x)
-> (forall x. Rep IssueCounts x -> IssueCounts)
-> Generic IssueCounts
forall x. Rep IssueCounts x -> IssueCounts
forall x. IssueCounts -> Rep IssueCounts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IssueCounts x -> IssueCounts
$cfrom :: forall x. IssueCounts -> Rep IssueCounts x
Generic, 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)

-- | 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 -> ProjectBoard
board_project :: ProjectBoard,
    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 ((forall x. IssueBoard -> Rep IssueBoard x)
-> (forall x. Rep IssueBoard x -> IssueBoard) -> Generic IssueBoard
forall x. Rep IssueBoard x -> IssueBoard
forall x. IssueBoard -> Rep IssueBoard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IssueBoard x -> IssueBoard
$cfrom :: forall x. IssueBoard -> Rep IssueBoard x
Generic, 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 ((forall x. BoardIssue -> Rep BoardIssue x)
-> (forall x. Rep BoardIssue x -> BoardIssue) -> Generic BoardIssue
forall x. Rep BoardIssue x -> BoardIssue
forall x. BoardIssue -> Rep BoardIssue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BoardIssue x -> BoardIssue
$cfrom :: forall x. BoardIssue -> Rep BoardIssue x
Generic, 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 ((forall x. BoardIssueLabel -> Rep BoardIssueLabel x)
-> (forall x. Rep BoardIssueLabel x -> BoardIssueLabel)
-> Generic BoardIssueLabel
forall x. Rep BoardIssueLabel x -> BoardIssueLabel
forall x. BoardIssueLabel -> Rep BoardIssueLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BoardIssueLabel x -> BoardIssueLabel
$cfrom :: forall x. BoardIssueLabel -> Rep BoardIssueLabel x
Generic, 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)

-- | A project board
data ProjectBoard = ProjectBoard
  { ProjectBoard -> Int
project_board_id :: Int,
    ProjectBoard -> Text
project_board_name :: Text,
    ProjectBoard -> Text
project_board_name_with_namespace :: Text,
    ProjectBoard -> Text
project_board_path :: Text,
    ProjectBoard -> Text
project_board_path_with_namespace :: Text,
    ProjectBoard -> Text
project_board_http_url_to_repo :: Text,
    ProjectBoard -> Text
project_board_web_url :: Text
  }
  deriving ((forall x. ProjectBoard -> Rep ProjectBoard x)
-> (forall x. Rep ProjectBoard x -> ProjectBoard)
-> Generic ProjectBoard
forall x. Rep ProjectBoard x -> ProjectBoard
forall x. ProjectBoard -> Rep ProjectBoard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectBoard x -> ProjectBoard
$cfrom :: forall x. ProjectBoard -> Rep ProjectBoard x
Generic, Int -> ProjectBoard -> ShowS
[ProjectBoard] -> ShowS
ProjectBoard -> String
(Int -> ProjectBoard -> ShowS)
-> (ProjectBoard -> String)
-> ([ProjectBoard] -> ShowS)
-> Show ProjectBoard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectBoard] -> ShowS
$cshowList :: [ProjectBoard] -> ShowS
show :: ProjectBoard -> String
$cshow :: ProjectBoard -> String
showsPrec :: Int -> ProjectBoard -> ShowS
$cshowsPrec :: Int -> ProjectBoard -> ShowS
Show, ProjectBoard -> ProjectBoard -> Bool
(ProjectBoard -> ProjectBoard -> Bool)
-> (ProjectBoard -> ProjectBoard -> Bool) -> Eq ProjectBoard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectBoard -> ProjectBoard -> Bool
$c/= :: ProjectBoard -> ProjectBoard -> Bool
== :: ProjectBoard -> ProjectBoard -> Bool
$c== :: ProjectBoard -> ProjectBoard -> 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
total_time :: Double,
    TestReport -> Int
total_count :: Int,
    TestReport -> Int
success_count :: Int,
    TestReport -> Int
failed_count :: Int,
    TestReport -> Int
skipped_count :: Int,
    TestReport -> Int
error_count :: Int,
    TestReport -> [TestSuite]
test_suites :: [TestSuite]
  }
  deriving ((forall x. TestReport -> Rep TestReport x)
-> (forall x. Rep TestReport x -> TestReport) -> Generic TestReport
forall x. Rep TestReport x -> TestReport
forall x. TestReport -> Rep TestReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestReport x -> TestReport
$cfrom :: forall x. TestReport -> Rep TestReport x
Generic, 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 ((forall x. TestSuite -> Rep TestSuite x)
-> (forall x. Rep TestSuite x -> TestSuite) -> Generic TestSuite
forall x. Rep TestSuite x -> TestSuite
forall x. TestSuite -> Rep TestSuite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestSuite x -> TestSuite
$cfrom :: forall x. TestSuite -> Rep TestSuite x
Generic, 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)

testsuitePrefix :: String -> String
testsuitePrefix :: ShowS
testsuitePrefix String
"testsuite_name" = String
"name"
testsuitePrefix String
"testsuite_total_time" = String
"total_time"
testsuitePrefix String
"testsuite_success_count" = String
"success_count"
testsuitePrefix String
"testsuite_failed_count" = String
"failed_count"
testsuitePrefix String
"testsuite_skipped_count" = String
"skipped_count"
testsuitePrefix String
"testsuite_error_count" = String
"error_count"
testsuitePrefix String
"testsuite_test_cases" = String
"test_cases"
testsuitePrefix String
s = String
s

-- | 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 ((forall x. TestCase -> Rep TestCase x)
-> (forall x. Rep TestCase x -> TestCase) -> Generic TestCase
forall x. Rep TestCase x -> TestCase
forall x. TestCase -> Rep TestCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestCase x -> TestCase
$cfrom :: forall x. TestCase -> Rep TestCase x
Generic, 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)

testcasePrefix :: String -> String
testcasePrefix :: ShowS
testcasePrefix String
"testcase_status" = String
"status"
testcasePrefix String
"testcase_name" = String
"name"
testcasePrefix String
"testcase_classname" = String
"classname"
testcasePrefix String
"testcase_execution_time" = String
"execution_time"
testcasePrefix String
"testcase_system_output" = String
"system_output"
testcasePrefix String
"testcase_stack_trace" = String
"stack_trace"
testcasePrefix String
s = String
s

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

bodyNoPrefix :: String -> String
bodyNoPrefix :: ShowS
bodyNoPrefix String
"commit_created_at" = String
"created_at"
bodyNoPrefix String
"commit_id" = String
"id"
bodyNoPrefix String
"commit_status" = String
"status"
bodyNoPrefix String
"commit_parent_ids" = String
"parent_ids"
bodyNoPrefix String
"todo_commit_id" = String
"id"
bodyNoPrefix String
"todo_commit_short_id" = String
"short_id"
bodyNoPrefix String
"todo_commit_created_at" = String
"created_at"
bodyNoPrefix String
"todo_parent_ids" = String
"parent_ids"
bodyNoPrefix String
"issue_author" = String
"author"
bodyNoPrefix String
"issue_created_at" = String
"created_at"
bodyNoPrefix String
"issue_description" = String
"description"
bodyNoPrefix String
"issue_due_date" = String
"due_date"
bodyNoPrefix String
"issue_id" = String
"id"
bodyNoPrefix String
"issue_labels" = String
"labels"
bodyNoPrefix String
"issue_project_id" = String
"project_id"
bodyNoPrefix String
"issue_state" = String
"state"
bodyNoPrefix String
"issue_title" = String
"title"
bodyNoPrefix String
"issue_web_url" = String
"web_url"
bodyNoPrefix String
"link_events" = String
"events"
bodyNoPrefix String
"link_labels" = String
"labels"
bodyNoPrefix String
"member_avatar_url" = String
"avatar_url"
bodyNoPrefix String
"member_id" = String
"id"
bodyNoPrefix String
"member_name" = String
"name"
bodyNoPrefix String
"member_state" = String
"state"
bodyNoPrefix String
"member_username" = String
"username"
bodyNoPrefix String
"member_web_url" = String
"we_url"
bodyNoPrefix String
"namespace_id" = String
"id"
bodyNoPrefix String
"namespace_name" = String
"name"
bodyNoPrefix String
"namespace_path" = String
"path"
bodyNoPrefix String
"owner_avatar_url" = String
"avatar_url"
bodyNoPrefix String
"owner_id" = String
"id"
bodyNoPrefix String
"owner_name" = String
"name"
bodyNoPrefix String
"owner_username" = String
"username"
bodyNoPrefix String
"owner_web_url" = String
"web_url"
bodyNoPrefix String
"pipeline_id" = String
"id"
bodyNoPrefix String
"pipeline_status" = String
"status"
bodyNoPrefix String
"pipeline_web_url" = String
"web_url"
bodyNoPrefix String
"project_avatar_url" = String
"avatar_url"
bodyNoPrefix String
"project_created_at" = String
"created_at"
bodyNoPrefix String
"project_id" = String
"id"
bodyNoPrefix String
"project_name" = String
"name"
bodyNoPrefix String
"project_path" = String
"path"
bodyNoPrefix String
"project_path_with_namespace" = String
"path_with_namespace"
bodyNoPrefix String
"project_web_url" = String
"web_url"
bodyNoPrefix String
"repository_id" = String
"id"
bodyNoPrefix String
"repository_name" = String
"name"
bodyNoPrefix String
"repository_path" = String
"path"
bodyNoPrefix String
"repository_type" = String
"type"
bodyNoPrefix String
"user_avatar_uri" = String
"avatar_url"
bodyNoPrefix String
"user_id" = String
"id"
bodyNoPrefix String
"user_name" = String
"name"
bodyNoPrefix String
"user_state" = String
"state"
bodyNoPrefix String
"user_username" = String
"username"
bodyNoPrefix String
"user_web_url" = String
"web_url"
bodyNoPrefix String
"event_title" = String
"title"
bodyNoPrefix String
"event_project_id" = String
"project_id"
bodyNoPrefix String
"pipeline_ref" = String
"ref"
bodyNoPrefix String
"branch_name" = String
"name"
bodyNoPrefix String
"branch_default" = String
"default"
bodyNoPrefix String
"branch_commit" = String
"commit"
bodyNoPrefix String
"repository_file_file_name" = String
"file_name"
bodyNoPrefix String
"repository_file_file_path" = String
"file_path"
bodyNoPrefix String
"repository_file_size" = String
"size"
bodyNoPrefix String
"repository_file_commit_id" = String
"commit_id"
bodyNoPrefix String
"merge_request_id" = String
"id"
bodyNoPrefix String
"merge_request_iid" = String
"iid"
bodyNoPrefix String
"merge_request_project_id" = String
"project_id"
bodyNoPrefix String
"merge_request_title" = String
"title"
bodyNoPrefix String
"merge_request_description" = String
"description"
bodyNoPrefix String
"merge_request_state" = String
"state"
bodyNoPrefix String
"merge_request_merged_by" = String
"merged_by"
bodyNoPrefix String
"merge_request_merged_at" = String
"merged_at"
bodyNoPrefix String
"merge_request_closed_by" = String
"closed_by"
bodyNoPrefix String
"merge_request_closed_at" = String
"closed_at"
bodyNoPrefix String
"merge_request_created_at" = String
"created_at"
bodyNoPrefix String
"merge_request_updated_at" = String
"updated_at"
bodyNoPrefix String
"merge_request_target_branch" = String
"target_branch"
bodyNoPrefix String
"merge_request_source_branch" = String
"source_branch"
bodyNoPrefix String
"merge_request_upvotes" = String
"upvotes"
bodyNoPrefix String
"merge_request_downvotes" = String
"downvotes"
bodyNoPrefix String
"merge_request_author" = String
"author"
bodyNoPrefix String
"merge_request_assignee" = String
"assignee"
bodyNoPrefix String
"merge_request_source_project_id" = String
"source_project_id"
bodyNoPrefix String
"merge_request_target_project_id" = String
"target_project_id"
bodyNoPrefix String
"merge_request_labels" = String
"labels"
bodyNoPrefix String
"merge_request_work_in_progress" = String
"work_in_progress"
bodyNoPrefix String
"merge_request_milestone" = String
"milestone"
bodyNoPrefix String
"merge_request_merge_when_pipeline_succeeds" = String
"merge_when_pipeline_succeeds"
bodyNoPrefix String
"merge_request_merge_status" = String
"merge_status"
bodyNoPrefix String
"merge_request_sha" = String
"sha"
bodyNoPrefix String
"merge_request_merge_commit_sha" = String
"merge_commit_sha"
bodyNoPrefix String
"merge_request_user_notes_count" = String
"user_notes_count"
bodyNoPrefix String
"merge_request_discussion_locked" = String
"discussion_locked"
bodyNoPrefix String
"merge_request_should_remove_source_branch" = String
"should_remove_source_branch"
bodyNoPrefix String
"merge_request_force_remove_source_branch" = String
"force_remove_source_branch"
bodyNoPrefix String
"merge_request_allow_collaboration" = String
"allow_collaboration"
bodyNoPrefix String
"merge_request_allow_maintainer_to_push" = String
"allow_maintainer_to_push"
bodyNoPrefix String
"merge_request_web_url" = String
"web_url"
bodyNoPrefix String
"merge_request_time_stats" = String
"time_stats"
bodyNoPrefix String
"merge_request_squash" = String
"squash"
bodyNoPrefix String
"merge_request_approvals_before_merge" = String
"approvals_before_merge"
bodyNoPrefix String
"merge_request_allow_contribution" = String
"allow_contribution"
bodyNoPrefix String
"merge_request_changes_count" = String
"changes_count"
bodyNoPrefix String
"merge_request_pipeline" = String
"pipeline"
bodyNoPrefix String
"merge_request_diverged_commits_count" = String
"diverged_commits_count"
bodyNoPrefix String
"merge_request_rebase_in_progress" = String
"rebase_in_progress"
bodyNoPrefix String
"merge_request_has_conflicts" = String
"has_conflicts"
bodyNoPrefix String
"merge_request_blocking_discussions_resolved" = String
"blocking_discussions_resolved"
bodyNoPrefix String
"project_stats" = String
"statistics"
bodyNoPrefix String
"commit_stats" = String
"stats"
bodyNoPrefix String
"share_id" = String
"id"
bodyNoPrefix String
"share_project_id" = String
"project_id"
bodyNoPrefix String
"share_group_id" = String
"group_id"
bodyNoPrefix String
"share_group_access" = String
"group_access"
bodyNoPrefix String
"share_expires_at" = String
"expires_at"
bodyNoPrefix String
"group_id" = String
"id"
bodyNoPrefix String
"group_name" = String
"name"
bodyNoPrefix String
"group_path" = String
"path"
bodyNoPrefix String
"group_description" = String
"description"
bodyNoPrefix String
"group_visibility" = String
"visibility"
bodyNoPrefix String
"group_lfs_enabled" = String
"lfs_enabled"
bodyNoPrefix String
"group_avatar_url" = String
"avatar_url"
bodyNoPrefix String
"group_web_url" = String
"web_url"
bodyNoPrefix String
"group_request_access_enabled" = String
"request_access_enabled"
bodyNoPrefix String
"group_full_name" = String
"full_name"
bodyNoPrefix String
"group_full_path" = String
"full_path"
bodyNoPrefix String
"group_file_template_project_id" = String
"file_template_project_id"
bodyNoPrefix String
"group_parent_id" = String
"parent_id"
bodyNoPrefix String
"job_commit" = String
"commit"
bodyNoPrefix String
"job_coverage" = String
"coverage"
bodyNoPrefix String
"job_created_at" = String
"created_at"
bodyNoPrefix String
"job_started_at" = String
"started_at"
bodyNoPrefix String
"job_finished_at" = String
"finished_at"
bodyNoPrefix String
"job_duration" = String
"duration"
bodyNoPrefix String
"job_artifacts_expire_at" = String
"artifacts_expire_at"
bodyNoPrefix String
"job_id" = String
"id"
bodyNoPrefix String
"job_name" = String
"name"
bodyNoPrefix String
"job_pipeline" = String
"pipeline"
bodyNoPrefix String
"job_ref" = String
"ref"
bodyNoPrefix String
"job_artifacts" = String
"artifacts"
bodyNoPrefix String
"job_stage" = String
"stage"
bodyNoPrefix String
"job_status" = String
"status"
bodyNoPrefix String
"job_tag" = String
"tag"
bodyNoPrefix String
"job_web_url" = String
"web_url"
bodyNoPrefix String
"job_user" = String
"user"
bodyNoPrefix String
"discussion_id" = String
"id"
bodyNoPrefix String
"discussion_individual_note" = String
"individual_note"
bodyNoPrefix String
"discussion_notes" = String
"notes"
bodyNoPrefix String
"note_id" = String
"id"
bodyNoPrefix String
"note_type" = String
"type"
bodyNoPrefix String
"note_body" = String
"body"
bodyNoPrefix String
"note_attachment" = String
"attachment"
bodyNoPrefix String
"note_author" = String
"author"
bodyNoPrefix String
"note_created_at" = String
"created_at"
bodyNoPrefix String
"note_updated_at" = String
"updated_at"
bodyNoPrefix String
"note_system" = String
"system"
bodyNoPrefix String
"note_noteable_id" = String
"noteable_id"
bodyNoPrefix String
"note_noteable_type" = String
"noteable_type"
bodyNoPrefix String
"note_noteable_iid" = String
"iid"
bodyNoPrefix String
"note_resolvable" = String
"resolvable"
-- TODO field names for Issues data type
bodyNoPrefix String
s = String
s

-- TODO refactor bodyNoPrefix function above into smaller
--    String -> String
-- functions like those below.

tagPrefix :: String -> String
tagPrefix :: ShowS
tagPrefix String
"tag_commit" = String
"commit"
tagPrefix String
"tag_release" = String
"release"
tagPrefix String
"tag_name" = String
"name"
tagPrefix String
"tag_target" = String
"target"
tagPrefix String
"tag_message" = String
"message"
tagPrefix String
"tag_protected" = String
"protected"
tagPrefix String
s = String
s

releasePrefix :: String -> String
releasePrefix :: ShowS
releasePrefix String
"release_tag_name" = String
"tag_name"
releasePrefix String
"release_description" = String
"description"
releasePrefix String
s = String
s

issueStatsPrefix :: String -> String
issueStatsPrefix :: ShowS
issueStatsPrefix String
"issues_all" = String
"all"
issueStatsPrefix String
"issues_closed" = String
"closed"
issueStatsPrefix String
"issues_opened" = String
"opened"
issueStatsPrefix String
"issues_statistics" = String
"statistics"
issueStatsPrefix String
"issues_counts" = String
"counts"
issueStatsPrefix String
s = String
s

boardsPrefix :: String -> String
boardsPrefix :: ShowS
boardsPrefix String
"board_id" = String
"id"
boardsPrefix String
"board_name" = String
"name"
boardsPrefix String
"board_project" = String
"project"
boardsPrefix String
"board_milestone" = String
"milestone"
boardsPrefix String
"board_lists" = String
"lists"
boardsPrefix String
"board_issue_id" = String
"id"
boardsPrefix String
"board_issue_label" = String
"label"
boardsPrefix String
"board_issue_position" = String
"position"
boardsPrefix String
"board_issue_max_issue_count" = String
"max_issue_count"
boardsPrefix String
"board_issue_max_issue_weight" = String
"max_issue_weight"
boardsPrefix String
"board_issue_limit_metric" = String
"limit_metric"
boardsPrefix String
"board_issue_label_name" = String
"name"
boardsPrefix String
"board_issue_label_color" = String
"color"
boardsPrefix String
"board_issue_label_description" = String
"description"
boardsPrefix String
"project_board_id" = String
"id"
boardsPrefix String
"project_board_name" = String
"name"
boardsPrefix String
"project_board_name_with_namespace" = String
"name_with_namespace"
boardsPrefix String
"project_board_path" = String
"path"
boardsPrefix String
"project_board_path_with_namespace" = String
"path_with_namespace"
boardsPrefix String
"project_board_http_url_to_repo" = String
"http_url_to_repo"
boardsPrefix String
"project_board_web_url" = String
"web_url"
boardsPrefix String
s = String
s

instance FromJSON TimeStats where
  parseJSON :: Value -> Parser TimeStats
parseJSON =
    Options -> Value -> Parser TimeStats
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Issue where
  parseJSON :: Value -> Parser Issue
parseJSON =
    Options -> Value -> Parser Issue
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON =
    Options -> Value -> Parser User
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Commit where
  parseJSON :: Value -> Parser Commit
parseJSON =
    Options -> Value -> Parser Commit
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON CommitTodo where
  parseJSON :: Value -> Parser CommitTodo
parseJSON =
    Options -> Value -> Parser CommitTodo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Tag where
  parseJSON :: Value -> Parser Tag
parseJSON =
    Options -> Value -> Parser Tag
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
tagPrefix
          }
      )

instance FromJSON Release where
  parseJSON :: Value -> Parser Release
parseJSON =
    Options -> Value -> Parser Release
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
releasePrefix
          }
      )

instance FromJSON CommitStats where
  parseJSON :: Value -> Parser CommitStats
parseJSON =
    Options -> Value -> Parser CommitStats
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Pipeline where
  parseJSON :: Value -> Parser Pipeline
parseJSON =
    Options -> Value -> Parser Pipeline
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Member where
  parseJSON :: Value -> Parser Member
parseJSON =
    Options -> Value -> Parser Member
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Permissions where
  parseJSON :: Value -> Parser Permissions
parseJSON =
    Options -> Value -> Parser Permissions
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Owner where
  parseJSON :: Value -> Parser Owner
parseJSON =
    Options -> Value -> Parser Owner
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Links where
  parseJSON :: Value -> Parser Links
parseJSON =
    Options -> Value -> Parser Links
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Namespace where
  parseJSON :: Value -> Parser Namespace
parseJSON =
    Options -> Value -> Parser Namespace
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Project where
  parseJSON :: Value -> Parser Project
parseJSON =
    Options -> Value -> Parser Project
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON ProjectStats where
  parseJSON :: Value -> Parser ProjectStats
parseJSON =
    Options -> Value -> Parser ProjectStats
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Repository where
  parseJSON :: Value -> Parser Repository
parseJSON =
    Options -> Value -> Parser Repository
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Job where
  parseJSON :: Value -> Parser Job
parseJSON =
    Options -> Value -> Parser Job
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Artifact where
  parseJSON :: Value -> Parser Artifact
parseJSON =
    Options -> Value -> Parser Artifact
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Group where
  parseJSON :: Value -> Parser Group
parseJSON =
    Options -> Value -> Parser Group
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON GroupShare where
  parseJSON :: Value -> Parser GroupShare
parseJSON =
    Options -> Value -> Parser GroupShare
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Branch where
  parseJSON :: Value -> Parser Branch
parseJSON =
    Options -> Value -> Parser Branch
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON RepositoryFile where
  parseJSON :: Value -> Parser RepositoryFile
parseJSON =
    Options -> Value -> Parser RepositoryFile
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON MergeRequest where
  parseJSON :: Value -> Parser MergeRequest
parseJSON =
    Options -> Value -> Parser MergeRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Diff where
  parseJSON :: Value -> Parser Diff
parseJSON =
    Options -> Value -> Parser Diff
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON =
    Options -> Value -> Parser Version
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance ToJSON EditIssueReq where
  toEncoding :: EditIssueReq -> Encoding
toEncoding =
    Options -> EditIssueReq -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Text -> Int
T.length Text
"edit_issue_"),
          omitNothingFields :: Bool
omitNothingFields = Bool
True
        }

instance FromJSON Discussion where
  parseJSON :: Value -> Parser Discussion
parseJSON =
    Options -> Value -> Parser Discussion
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON Note where
  parseJSON :: Value -> Parser Note
parseJSON =
    Options -> Value -> Parser Note
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
bodyNoPrefix
          }
      )

instance FromJSON IssueCounts where
  parseJSON :: Value -> Parser IssueCounts
parseJSON =
    Options -> Value -> Parser IssueCounts
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
issueStatsPrefix
          }
      )

instance FromJSON IssueStats where
  parseJSON :: Value -> Parser IssueStats
parseJSON =
    Options -> Value -> Parser IssueStats
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
issueStatsPrefix
          }
      )

instance FromJSON IssueStatistics where
  parseJSON :: Value -> Parser IssueStatistics
parseJSON =
    Options -> Value -> Parser IssueStatistics
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
issueStatsPrefix
          }
      )

instance FromJSON IssueBoard where
  parseJSON :: Value -> Parser IssueBoard
parseJSON =
    Options -> Value -> Parser IssueBoard
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
boardsPrefix
          }
      )

instance FromJSON BoardIssue where
  parseJSON :: Value -> Parser BoardIssue
parseJSON =
    Options -> Value -> Parser BoardIssue
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
boardsPrefix
          }
      )

instance FromJSON BoardIssueLabel where
  parseJSON :: Value -> Parser BoardIssueLabel
parseJSON =
    Options -> Value -> Parser BoardIssueLabel
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
boardsPrefix
          }
      )

instance FromJSON ProjectBoard where
  parseJSON :: Value -> Parser ProjectBoard
parseJSON =
    Options -> Value -> Parser ProjectBoard
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
boardsPrefix
          }
      )

instance FromJSON TestReport where
  parseJSON :: Value -> Parser TestReport
parseJSON =
    Options -> Value -> Parser TestReport
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions

instance FromJSON TestSuite where
  parseJSON :: Value -> Parser TestSuite
parseJSON =
    Options -> Value -> Parser TestSuite
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
testsuitePrefix
          }
      )

instance FromJSON TestCase where
  parseJSON :: Value -> Parser TestCase
parseJSON =
    Options -> Value -> Parser TestCase
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      ( Options
defaultOptions
          { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
testcasePrefix
          }
      )