{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Repos.Repo where

import Hercules.API.Accounts.Account (Account)
import Hercules.API.Prelude

-- | Information about a repository on a connected repository site such as github.
data Repo = Repo
  { Repo -> Id Repo
id :: Id Repo,
    Repo -> Id Account
ownerId :: Id Account,
    Repo -> Text
siteSlug :: Text,
    Repo -> Text
slug :: Text,
    Repo -> Text
displayName :: Text,
    Repo -> Maybe Text
imageURL :: Maybe Text,
    Repo -> Bool
isPublic :: Bool,
    Repo -> Maybe Text
defaultBranch :: Maybe Text,
    Repo -> Text
httpURL :: Text,
    Repo -> Text
sshURL :: Text,
    -- | An installed repo is one that Hercules has permission to.
    --
    -- A non-installed repo is one that is only visible because of the
    -- authenticated user's credentials.
    Repo -> Bool
isInstalled :: Bool,
    -- | Whether the authenticated user can grant permission to this
    --   repository
    Repo -> Bool
isInstallable :: Bool
  }
  deriving (forall x. Rep Repo x -> Repo
forall x. Repo -> Rep Repo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repo x -> Repo
$cfrom :: forall x. Repo -> Rep Repo x
Generic, Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repo] -> ShowS
$cshowList :: [Repo] -> ShowS
show :: Repo -> String
$cshow :: Repo -> String
showsPrec :: Int -> Repo -> ShowS
$cshowsPrec :: Int -> Repo -> ShowS
Show, Repo -> Repo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c== :: Repo -> Repo -> Bool
Eq, Repo -> ()
forall a. (a -> ()) -> NFData a
rnf :: Repo -> ()
$crnf :: Repo -> ()
NFData, [Repo] -> Encoding
[Repo] -> Value
Repo -> Encoding
Repo -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Repo] -> Encoding
$ctoEncodingList :: [Repo] -> Encoding
toJSONList :: [Repo] -> Value
$ctoJSONList :: [Repo] -> Value
toEncoding :: Repo -> Encoding
$ctoEncoding :: Repo -> Encoding
toJSON :: Repo -> Value
$ctoJSON :: Repo -> Value
ToJSON, Value -> Parser [Repo]
Value -> Parser Repo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Repo]
$cparseJSONList :: Value -> Parser [Repo]
parseJSON :: Value -> Parser Repo
$cparseJSON :: Value -> Parser Repo
FromJSON, Proxy Repo -> Declare (Definitions Schema) NamedSchema
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy Repo -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy Repo -> Declare (Definitions Schema) NamedSchema
ToSchema)