{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.SourceHostingSite.SourceHostingSite where

import Hercules.API.Prelude

-- | A source hosting site (example github for github.com) used for
-- source code, permissions, CI statuses, ...
data SourceHostingSite = SourceHostingSite
  { SourceHostingSite -> Id SourceHostingSite
id :: Id SourceHostingSite,
    SourceHostingSite -> Name SourceHostingSite
slug :: Name SourceHostingSite,
    SourceHostingSite -> Text
displayName :: Text,
    SourceHostingSite -> Maybe Text
newInstallationURL :: Maybe Text
  }
  deriving ((forall x. SourceHostingSite -> Rep SourceHostingSite x)
-> (forall x. Rep SourceHostingSite x -> SourceHostingSite)
-> Generic SourceHostingSite
forall x. Rep SourceHostingSite x -> SourceHostingSite
forall x. SourceHostingSite -> Rep SourceHostingSite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceHostingSite x -> SourceHostingSite
$cfrom :: forall x. SourceHostingSite -> Rep SourceHostingSite x
Generic, Int -> SourceHostingSite -> ShowS
[SourceHostingSite] -> ShowS
SourceHostingSite -> String
(Int -> SourceHostingSite -> ShowS)
-> (SourceHostingSite -> String)
-> ([SourceHostingSite] -> ShowS)
-> Show SourceHostingSite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceHostingSite] -> ShowS
$cshowList :: [SourceHostingSite] -> ShowS
show :: SourceHostingSite -> String
$cshow :: SourceHostingSite -> String
showsPrec :: Int -> SourceHostingSite -> ShowS
$cshowsPrec :: Int -> SourceHostingSite -> ShowS
Show, SourceHostingSite -> SourceHostingSite -> Bool
(SourceHostingSite -> SourceHostingSite -> Bool)
-> (SourceHostingSite -> SourceHostingSite -> Bool)
-> Eq SourceHostingSite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceHostingSite -> SourceHostingSite -> Bool
$c/= :: SourceHostingSite -> SourceHostingSite -> Bool
== :: SourceHostingSite -> SourceHostingSite -> Bool
$c== :: SourceHostingSite -> SourceHostingSite -> Bool
Eq, SourceHostingSite -> ()
(SourceHostingSite -> ()) -> NFData SourceHostingSite
forall a. (a -> ()) -> NFData a
rnf :: SourceHostingSite -> ()
$crnf :: SourceHostingSite -> ()
NFData, [SourceHostingSite] -> Encoding
[SourceHostingSite] -> Value
SourceHostingSite -> Encoding
SourceHostingSite -> Value
(SourceHostingSite -> Value)
-> (SourceHostingSite -> Encoding)
-> ([SourceHostingSite] -> Value)
-> ([SourceHostingSite] -> Encoding)
-> ToJSON SourceHostingSite
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SourceHostingSite] -> Encoding
$ctoEncodingList :: [SourceHostingSite] -> Encoding
toJSONList :: [SourceHostingSite] -> Value
$ctoJSONList :: [SourceHostingSite] -> Value
toEncoding :: SourceHostingSite -> Encoding
$ctoEncoding :: SourceHostingSite -> Encoding
toJSON :: SourceHostingSite -> Value
$ctoJSON :: SourceHostingSite -> Value
ToJSON, Value -> Parser [SourceHostingSite]
Value -> Parser SourceHostingSite
(Value -> Parser SourceHostingSite)
-> (Value -> Parser [SourceHostingSite])
-> FromJSON SourceHostingSite
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SourceHostingSite]
$cparseJSONList :: Value -> Parser [SourceHostingSite]
parseJSON :: Value -> Parser SourceHostingSite
$cparseJSON :: Value -> Parser SourceHostingSite
FromJSON, Proxy SourceHostingSite -> Declare (Definitions Schema) NamedSchema
(Proxy SourceHostingSite
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SourceHostingSite
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy SourceHostingSite -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy SourceHostingSite -> Declare (Definitions Schema) NamedSchema
ToSchema)