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

module GitHub.Data.Actions.Cache (
    Cache(..),
    RepositoryCacheUsage(..),
    OrganizationCacheUsage(..)
    ) where

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

import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount))

-------------------------------------------------------------------------------
-- Cache
-------------------------------------------------------------------------------

data Cache = Cache
    { Cache -> Id Cache
cacheId             :: !(Id Cache)
    , Cache -> Text
cacheRef            :: !Text
    , Cache -> Text
cacheKey            :: !Text
    , Cache -> Text
cacheVersion        :: !Text
    , Cache -> UTCTime
cacheLastAccessedAt :: !UTCTime
    , Cache -> UTCTime
cacheCreatedAt      :: !UTCTime
    , Cache -> Int
cacheSizeInBytes    :: !Int
    }
  deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cache -> ShowS
showsPrec :: Int -> Cache -> ShowS
$cshow :: Cache -> String
show :: Cache -> String
$cshowList :: [Cache] -> ShowS
showList :: [Cache] -> ShowS
Show, Typeable Cache
Typeable Cache =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Cache -> c Cache)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Cache)
-> (Cache -> Constr)
-> (Cache -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Cache))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cache))
-> ((forall b. Data b => b -> b) -> Cache -> Cache)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r)
-> (forall u. (forall d. Data d => d -> u) -> Cache -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Cache -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Cache -> m Cache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cache -> m Cache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cache -> m Cache)
-> Data Cache
Cache -> Constr
Cache -> DataType
(forall b. Data b => b -> b) -> Cache -> Cache
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) -> Cache -> u
forall u. (forall d. Data d => d -> u) -> Cache -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cache
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cache -> c Cache
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cache)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cache)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cache -> c Cache
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cache -> c Cache
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cache
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cache
$ctoConstr :: Cache -> Constr
toConstr :: Cache -> Constr
$cdataTypeOf :: Cache -> DataType
dataTypeOf :: Cache -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cache)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cache)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cache)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cache)
$cgmapT :: (forall b. Data b => b -> b) -> Cache -> Cache
gmapT :: (forall b. Data b => b -> b) -> Cache -> Cache
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cache -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cache -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Cache -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cache -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cache -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cache -> m Cache
Data, Typeable, Cache -> Cache -> Bool
(Cache -> Cache -> Bool) -> (Cache -> Cache -> Bool) -> Eq Cache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cache -> Cache -> Bool
== :: Cache -> Cache -> Bool
$c/= :: Cache -> Cache -> Bool
/= :: Cache -> Cache -> Bool
Eq, Eq Cache
Eq Cache =>
(Cache -> Cache -> Ordering)
-> (Cache -> Cache -> Bool)
-> (Cache -> Cache -> Bool)
-> (Cache -> Cache -> Bool)
-> (Cache -> Cache -> Bool)
-> (Cache -> Cache -> Cache)
-> (Cache -> Cache -> Cache)
-> Ord Cache
Cache -> Cache -> Bool
Cache -> Cache -> Ordering
Cache -> Cache -> Cache
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
$ccompare :: Cache -> Cache -> Ordering
compare :: Cache -> Cache -> Ordering
$c< :: Cache -> Cache -> Bool
< :: Cache -> Cache -> Bool
$c<= :: Cache -> Cache -> Bool
<= :: Cache -> Cache -> Bool
$c> :: Cache -> Cache -> Bool
> :: Cache -> Cache -> Bool
$c>= :: Cache -> Cache -> Bool
>= :: Cache -> Cache -> Bool
$cmax :: Cache -> Cache -> Cache
max :: Cache -> Cache -> Cache
$cmin :: Cache -> Cache -> Cache
min :: Cache -> Cache -> Cache
Ord, (forall x. Cache -> Rep Cache x)
-> (forall x. Rep Cache x -> Cache) -> Generic Cache
forall x. Rep Cache x -> Cache
forall x. Cache -> Rep Cache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cache -> Rep Cache x
from :: forall x. Cache -> Rep Cache x
$cto :: forall x. Rep Cache x -> Cache
to :: forall x. Rep Cache x -> Cache
Generic)

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

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

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

