{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- |
-- Module      : Gogol.URLShortener.Internal.Product
-- Copyright   : (c) 2015-2025 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+gogol@gmail.com>
--               Toni Cebrián <toni@tonicebrian.com>
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Gogol.URLShortener.Internal.Product
  ( -- * AnalyticsSnapshot
    AnalyticsSnapshot (..),
    newAnalyticsSnapshot,

    -- * AnalyticsSummary
    AnalyticsSummary (..),
    newAnalyticsSummary,

    -- * StringCount
    StringCount (..),
    newStringCount,

    -- * Url
    Url (..),
    newUrl,

    -- * UrlHistory
    UrlHistory (..),
    newUrlHistory,
  )
where

import Gogol.Prelude qualified as Core
import Gogol.URLShortener.Internal.Sum

--
-- /See:/ 'newAnalyticsSnapshot' smart constructor.
data AnalyticsSnapshot = AnalyticsSnapshot
  { -- | Top browsers, e.g. \"Chrome\"; sorted by (descending) click counts. Only present if this data is available.
    AnalyticsSnapshot -> Maybe [StringCount]
browsers :: (Core.Maybe [StringCount]),
    -- | Top countries (expressed as country codes), e.g. \"US\" or \"DE\"; sorted by (descending) click counts. Only present if this data is available.
    AnalyticsSnapshot -> Maybe [StringCount]
countries :: (Core.Maybe [StringCount]),
    -- | Number of clicks on all goo.gl short URLs pointing to this long URL.
    AnalyticsSnapshot -> Maybe Int64
longUrlClicks :: (Core.Maybe Core.Int64),
    -- | Top platforms or OSes, e.g. \"Windows\"; sorted by (descending) click counts. Only present if this data is available.
    AnalyticsSnapshot -> Maybe [StringCount]
platforms :: (Core.Maybe [StringCount]),
    -- | Top referring hosts, e.g. \"www.google.com\"; sorted by (descending) click counts. Only present if this data is available.
    AnalyticsSnapshot -> Maybe [StringCount]
referrers :: (Core.Maybe [StringCount]),
    -- | Number of clicks on this short URL.
    AnalyticsSnapshot -> Maybe Int64
shortUrlClicks :: (Core.Maybe Core.Int64)
  }
  deriving (AnalyticsSnapshot -> AnalyticsSnapshot -> Bool
(AnalyticsSnapshot -> AnalyticsSnapshot -> Bool)
-> (AnalyticsSnapshot -> AnalyticsSnapshot -> Bool)
-> Eq AnalyticsSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnalyticsSnapshot -> AnalyticsSnapshot -> Bool
== :: AnalyticsSnapshot -> AnalyticsSnapshot -> Bool
$c/= :: AnalyticsSnapshot -> AnalyticsSnapshot -> Bool
/= :: AnalyticsSnapshot -> AnalyticsSnapshot -> Bool
Core.Eq, Int -> AnalyticsSnapshot -> ShowS
[AnalyticsSnapshot] -> ShowS
AnalyticsSnapshot -> String
(Int -> AnalyticsSnapshot -> ShowS)
-> (AnalyticsSnapshot -> String)
-> ([AnalyticsSnapshot] -> ShowS)
-> Show AnalyticsSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnalyticsSnapshot -> ShowS
showsPrec :: Int -> AnalyticsSnapshot -> ShowS
$cshow :: AnalyticsSnapshot -> String
show :: AnalyticsSnapshot -> String
$cshowList :: [AnalyticsSnapshot] -> ShowS
showList :: [AnalyticsSnapshot] -> ShowS
Core.Show, (forall x. AnalyticsSnapshot -> Rep AnalyticsSnapshot x)
-> (forall x. Rep AnalyticsSnapshot x -> AnalyticsSnapshot)
-> Generic AnalyticsSnapshot
forall x. Rep AnalyticsSnapshot x -> AnalyticsSnapshot
forall x. AnalyticsSnapshot -> Rep AnalyticsSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnalyticsSnapshot -> Rep AnalyticsSnapshot x
from :: forall x. AnalyticsSnapshot -> Rep AnalyticsSnapshot x
$cto :: forall x. Rep AnalyticsSnapshot x -> AnalyticsSnapshot
to :: forall x. Rep AnalyticsSnapshot x -> AnalyticsSnapshot
Core.Generic)

-- | Creates a value of 'AnalyticsSnapshot' with the minimum fields required to make a request.
newAnalyticsSnapshot ::
  AnalyticsSnapshot
newAnalyticsSnapshot :: AnalyticsSnapshot
newAnalyticsSnapshot =
  AnalyticsSnapshot
    { browsers :: Maybe [StringCount]
browsers = Maybe [StringCount]
forall a. Maybe a
Core.Nothing,
      countries :: Maybe [StringCount]
countries = Maybe [StringCount]
forall a. Maybe a
Core.Nothing,
      longUrlClicks :: Maybe Int64
longUrlClicks = Maybe Int64
forall a. Maybe a
Core.Nothing,
      platforms :: Maybe [StringCount]
platforms = Maybe [StringCount]
forall a. Maybe a
Core.Nothing,
      referrers :: Maybe [StringCount]
referrers = Maybe [StringCount]
forall a. Maybe a
Core.Nothing,
      shortUrlClicks :: Maybe Int64
shortUrlClicks = Maybe Int64
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON AnalyticsSnapshot where
  parseJSON :: Value -> Parser AnalyticsSnapshot
parseJSON =
    String
-> (Object -> Parser AnalyticsSnapshot)
-> Value
-> Parser AnalyticsSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AnalyticsSnapshot"
      ( \Object
o ->
          Maybe [StringCount]
-> Maybe [StringCount]
-> Maybe Int64
-> Maybe [StringCount]
-> Maybe [StringCount]
-> Maybe Int64
-> AnalyticsSnapshot
AnalyticsSnapshot
            (Maybe [StringCount]
 -> Maybe [StringCount]
 -> Maybe Int64
 -> Maybe [StringCount]
 -> Maybe [StringCount]
 -> Maybe Int64
 -> AnalyticsSnapshot)
-> Parser (Maybe [StringCount])
-> Parser
     (Maybe [StringCount]
      -> Maybe Int64
      -> Maybe [StringCount]
      -> Maybe [StringCount]
      -> Maybe Int64
      -> AnalyticsSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [StringCount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"browsers")
            Parser
  (Maybe [StringCount]
   -> Maybe Int64
   -> Maybe [StringCount]
   -> Maybe [StringCount]
   -> Maybe Int64
   -> AnalyticsSnapshot)
-> Parser (Maybe [StringCount])
-> Parser
     (Maybe Int64
      -> Maybe [StringCount]
      -> Maybe [StringCount]
      -> Maybe Int64
      -> AnalyticsSnapshot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [StringCount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"countries")
            Parser
  (Maybe Int64
   -> Maybe [StringCount]
   -> Maybe [StringCount]
   -> Maybe Int64
   -> AnalyticsSnapshot)
-> Parser (Maybe Int64)
-> Parser
     (Maybe [StringCount]
      -> Maybe [StringCount] -> Maybe Int64 -> AnalyticsSnapshot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"longUrlClicks" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
            Parser
  (Maybe [StringCount]
   -> Maybe [StringCount] -> Maybe Int64 -> AnalyticsSnapshot)
-> Parser (Maybe [StringCount])
-> Parser (Maybe [StringCount] -> Maybe Int64 -> AnalyticsSnapshot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [StringCount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"platforms")
            Parser (Maybe [StringCount] -> Maybe Int64 -> AnalyticsSnapshot)
-> Parser (Maybe [StringCount])
-> Parser (Maybe Int64 -> AnalyticsSnapshot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe [StringCount])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"referrers")
            Parser (Maybe Int64 -> AnalyticsSnapshot)
-> Parser (Maybe Int64) -> Parser AnalyticsSnapshot
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"shortUrlClicks" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
      )

instance Core.ToJSON AnalyticsSnapshot where
  toJSON :: AnalyticsSnapshot -> Value
toJSON AnalyticsSnapshot {Maybe Int64
Maybe [StringCount]
browsers :: AnalyticsSnapshot -> Maybe [StringCount]
countries :: AnalyticsSnapshot -> Maybe [StringCount]
longUrlClicks :: AnalyticsSnapshot -> Maybe Int64
platforms :: AnalyticsSnapshot -> Maybe [StringCount]
referrers :: AnalyticsSnapshot -> Maybe [StringCount]
shortUrlClicks :: AnalyticsSnapshot -> Maybe Int64
browsers :: Maybe [StringCount]
countries :: Maybe [StringCount]
longUrlClicks :: Maybe Int64
platforms :: Maybe [StringCount]
referrers :: Maybe [StringCount]
shortUrlClicks :: Maybe Int64
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"browsers" Core..=) ([StringCount] -> Pair) -> Maybe [StringCount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [StringCount]
browsers,
            (Key
"countries" Core..=) ([StringCount] -> Pair) -> Maybe [StringCount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [StringCount]
countries,
            (Key
"longUrlClicks" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
longUrlClicks,
            (Key
"platforms" Core..=) ([StringCount] -> Pair) -> Maybe [StringCount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [StringCount]
platforms,
            (Key
"referrers" Core..=) ([StringCount] -> Pair) -> Maybe [StringCount] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [StringCount]
referrers,
            (Key
"shortUrlClicks" Core..=)
              (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText
              (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
shortUrlClicks
          ]
      )

--
-- /See:/ 'newAnalyticsSummary' smart constructor.
data AnalyticsSummary = AnalyticsSummary
  { -- | Click analytics over all time.
    AnalyticsSummary -> Maybe AnalyticsSnapshot
allTime :: (Core.Maybe AnalyticsSnapshot),
    -- | Click analytics over the last day.
    AnalyticsSummary -> Maybe AnalyticsSnapshot
day :: (Core.Maybe AnalyticsSnapshot),
    -- | Click analytics over the last month.
    AnalyticsSummary -> Maybe AnalyticsSnapshot
month :: (Core.Maybe AnalyticsSnapshot),
    -- | Click analytics over the last two hours.
    AnalyticsSummary -> Maybe AnalyticsSnapshot
twoHours :: (Core.Maybe AnalyticsSnapshot),
    -- | Click analytics over the last week.
    AnalyticsSummary -> Maybe AnalyticsSnapshot
week :: (Core.Maybe AnalyticsSnapshot)
  }
  deriving (AnalyticsSummary -> AnalyticsSummary -> Bool
(AnalyticsSummary -> AnalyticsSummary -> Bool)
-> (AnalyticsSummary -> AnalyticsSummary -> Bool)
-> Eq AnalyticsSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnalyticsSummary -> AnalyticsSummary -> Bool
== :: AnalyticsSummary -> AnalyticsSummary -> Bool
$c/= :: AnalyticsSummary -> AnalyticsSummary -> Bool
/= :: AnalyticsSummary -> AnalyticsSummary -> Bool
Core.Eq, Int -> AnalyticsSummary -> ShowS
[AnalyticsSummary] -> ShowS
AnalyticsSummary -> String
(Int -> AnalyticsSummary -> ShowS)
-> (AnalyticsSummary -> String)
-> ([AnalyticsSummary] -> ShowS)
-> Show AnalyticsSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnalyticsSummary -> ShowS
showsPrec :: Int -> AnalyticsSummary -> ShowS
$cshow :: AnalyticsSummary -> String
show :: AnalyticsSummary -> String
$cshowList :: [AnalyticsSummary] -> ShowS
showList :: [AnalyticsSummary] -> ShowS
Core.Show, (forall x. AnalyticsSummary -> Rep AnalyticsSummary x)
-> (forall x. Rep AnalyticsSummary x -> AnalyticsSummary)
-> Generic AnalyticsSummary
forall x. Rep AnalyticsSummary x -> AnalyticsSummary
forall x. AnalyticsSummary -> Rep AnalyticsSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnalyticsSummary -> Rep AnalyticsSummary x
from :: forall x. AnalyticsSummary -> Rep AnalyticsSummary x
$cto :: forall x. Rep AnalyticsSummary x -> AnalyticsSummary
to :: forall x. Rep AnalyticsSummary x -> AnalyticsSummary
Core.Generic)

-- | Creates a value of 'AnalyticsSummary' with the minimum fields required to make a request.
newAnalyticsSummary ::
  AnalyticsSummary
newAnalyticsSummary :: AnalyticsSummary
newAnalyticsSummary =
  AnalyticsSummary
    { allTime :: Maybe AnalyticsSnapshot
allTime = Maybe AnalyticsSnapshot
forall a. Maybe a
Core.Nothing,
      day :: Maybe AnalyticsSnapshot
day = Maybe AnalyticsSnapshot
forall a. Maybe a
Core.Nothing,
      month :: Maybe AnalyticsSnapshot
month = Maybe AnalyticsSnapshot
forall a. Maybe a
Core.Nothing,
      twoHours :: Maybe AnalyticsSnapshot
twoHours = Maybe AnalyticsSnapshot
forall a. Maybe a
Core.Nothing,
      week :: Maybe AnalyticsSnapshot
week = Maybe AnalyticsSnapshot
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON AnalyticsSummary where
  parseJSON :: Value -> Parser AnalyticsSummary
parseJSON =
    String
-> (Object -> Parser AnalyticsSummary)
-> Value
-> Parser AnalyticsSummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"AnalyticsSummary"
      ( \Object
o ->
          Maybe AnalyticsSnapshot
-> Maybe AnalyticsSnapshot
-> Maybe AnalyticsSnapshot
-> Maybe AnalyticsSnapshot
-> Maybe AnalyticsSnapshot
-> AnalyticsSummary
AnalyticsSummary
            (Maybe AnalyticsSnapshot
 -> Maybe AnalyticsSnapshot
 -> Maybe AnalyticsSnapshot
 -> Maybe AnalyticsSnapshot
 -> Maybe AnalyticsSnapshot
 -> AnalyticsSummary)
-> Parser (Maybe AnalyticsSnapshot)
-> Parser
     (Maybe AnalyticsSnapshot
      -> Maybe AnalyticsSnapshot
      -> Maybe AnalyticsSnapshot
      -> Maybe AnalyticsSnapshot
      -> AnalyticsSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe AnalyticsSnapshot)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"allTime")
            Parser
  (Maybe AnalyticsSnapshot
   -> Maybe AnalyticsSnapshot
   -> Maybe AnalyticsSnapshot
   -> Maybe AnalyticsSnapshot
   -> AnalyticsSummary)
-> Parser (Maybe AnalyticsSnapshot)
-> Parser
     (Maybe AnalyticsSnapshot
      -> Maybe AnalyticsSnapshot
      -> Maybe AnalyticsSnapshot
      -> AnalyticsSummary)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe AnalyticsSnapshot)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"day")
            Parser
  (Maybe AnalyticsSnapshot
   -> Maybe AnalyticsSnapshot
   -> Maybe AnalyticsSnapshot
   -> AnalyticsSummary)
-> Parser (Maybe AnalyticsSnapshot)
-> Parser
     (Maybe AnalyticsSnapshot
      -> Maybe AnalyticsSnapshot -> AnalyticsSummary)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe AnalyticsSnapshot)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"month")
            Parser
  (Maybe AnalyticsSnapshot
   -> Maybe AnalyticsSnapshot -> AnalyticsSummary)
-> Parser (Maybe AnalyticsSnapshot)
-> Parser (Maybe AnalyticsSnapshot -> AnalyticsSummary)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe AnalyticsSnapshot)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"twoHours")
            Parser (Maybe AnalyticsSnapshot -> AnalyticsSummary)
-> Parser (Maybe AnalyticsSnapshot) -> Parser AnalyticsSummary
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe AnalyticsSnapshot)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"week")
      )

instance Core.ToJSON AnalyticsSummary where
  toJSON :: AnalyticsSummary -> Value
toJSON AnalyticsSummary {Maybe AnalyticsSnapshot
allTime :: AnalyticsSummary -> Maybe AnalyticsSnapshot
day :: AnalyticsSummary -> Maybe AnalyticsSnapshot
month :: AnalyticsSummary -> Maybe AnalyticsSnapshot
twoHours :: AnalyticsSummary -> Maybe AnalyticsSnapshot
week :: AnalyticsSummary -> Maybe AnalyticsSnapshot
allTime :: Maybe AnalyticsSnapshot
day :: Maybe AnalyticsSnapshot
month :: Maybe AnalyticsSnapshot
twoHours :: Maybe AnalyticsSnapshot
week :: Maybe AnalyticsSnapshot
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"allTime" Core..=) (AnalyticsSnapshot -> Pair)
-> Maybe AnalyticsSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AnalyticsSnapshot
allTime,
            (Key
"day" Core..=) (AnalyticsSnapshot -> Pair)
-> Maybe AnalyticsSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AnalyticsSnapshot
day,
            (Key
"month" Core..=) (AnalyticsSnapshot -> Pair)
-> Maybe AnalyticsSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AnalyticsSnapshot
month,
            (Key
"twoHours" Core..=) (AnalyticsSnapshot -> Pair)
-> Maybe AnalyticsSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AnalyticsSnapshot
twoHours,
            (Key
"week" Core..=) (AnalyticsSnapshot -> Pair)
-> Maybe AnalyticsSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AnalyticsSnapshot
week
          ]
      )

--
-- /See:/ 'newStringCount' smart constructor.
data StringCount = StringCount
  { -- | Number of clicks for this top entry, e.g. for this particular country or browser.
    StringCount -> Maybe Int64
count :: (Core.Maybe Core.Int64),
    -- | Label assigned to this top entry, e.g. \"US\" or \"Chrome\".
    StringCount -> Maybe Text
id :: (Core.Maybe Core.Text)
  }
  deriving (StringCount -> StringCount -> Bool
(StringCount -> StringCount -> Bool)
-> (StringCount -> StringCount -> Bool) -> Eq StringCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StringCount -> StringCount -> Bool
== :: StringCount -> StringCount -> Bool
$c/= :: StringCount -> StringCount -> Bool
/= :: StringCount -> StringCount -> Bool
Core.Eq, Int -> StringCount -> ShowS
[StringCount] -> ShowS
StringCount -> String
(Int -> StringCount -> ShowS)
-> (StringCount -> String)
-> ([StringCount] -> ShowS)
-> Show StringCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StringCount -> ShowS
showsPrec :: Int -> StringCount -> ShowS
$cshow :: StringCount -> String
show :: StringCount -> String
$cshowList :: [StringCount] -> ShowS
showList :: [StringCount] -> ShowS
Core.Show, (forall x. StringCount -> Rep StringCount x)
-> (forall x. Rep StringCount x -> StringCount)
-> Generic StringCount
forall x. Rep StringCount x -> StringCount
forall x. StringCount -> Rep StringCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StringCount -> Rep StringCount x
from :: forall x. StringCount -> Rep StringCount x
$cto :: forall x. Rep StringCount x -> StringCount
to :: forall x. Rep StringCount x -> StringCount
Core.Generic)

