{-# LANGUAGE DeriveGeneric #-}
module Telegram.Bot.API.Types.LinkPreviewOptions where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Text (Text)
import GHC.Generics (Generic)

import Telegram.Bot.API.Internal.Utils

-- ** 'LinkPreviewOptions'

data LinkPreviewOptions = LinkPreviewOptions
  { LinkPreviewOptions -> Maybe Bool
linkPreviewOptionsIsDisabled :: Maybe Bool -- ^ 'True', if the link preview is disabled.
  , LinkPreviewOptions -> Maybe Text
linkPreviewOptionsUrl :: Maybe Text -- ^ URL to use for the link preview. If empty, then the first URL found in the message text will be used.
  , LinkPreviewOptions -> Maybe Bool
linkPreviewOptionsPreferSmallMedia :: Maybe Bool -- ^ 'True', if the media in the link preview is suppposed to be shrunk; ignored if the URL isn't explicitly specified or media size change isn't supported for the preview.
  , LinkPreviewOptions -> Maybe Bool
linkPreviewOptionsPreferLargeMedia :: Maybe Bool -- ^ 'True', if the media in the link preview is suppposed to be enlarged; ignored if the URL isn't explicitly specified or media size change isn't supported for the preview.
  , LinkPreviewOptions -> Maybe Bool
linkPreviewOptionsShowAboveText :: Maybe Bool -- ^ 'True', if the link preview must be shown above the message text; otherwise, the link preview will be shown below the message text.
  }
  deriving ((forall x. LinkPreviewOptions -> Rep LinkPreviewOptions x)
-> (forall x. Rep LinkPreviewOptions x -> LinkPreviewOptions)
-> Generic LinkPreviewOptions
forall x. Rep LinkPreviewOptions x -> LinkPreviewOptions
forall x. LinkPreviewOptions -> Rep LinkPreviewOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LinkPreviewOptions -> Rep LinkPreviewOptions x
from :: forall x. LinkPreviewOptions -> Rep LinkPreviewOptions x
$cto :: forall x. Rep LinkPreviewOptions x -> LinkPreviewOptions
to :: forall x. Rep LinkPreviewOptions x -> LinkPreviewOptions
Generic, Int -> LinkPreviewOptions -> ShowS
[LinkPreviewOptions] -> ShowS
LinkPreviewOptions -> String
(Int -> LinkPreviewOptions -> ShowS)
-> (LinkPreviewOptions -> String)
-> ([LinkPreviewOptions] -> ShowS)
-> Show LinkPreviewOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkPreviewOptions -> ShowS
showsPrec :: Int -> LinkPreviewOptions -> ShowS
$cshow :: LinkPreviewOptions -> String
show :: LinkPreviewOptions -> String
$cshowList :: [LinkPreviewOptions] -> ShowS
showList :: [LinkPreviewOptions] -> ShowS
Show)

instance ToJSON   LinkPreviewOptions where toJSON :: LinkPreviewOptions -> Value
toJSON = LinkPreviewOptions -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON LinkPreviewOptions where parseJSON :: Value -> Parser LinkPreviewOptions
parseJSON = Value -> Parser LinkPreviewOptions
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON