{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures    #-}

module GitHub.Data.Actions.Artifacts (
    Artifact(..),
    ArtifactWorkflowRun(..),
    ) where

import GitHub.Data.Id          (Id)
import GitHub.Data.URL         (URL)
import GitHub.Internal.Prelude
import Prelude ()

import GitHub.Data.Actions.Common       (WithTotalCount (WithTotalCount))
import GitHub.Data.Actions.WorkflowRuns (WorkflowRun)
import GitHub.Data.Repos                (Repo)

-------------------------------------------------------------------------------
-- Artifact
-------------------------------------------------------------------------------

data ArtifactWorkflowRun  = ArtifactWorkflowRun
    { ArtifactWorkflowRun -> Id WorkflowRun
artifactWorkflowRunWorkflowRunId    :: !(Id WorkflowRun)
    , ArtifactWorkflowRun -> Id Repo
artifactWorkflowRunRepositoryId     :: !(Id Repo)
    , ArtifactWorkflowRun -> Id Repo
artifactWorkflowRunHeadRepositoryId :: !(Id Repo)
    , ArtifactWorkflowRun -> Text
artifactWorkflowRunHeadBranch       :: !Text
    , ArtifactWorkflowRun -> Text
artifactWorkflowRunHeadSha          :: !Text
    }
  deriving (Int -> ArtifactWorkflowRun -> ShowS
[ArtifactWorkflowRun] -> ShowS
ArtifactWorkflowRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactWorkflowRun] -> ShowS
$cshowList :: [ArtifactWorkflowRun] -> ShowS
show :: ArtifactWorkflowRun -> String
$cshow :: ArtifactWorkflowRun -> String
showsPrec :: Int -> ArtifactWorkflowRun -> ShowS
$cshowsPrec :: Int -> ArtifactWorkflowRun -> ShowS
Show, Typeable ArtifactWorkflowRun
ArtifactWorkflowRun -> DataType
ArtifactWorkflowRun -> Constr
(forall b. Data b => b -> b)
-> ArtifactWorkflowRun -> ArtifactWorkflowRun
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactWorkflowRun -> u
forall u.
(forall d. Data d => d -> u) -> ArtifactWorkflowRun -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactWorkflowRun -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactWorkflowRun -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactWorkflowRun
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ArtifactWorkflowRun
-> c ArtifactWorkflowRun
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactWorkflowRun)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactWorkflowRun)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactWorkflowRun -> m ArtifactWorkflowRun
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactWorkflowRun -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactWorkflowRun -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ArtifactWorkflowRun -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ArtifactWorkflowRun -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactWorkflowRun -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactWorkflowRun -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactWorkflowRun -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactWorkflowRun -> r
gmapT :: (forall b. Data b => b -> b)
-> ArtifactWorkflowRun -> ArtifactWorkflowRun
$cgmapT :: (forall b. Data b => b -> b)
-> ArtifactWorkflowRun -> ArtifactWorkflowRun
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactWorkflowRun)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactWorkflowRun)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactWorkflowRun)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactWorkflowRun)
dataTypeOf :: ArtifactWorkflowRun -> DataType
$cdataTypeOf :: ArtifactWorkflowRun -> DataType
toConstr :: ArtifactWorkflowRun -> Constr
$ctoConstr :: ArtifactWorkflowRun -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactWorkflowRun
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactWorkflowRun
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ArtifactWorkflowRun
-> c ArtifactWorkflowRun
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ArtifactWorkflowRun
-> c ArtifactWorkflowRun
Data, Typeable, ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
$c/= :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
== :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
$c== :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
Eq, Eq ArtifactWorkflowRun
ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
ArtifactWorkflowRun -> ArtifactWorkflowRun -> Ordering
ArtifactWorkflowRun -> ArtifactWorkflowRun -> ArtifactWorkflowRun
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> ArtifactWorkflowRun
$cmin :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> ArtifactWorkflowRun
max :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> ArtifactWorkflowRun
$cmax :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> ArtifactWorkflowRun
>= :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
$c>= :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
> :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
$c> :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
<= :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
$c<= :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
< :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
$c< :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Bool
compare :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Ordering
$ccompare :: ArtifactWorkflowRun -> ArtifactWorkflowRun -> Ordering
Ord, forall x. Rep ArtifactWorkflowRun x -> ArtifactWorkflowRun
forall x. ArtifactWorkflowRun -> Rep ArtifactWorkflowRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArtifactWorkflowRun x -> ArtifactWorkflowRun
$cfrom :: forall x. ArtifactWorkflowRun -> Rep ArtifactWorkflowRun x
Generic)

data Artifact = Artifact
    { Artifact -> URL
artifactArchiveDownloadUrl :: !URL
    , Artifact -> UTCTime
artifactCreatedAt          :: !UTCTime
    , Artifact -> Bool
artifactExpired            :: !Bool
    , Artifact -> UTCTime
artifactExpiresAt          :: !UTCTime
    , Artifact -> Id Artifact
artifactId                 :: !(Id Artifact)
    , Artifact -> Text
artifactName               :: !Text
    , Artifact -> Text
artifactNodeId             :: !Text
    , Artifact -> Int
artifactSizeInBytes        :: !Int
    , Artifact -> UTCTime
artifactUpdatedAt          :: !UTCTime
    , Artifact -> URL
artifactUrl                :: !URL
    , Artifact -> ArtifactWorkflowRun
artifactWorkflowRun        :: !ArtifactWorkflowRun
    }
  deriving (Int -> Artifact -> ShowS
[Artifact] -> ShowS
Artifact -> String
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, Typeable Artifact
Artifact -> DataType
Artifact -> Constr
(forall b. Data b => b -> b) -> Artifact -> Artifact
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Artifact -> u
forall u. (forall d. Data d => d -> u) -> Artifact -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Artifact -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Artifact -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Artifact
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Artifact -> c Artifact
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Artifact)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Artifact)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Artifact -> m Artifact
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Artifact -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Artifact -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Artifact -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Artifact -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Artifact -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Artifact -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Artifact -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Artifact -> r
gmapT :: (forall b. Data b => b -> b) -> Artifact -> Artifact
$cgmapT :: (forall b. Data b => b -> b) -> Artifact -> Artifact
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Artifact)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Artifact)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Artifact)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Artifact)
dataTypeOf :: Artifact -> DataType
$cdataTypeOf :: Artifact -> DataType
toConstr :: Artifact -> Constr
$ctoConstr :: Artifact -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Artifact
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Artifact
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Artifact -> c Artifact
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Artifact -> c Artifact
Data, Typeable, Artifact -> Artifact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Artifact -> Artifact -> Bool
$c/= :: Artifact -> Artifact -> Bool
== :: Artifact -> Artifact -> Bool
$c== :: Artifact -> Artifact -> Bool
Eq, Eq Artifact
Artifact -> Artifact -> Bool
Artifact -> Artifact -> Ordering
Artifact -> Artifact -> Artifact
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Artifact -> Artifact -> Artifact
$cmin :: Artifact -> Artifact -> Artifact
max :: Artifact -> Artifact -> Artifact
$cmax :: Artifact -> Artifact -> Artifact
>= :: Artifact -> Artifact -> Bool
$c>= :: Artifact -> Artifact -> Bool
> :: Artifact -> Artifact -> Bool
$c> :: Artifact -> Artifact -> Bool
<= :: Artifact -> Artifact -> Bool
$c<= :: Artifact -> Artifact -> Bool
< :: Artifact -> Artifact -> Bool
$c< :: Artifact -> Artifact -> Bool
compare :: Artifact -> Artifact -> Ordering
$ccompare :: Artifact -> Artifact -> Ordering
Ord, 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)

-------------------------------------------------------------------------------
-- JSON instances
-------------------------------------------------------------------------------

instance FromJSON ArtifactWorkflowRun where
    parseJSON :: Value -> Parser ArtifactWorkflowRun
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ArtifactWorkflowRun" forall a b. (a -> b) -> a -> b
$ \Object
o -> Id WorkflowRun
-> Id Repo -> Id Repo -> Text -> Text -> ArtifactWorkflowRun
ArtifactWorkflowRun
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_repository_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_branch"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_sha"

instance FromJSON Artifact where
    parseJSON :: Value -> Parser Artifact
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Artifact" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> UTCTime
-> Bool
-> UTCTime
-> Id Artifact
-> Text
-> Text
-> Int
-> UTCTime
-> URL
-> ArtifactWorkflowRun
-> Artifact
Artifact
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"archive_download_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expired"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expires_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size_in_bytes"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"workflow_run"

instance FromJSON (WithTotalCount Artifact) where
    parseJSON :: Value -> Parser (WithTotalCount Artifact)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ArtifactList" forall a b. (a -> b) -> a -> b
$ \Object
o -> forall a. Vector a -> Int -> WithTotalCount a
WithTotalCount
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"artifacts"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_count"