-- | Creates a value of 'StringCount' with the minimum fields required to make a request.
newStringCount ::
  StringCount
newStringCount :: StringCount
newStringCount =
  StringCount {count :: Maybe Int64
count = Maybe Int64
forall a. Maybe a
Core.Nothing, id :: Maybe Text
id = Maybe Text
forall a. Maybe a
Core.Nothing}

instance Core.FromJSON StringCount where
  parseJSON :: Value -> Parser StringCount
parseJSON =
    String
-> (Object -> Parser StringCount) -> Value -> Parser StringCount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"StringCount"
      ( \Object
o ->
          Maybe Int64 -> Maybe Text -> StringCount
StringCount
            (Maybe Int64 -> Maybe Text -> StringCount)
-> Parser (Maybe Int64) -> Parser (Maybe Text -> StringCount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe (AsText Int64))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"count" Parser (Maybe (AsText Int64))
-> (Maybe (AsText Int64) -> Maybe Int64) -> Parser (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Core.<&> (AsText Int64 -> Int64) -> Maybe (AsText Int64) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.fmap AsText Int64 -> Int64
forall a. AsText a -> a
Core.fromAsText)
            Parser (Maybe Text -> StringCount)
-> Parser (Maybe Text) -> Parser StringCount
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"id")
      )

