{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Telegram.Bot.API.Types.BackgroundType where

import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.=), (.:), (.:?), withObject)
import Data.Aeson.Types (Parser)
import Data.Text (Text)
import GHC.Generics (Generic)

import qualified Data.Text as Text

import Telegram.Bot.API.Types.BackgroundFill
import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.Document
import Telegram.Bot.API.Internal.Utils

-- ** 'BackgroundType'

-- | This object describes the type of a background. Currently, it can be one of
--
-- * BackgroundTypeFill
-- * BackgroundTypeWallpaper
-- * BackgroundTypePattern
-- * BackgroundTypeChatTheme
--
data BackgroundType
  -- | The background is automatically filled based on the selected colors.
  = BackgroundTypeFill
      { BackgroundType -> Text
backgroundTypeFillType :: Text -- ^ Type of the background, always “fill”.
      , BackgroundType -> BackgroundFill
backgroundTypeFillFill :: BackgroundFill -- ^ The background fill.
      , BackgroundType -> Int
backgroundTypeFillDarkThemeDimming :: Int -- ^ Dimming of the background in dark themes, as a percentage; @0-100@.
      }
  -- | The background is a wallpaper in the JPEG format.
  | BackgroundTypeWallpaper
      { BackgroundType -> Text
backgroundTypeWallpaperType :: Text -- ^ Type of the background, always “wallpaper”.
      , BackgroundType -> Document
backgroundTypeWallpaperDocument :: Document -- ^ Document with the wallpaper.
      , BackgroundType -> Int
backgroundTypeWallpaperDarkThemeDimming :: Int -- ^ Dimming of the background in dark themes, as a percentage; @0-100@.
      , BackgroundType -> Maybe Bool
backgroundTypeWallpaperIsBlurred :: Maybe Bool -- ^ 'True', if the wallpaper is downscaled to fit in a @450x450@ square and then box-blurred with radius 12.
      , BackgroundType -> Maybe Bool
backgroundTypeWallpaperIsMoving :: Maybe Bool -- ^ 'True', if the background moves slightly when the device is tilted.
      }
  -- | The background is a PNG or TGV (gzipped subset of SVG with MIME type “application/x-tgwallpattern”) pattern to be combined with the background fill chosen by the user.
  | BackgroundTypePattern
      { BackgroundType -> Text
backgroundTypePatternType :: Text -- ^ Type of the background, always “pattern”.
      , BackgroundType -> Document
backgroundTypePatternDocument :: Document -- ^ Document with the pattern.
      , BackgroundType -> BackgroundFill
backgroundTypePatternFill :: BackgroundFill -- ^ The background fill that is combined with the pattern.
      , BackgroundType -> Int
backgroundTypePatternIntensity :: Int -- ^ Intensity of the pattern when it is shown above the filled background; @0-100@.
      , BackgroundType -> Maybe Bool
backgroundTypePatternIsInverted :: Maybe Bool -- ^ 'True', if the background fill must be applied only to the pattern itself. All other pixels are black in this case. For dark themes only.
      , BackgroundType -> Maybe Bool
backgroundTypePatternIsMoving :: Maybe Bool -- ^ 'True', if the background moves slightly when the device is tilted.
      }
  -- | The background is taken directly from a built-in chat theme.
  | BackgroundTypeChatTheme
      { BackgroundType -> Text
backgroundTypeChatThemeType :: Text -- ^ Type of the background, always “chat_theme”.
      , BackgroundType -> Text
backgroundTypeChatThemeThemeName :: Text -- ^ Name of the chat theme, which is usually an emoji.
      }
  deriving ((forall x. BackgroundType -> Rep BackgroundType x)
-> (forall x. Rep BackgroundType x -> BackgroundType)
-> Generic BackgroundType
forall x. Rep BackgroundType x -> BackgroundType
forall x. BackgroundType -> Rep BackgroundType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BackgroundType -> Rep BackgroundType x
from :: forall x. BackgroundType -> Rep BackgroundType x
$cto :: forall x. Rep BackgroundType x -> BackgroundType
to :: forall x. Rep BackgroundType x -> BackgroundType
Generic, Int -> BackgroundType -> ShowS
[BackgroundType] -> ShowS
BackgroundType -> String
(Int -> BackgroundType -> ShowS)
-> (BackgroundType -> String)
-> ([BackgroundType] -> ShowS)
-> Show BackgroundType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackgroundType -> ShowS
showsPrec :: Int -> BackgroundType -> ShowS
$cshow :: BackgroundType -> String
show :: BackgroundType -> String
$cshowList :: [BackgroundType] -> ShowS
showList :: [BackgroundType] -> ShowS
Show)

instance ToJSON BackgroundType where
  toJSON :: BackgroundType -> Value
toJSON = \case
     BackgroundTypeFill Text
_t BackgroundFill
f Int
dtd -> Value -> [Pair] -> Value
addJsonFields
       (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
       (Text -> [Pair] -> [Pair]
addType Text
"fill" [Key
"fill" Key -> BackgroundFill -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BackgroundFill
f, Key
"dark_theme_dimming" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
dtd])
     BackgroundTypeWallpaper Text
_t Document
d Int
dtd Maybe Bool
ib Maybe Bool
im -> Value -> [Pair] -> Value
addJsonFields
       (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
       (Text -> [Pair] -> [Pair]
addType Text
"wallpaper" [Key
"document" Key -> Document -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Document
d, Key
"dark_theme_dimming" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
dtd, Key
"is_blurred" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
ib, Key
"is_moving" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
im])
     BackgroundTypePattern Text
_t Document
d BackgroundFill
f Int
i Maybe Bool
ii Maybe Bool
im -> Value -> [Pair] -> Value
addJsonFields
       (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
       (Text -> [Pair] -> [Pair]
addType Text
"pattern" [Key
"document" Key -> Document -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Document
d, Key
"fill" Key -> BackgroundFill -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BackgroundFill
f, Key
"intensity" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
i, Key
"is_inverted" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
ii, Key
"is_moving" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
im])
     BackgroundTypeChatTheme Text
_t Text
tn -> Value -> [Pair] -> Value
addJsonFields
       (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
       (Text -> [Pair] -> [Pair]
addType Text
"chat_theme" [Key
"theme_name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tn])

instance FromJSON BackgroundType where
  parseJSON :: Value -> Parser BackgroundType
parseJSON = String
-> (Object -> Parser BackgroundType)
-> Value
-> Parser BackgroundType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BackgroundType" \Object
o ->
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text) Parser Text
-> (Text -> Parser BackgroundType) -> Parser BackgroundType
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"fill" -> Text -> BackgroundFill -> Int -> BackgroundType
BackgroundTypeFill
      (Text -> BackgroundFill -> Int -> BackgroundType)
-> Parser Text -> Parser (BackgroundFill -> Int -> BackgroundType)
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
"type"
      Parser (BackgroundFill -> Int -> BackgroundType)
-> Parser BackgroundFill -> Parser (Int -> BackgroundType)
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 BackgroundFill
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fill"
      Parser (Int -> BackgroundType)
-> Parser Int -> Parser BackgroundType
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
"dark_theme_dimming"
    Text
"wallpaper" -> Text
-> Document -> Int -> Maybe Bool -> Maybe Bool -> BackgroundType
BackgroundTypeWallpaper
      (Text
 -> Document -> Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser Text
-> Parser
     (Document -> Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
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
"type"
      Parser
  (Document -> Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser Document
-> Parser (Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
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 Document
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"document"
      Parser (Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser Int
-> Parser (Maybe Bool -> Maybe Bool -> BackgroundType)
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
"dark_theme_dimming"
      Parser (Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> BackgroundType)
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 (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_blurred"
      Parser (Maybe Bool -> BackgroundType)
-> Parser (Maybe Bool) -> Parser BackgroundType
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 (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_moving"
    Text
"pattern" -> Text
-> Document
-> BackgroundFill
-> Int
-> Maybe Bool
-> Maybe Bool
-> BackgroundType
BackgroundTypePattern
      (Text
 -> Document
 -> BackgroundFill
 -> Int
 -> Maybe Bool
 -> Maybe Bool
 -> BackgroundType)
-> Parser Text
-> Parser
     (Document
      -> BackgroundFill
      -> Int
      -> Maybe Bool
      -> Maybe Bool
      -> BackgroundType)
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
"type"
      Parser
  (Document
   -> BackgroundFill
   -> Int
   -> Maybe Bool
   -> Maybe Bool
   -> BackgroundType)
-> Parser Document
-> Parser
     (BackgroundFill
      -> Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
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 Document
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"document"
      Parser
  (BackgroundFill
   -> Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser BackgroundFill
-> Parser (Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
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 BackgroundFill
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fill"
      Parser (Int -> Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser Int
-> Parser (Maybe Bool -> Maybe Bool -> BackgroundType)
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
"intensity"
      Parser (Maybe Bool -> Maybe Bool -> BackgroundType)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> BackgroundType)
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 (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_inverted"
      Parser (Maybe Bool -> BackgroundType)
-> Parser (Maybe Bool) -> Parser BackgroundType
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 (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_moving"
    Text
"chat_theme" -> Text -> Text -> BackgroundType
BackgroundTypeChatTheme
      (Text -> Text -> BackgroundType)
-> Parser Text -> Parser (Text -> BackgroundType)
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
"type"
      Parser (Text -> BackgroundType)
-> Parser Text -> Parser BackgroundType
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
"theme_name"
    Text
t -> String -> Parser BackgroundType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BackgroundType)
-> String -> Parser BackgroundType
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text
"Unknown type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)