instance FromJSON Cache where
    parseJSON :: Value -> Parser Cache
parseJSON = String -> (Object -> Parser Cache) -> Value -> Parser Cache
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cache" ((Object -> Parser Cache) -> Value -> Parser Cache)
-> (Object -> Parser Cache) -> Value -> Parser Cache
forall a b. (a -> b) -> a -> b
$ \Object
o -> Id Cache
-> Text -> Text -> Text -> UTCTime -> UTCTime -> Int -> Cache
Cache
        (Id Cache
 -> Text -> Text -> Text -> UTCTime -> UTCTime -> Int -> Cache)
-> Parser (Id Cache)
-> Parser
     (Text -> Text -> Text -> UTCTime -> UTCTime -> Int -> Cache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Id Cache)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser (Text -> Text -> Text -> UTCTime -> UTCTime -> Int -> Cache)
-> Parser Text
-> Parser (Text -> Text -> UTCTime -> UTCTime -> Int -> Cache)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"
        Parser (Text -> Text -> UTCTime -> UTCTime -> Int -> Cache)
-> Parser Text
-> Parser (Text -> UTCTime -> UTCTime -> Int -> Cache)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
        Parser (Text -> UTCTime -> UTCTime -> Int -> Cache)
-> Parser Text -> Parser (UTCTime -> UTCTime -> Int -> Cache)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
        Parser (UTCTime -> UTCTime -> Int -> Cache)
-> Parser UTCTime -> Parser (UTCTime -> Int -> Cache)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last_accessed_at"
        Parser (UTCTime -> Int -> Cache)
-> Parser UTCTime -> Parser (Int -> Cache)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        Parser (Int -> Cache) -> Parser Int -> Parser Cache
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size_in_bytes"

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

instance FromJSON OrganizationCacheUsage where
    parseJSON :: Value -> Parser OrganizationCacheUsage
parseJSON = String
-> (Object -> Parser OrganizationCacheUsage)
-> Value
-> Parser OrganizationCacheUsage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OrganizationCacheUsage" ((Object -> Parser OrganizationCacheUsage)
 -> Value -> Parser OrganizationCacheUsage)
-> (Object -> Parser OrganizationCacheUsage)
-> Value
-> Parser OrganizationCacheUsage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> OrganizationCacheUsage
OrganizationCacheUsage
        (Int -> Int -> OrganizationCacheUsage)
-> Parser Int -> Parser (Int -> OrganizationCacheUsage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_active_caches_size_in_bytes"
        Parser (Int -> OrganizationCacheUsage)
-> Parser Int -> Parser OrganizationCacheUsage
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_active_caches_count"

instance FromJSON RepositoryCacheUsage where
    parseJSON :: Value -> Parser RepositoryCacheUsage
parseJSON = String
-> (Object -> Parser RepositoryCacheUsage)
-> Value
-> Parser RepositoryCacheUsage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RepositoryCacheUsage" ((Object -> Parser RepositoryCacheUsage)
 -> Value -> Parser RepositoryCacheUsage)
-> (Object -> Parser RepositoryCacheUsage)
-> Value
-> Parser RepositoryCacheUsage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Int -> Int -> RepositoryCacheUsage
RepositoryCacheUsage
        (Text -> Int -> Int -> RepositoryCacheUsage)
-> Parser Text -> Parser (Int -> Int -> RepositoryCacheUsage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"full_name"
        Parser (Int -> Int -> RepositoryCacheUsage)
-> Parser Int -> Parser (Int -> RepositoryCacheUsage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_caches_size_in_bytes"
        Parser (Int -> RepositoryCacheUsage)
-> Parser Int -> Parser RepositoryCacheUsage
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_caches_count"

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