instance Core.ToJSON StringCount where
  toJSON :: StringCount -> Value
toJSON StringCount {Maybe Int64
Maybe Text
count :: StringCount -> Maybe Int64
id :: StringCount -> Maybe Text
count :: Maybe Int64
id :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"count" Core..=) (AsText Int64 -> Pair) -> (Int64 -> AsText Int64) -> Int64 -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
Core.. Int64 -> AsText Int64
forall a. a -> AsText a
Core.AsText (Int64 -> Pair) -> Maybe Int64 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int64
count,
            (Key
"id" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
id
          ]
      )

--
-- /See:/ 'newUrl' smart constructor.
data Url = Url
  { -- | A summary of the click analytics for the short and long URL. Might not be present if not requested or currently unavailable.
    Url -> Maybe AnalyticsSummary
analytics :: (Core.Maybe AnalyticsSummary),
    -- | Time the short URL was created; ISO 8601 representation using the yyyy-MM-dd\'T\'HH:mm:ss.SSSZZ format, e.g. \"2010-10-14T19:01:24.944+00:00\".
    Url -> Maybe Text
created :: (Core.Maybe Core.Text),
    -- | Short URL, e.g. \"http:\/\/goo.gl\/l6MS\".
    Url -> Maybe Text
id :: (Core.Maybe Core.Text),
    -- | The fixed string \"urlshortener#url\".
    Url -> Text
kind :: Core.Text,
    -- | Long URL, e.g. \"http:\/\/www.google.com\/\". Might not be present if the status is \"REMOVED\".
    Url -> Maybe Text
longUrl :: (Core.Maybe Core.Text),
    -- | Status of the target URL. Possible values: \"OK\", \"MALWARE\", \"PHISHING\", or \"REMOVED\". A URL might be marked \"REMOVED\" if it was flagged as spam, for example.
    Url -> Maybe Text
status :: (Core.Maybe Core.Text)
  }
  deriving (Url -> Url -> Bool
(Url -> Url -> Bool) -> (Url -> Url -> Bool) -> Eq Url
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Url -> Url -> Bool
== :: Url -> Url -> Bool
$c/= :: Url -> Url -> Bool
/= :: Url -> Url -> Bool
Core.Eq, Int -> Url -> ShowS
[Url] -> ShowS
Url -> String
(Int -> Url -> ShowS)
-> (Url -> String) -> ([Url] -> ShowS) -> Show Url
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Url -> ShowS
showsPrec :: Int -> Url -> ShowS
$cshow :: Url -> String
show :: Url -> String
$cshowList :: [Url] -> ShowS
showList :: [Url] -> ShowS
Core.Show, (forall x. Url -> Rep Url x)
-> (forall x. Rep Url x -> Url) -> Generic Url
forall x. Rep Url x -> Url
forall x. Url -> Rep Url x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Url -> Rep Url x
from :: forall x. Url -> Rep Url x
$cto :: forall x. Rep Url x -> Url
to :: forall x. Rep Url x -> Url
Core.Generic)

-- | Creates a value of 'Url' with the minimum fields required to make a request.
newUrl ::
  Url
newUrl :: Url
newUrl =
  Url
    { analytics :: Maybe AnalyticsSummary
analytics = Maybe AnalyticsSummary
forall a. Maybe a
Core.Nothing,
      created :: Maybe Text
created = Maybe Text
forall a. Maybe a
Core.Nothing,
      id :: Maybe Text
id = Maybe Text
forall a. Maybe a
Core.Nothing,
      kind :: Text
kind = Text
"urlshortener#url",
      longUrl :: Maybe Text
longUrl = Maybe Text
forall a. Maybe a
Core.Nothing,
      status :: Maybe Text
status = Maybe Text
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON Url where
  parseJSON :: Value -> Parser Url
parseJSON =
    String -> (Object -> Parser Url) -> Value -> Parser Url
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"Url"
      ( \Object
o ->
          Maybe AnalyticsSummary
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Url
Url
            (Maybe AnalyticsSummary
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Url)
-> Parser (Maybe AnalyticsSummary)
-> Parser
     (Maybe Text
      -> Maybe Text -> Text -> Maybe Text -> Maybe Text -> Url)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe AnalyticsSummary)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"analytics")
            Parser
  (Maybe Text
   -> Maybe Text -> Text -> Maybe Text -> Maybe Text -> Url)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> Maybe Text -> Maybe Text -> Url)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"created")
            Parser (Maybe Text -> Text -> Maybe Text -> Maybe Text -> Url)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> Maybe Text -> Url)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"id")
            Parser (Text -> Maybe Text -> Maybe Text -> Url)
-> Parser Text -> Parser (Maybe Text -> Maybe Text -> Url)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"kind" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
Core..!= Text
"urlshortener#url")
            Parser (Maybe Text -> Maybe Text -> Url)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Url)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"longUrl")
            Parser (Maybe Text -> Url) -> Parser (Maybe Text) -> Parser Url
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"status")
      )

instance Core.ToJSON Url where
  toJSON :: Url -> Value
toJSON Url {Maybe Text
Maybe AnalyticsSummary
Text
analytics :: Url -> Maybe AnalyticsSummary
created :: Url -> Maybe Text
id :: Url -> Maybe Text
kind :: Url -> Text
longUrl :: Url -> Maybe Text
status :: Url -> Maybe Text
analytics :: Maybe AnalyticsSummary
created :: Maybe Text
id :: Maybe Text
kind :: Text
longUrl :: Maybe Text
status :: Maybe Text
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"analytics" Core..=) (AnalyticsSummary -> Pair) -> Maybe AnalyticsSummary -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe AnalyticsSummary
analytics,
            (Key
"created" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
created,
            (Key
"id" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
id,
            Pair -> Maybe Pair
forall a. a -> Maybe a
Core.Just (Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Core..= Text
kind),
            (Key
"longUrl" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
longUrl,
            (Key
"status" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
status
          ]
      )

--
-- /See:/ 'newUrlHistory' smart constructor.
data UrlHistory = UrlHistory
  { -- | A list of URL resources.
    UrlHistory -> Maybe [Url]
items :: (Core.Maybe [Url]),
    -- | Number of items returned with each full \"page\" of results. Note that the last page could have fewer items than the \"itemsPerPage\" value.
    UrlHistory -> Maybe Int32
itemsPerPage :: (Core.Maybe Core.Int32),
    -- | The fixed string \"urlshortener#urlHistory\".
    UrlHistory -> Text
kind :: Core.Text,
    -- | A token to provide to get the next page of results.
    UrlHistory -> Maybe Text
nextPageToken :: (Core.Maybe Core.Text),
    -- | Total number of short URLs associated with this user (may be approximate).
    UrlHistory -> Maybe Int32
totalItems :: (Core.Maybe Core.Int32)
  }
  deriving (UrlHistory -> UrlHistory -> Bool
(UrlHistory -> UrlHistory -> Bool)
-> (UrlHistory -> UrlHistory -> Bool) -> Eq UrlHistory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlHistory -> UrlHistory -> Bool
== :: UrlHistory -> UrlHistory -> Bool
$c/= :: UrlHistory -> UrlHistory -> Bool
/= :: UrlHistory -> UrlHistory -> Bool
Core.Eq, Int -> UrlHistory -> ShowS
[UrlHistory] -> ShowS
UrlHistory -> String
(Int -> UrlHistory -> ShowS)
-> (UrlHistory -> String)
-> ([UrlHistory] -> ShowS)
-> Show UrlHistory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlHistory -> ShowS
showsPrec :: Int -> UrlHistory -> ShowS
$cshow :: UrlHistory -> String
show :: UrlHistory -> String
$cshowList :: [UrlHistory] -> ShowS
showList :: [UrlHistory] -> ShowS
Core.Show, (forall x. UrlHistory -> Rep UrlHistory x)
-> (forall x. Rep UrlHistory x -> UrlHistory) -> Generic UrlHistory
forall x. Rep UrlHistory x -> UrlHistory
forall x. UrlHistory -> Rep UrlHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UrlHistory -> Rep UrlHistory x
from :: forall x. UrlHistory -> Rep UrlHistory x
$cto :: forall x. Rep UrlHistory x -> UrlHistory
to :: forall x. Rep UrlHistory x -> UrlHistory
Core.Generic)

-- | Creates a value of 'UrlHistory' with the minimum fields required to make a request.
newUrlHistory ::
  UrlHistory
newUrlHistory :: UrlHistory
newUrlHistory =
  UrlHistory
    { items :: Maybe [Url]
items = Maybe [Url]
forall a. Maybe a
Core.Nothing,
      itemsPerPage :: Maybe Int32
itemsPerPage = Maybe Int32
forall a. Maybe a
Core.Nothing,
      kind :: Text
kind = Text
"urlshortener#urlHistory",
      nextPageToken :: Maybe Text
nextPageToken = Maybe Text
forall a. Maybe a
Core.Nothing,
      totalItems :: Maybe Int32
totalItems = Maybe Int32
forall a. Maybe a
Core.Nothing
    }

instance Core.FromJSON UrlHistory where
  parseJSON :: Value -> Parser UrlHistory
parseJSON =
    String
-> (Object -> Parser UrlHistory) -> Value -> Parser UrlHistory
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Core.withObject
      String
"UrlHistory"
      ( \Object
o ->
          Maybe [Url]
-> Maybe Int32 -> Text -> Maybe Text -> Maybe Int32 -> UrlHistory
UrlHistory
            (Maybe [Url]
 -> Maybe Int32 -> Text -> Maybe Text -> Maybe Int32 -> UrlHistory)
-> Parser (Maybe [Url])
-> Parser
     (Maybe Int32 -> Text -> Maybe Text -> Maybe Int32 -> UrlHistory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> (Object
o Object -> Key -> Parser (Maybe [Url])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"items")
            Parser
  (Maybe Int32 -> Text -> Maybe Text -> Maybe Int32 -> UrlHistory)
-> Parser (Maybe Int32)
-> Parser (Text -> Maybe Text -> Maybe Int32 -> UrlHistory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"itemsPerPage")
            Parser (Text -> Maybe Text -> Maybe Int32 -> UrlHistory)
-> Parser Text -> Parser (Maybe Text -> Maybe Int32 -> UrlHistory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"kind" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
Core..!= Text
"urlshortener#urlHistory")
            Parser (Maybe Text -> Maybe Int32 -> UrlHistory)
-> Parser (Maybe Text) -> Parser (Maybe Int32 -> UrlHistory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"nextPageToken")
            Parser (Maybe Int32 -> UrlHistory)
-> Parser (Maybe Int32) -> Parser UrlHistory
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Core.<*> (Object
o Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Core..:? Key
"totalItems")
      )

instance Core.ToJSON UrlHistory where
  toJSON :: UrlHistory -> Value
toJSON UrlHistory {Maybe Int32
Maybe [Url]
Maybe Text
Text
items :: UrlHistory -> Maybe [Url]
itemsPerPage :: UrlHistory -> Maybe Int32
kind :: UrlHistory -> Text
nextPageToken :: UrlHistory -> Maybe Text
totalItems :: UrlHistory -> Maybe Int32
items :: Maybe [Url]
itemsPerPage :: Maybe Int32
kind :: Text
nextPageToken :: Maybe Text
totalItems :: Maybe Int32
..} =
    [Pair] -> Value
Core.object
      ( [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Core.catMaybes
          [ (Key
"items" Core..=) ([Url] -> Pair) -> Maybe [Url] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe [Url]
items,
            (Key
"itemsPerPage" Core..=) (Int32 -> Pair) -> Maybe Int32 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int32
itemsPerPage,
            Pair -> Maybe Pair
forall a. a -> Maybe a
Core.Just (Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Core..= Text
kind),
            (Key
"nextPageToken" Core..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Text
nextPageToken,
            (Key
"totalItems" Core..=) (Int32 -> Pair) -> Maybe Int32 -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Core.<$> Maybe Int32
totalItems
          ]
      )