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

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

import qualified Data.Text as Text

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

-- ** 'BackgroundFill'

-- | This object describes the way a background is filled based on the selected colors. Currently, it can be one of
--
-- * BackgroundFillSolid
-- * BackgroundFillGradient
-- * BackgroundFillFreeformGradient
--
data BackgroundFill
  -- | The background is filled using the selected color.
  = BackgroundFillSolid
      { BackgroundFill -> Text
backgroundFillSolidType :: Text -- ^ Type of the background fill, always “solid”.
      , BackgroundFill -> Int
backgroundFillSolidColor :: Int  -- ^ The color of the background fill in the RGB24 format.
      }
  -- | The background is a gradient fill.
  | BackgroundFillGradient
      { BackgroundFill -> Text
backgroundFillGradientType :: Text -- ^ Type of the background fill, always “gradient”.
      , BackgroundFill -> Int
backgroundFillGradientTopColor :: Int -- ^ Top color of the gradient in the RGB24 format.
      , BackgroundFill -> Int
backgroundFillGradientBottomColor :: Int -- ^ Bottom color of the gradient in the RGB24 format.
      , BackgroundFill -> Int
backgroundFillGradientRotationAngle :: Int -- ^ Clockwise rotation angle of the background fill in degrees; @0-359@.
      }
  -- | The background is a freeform gradient that rotates after every message in the chat.
  | BackgroundFillFreeformGradient
      { BackgroundFill -> Text
backgroundFillFreeformGradientType :: Text -- ^ Type of the background fill, always “freeform_gradient”.
      , BackgroundFill -> [Int]
backgroundFillFreeformGradientColors :: [Int] -- ^ A list of the 3 or 4 base colors that are used to generate the freeform gradient in the RGB24 format.
      }
  deriving ((forall x. BackgroundFill -> Rep BackgroundFill x)
-> (forall x. Rep BackgroundFill x -> BackgroundFill)
-> Generic BackgroundFill
forall x. Rep BackgroundFill x -> BackgroundFill
forall x. BackgroundFill -> Rep BackgroundFill x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BackgroundFill -> Rep BackgroundFill x
from :: forall x. BackgroundFill -> Rep BackgroundFill x
$cto :: forall x. Rep BackgroundFill x -> BackgroundFill
to :: forall x. Rep BackgroundFill x -> BackgroundFill
Generic, Int -> BackgroundFill -> ShowS
[BackgroundFill] -> ShowS
BackgroundFill -> String
(Int -> BackgroundFill -> ShowS)
-> (BackgroundFill -> String)
-> ([BackgroundFill] -> ShowS)
-> Show BackgroundFill
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackgroundFill -> ShowS
showsPrec :: Int -> BackgroundFill -> ShowS
$cshow :: BackgroundFill -> String
show :: BackgroundFill -> String
$cshowList :: [BackgroundFill] -> ShowS
showList :: [BackgroundFill] -> ShowS
Show)

instance ToJSON BackgroundFill where
  toJSON :: BackgroundFill -> Value
toJSON = \case
    BackgroundFillSolid Text
_t Int
c -> Value -> [Pair] -> Value
addJsonFields
      (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
      (Text -> [Pair] -> [Pair]
addType Text
"solid" [Key
"color" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
c])
    BackgroundFillGradient Text
_t Int
tc Int
bc Int
ra -> Value -> [Pair] -> Value
addJsonFields
      (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
      (Text -> [Pair] -> [Pair]
addType Text
"gradient" [Key
"top_color" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
tc, Key
"bottom_color" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
bc, Key
"rotation_angle" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
ra])
    BackgroundFillFreeformGradient Text
_t [Int]
cs -> Value -> [Pair] -> Value
addJsonFields
      (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
      (Text -> [Pair] -> [Pair]
addType Text
"freeform_gradient" [Key
"colors" Key -> [Int] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Int]
cs])

instance FromJSON BackgroundFill where
  parseJSON :: Value -> Parser BackgroundFill
parseJSON = String
-> (Object -> Parser BackgroundFill)
-> Value
-> Parser BackgroundFill
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BackgroundFill" \Object
o ->
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text) Parser Text
-> (Text -> Parser BackgroundFill) -> Parser BackgroundFill
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
"solid" -> Text -> Int -> BackgroundFill
BackgroundFillSolid
      (Text -> Int -> BackgroundFill)
-> Parser Text -> Parser (Int -> BackgroundFill)
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 (Int -> BackgroundFill)
-> Parser Int -> Parser BackgroundFill
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
"color"
    Text
"gradient" ->Text -> Int -> Int -> Int -> BackgroundFill
BackgroundFillGradient
      (Text -> Int -> Int -> Int -> BackgroundFill)
-> Parser Text -> Parser (Int -> Int -> Int -> BackgroundFill)
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 (Int -> Int -> Int -> BackgroundFill)
-> Parser Int -> Parser (Int -> Int -> BackgroundFill)
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
"top_color"
      Parser (Int -> Int -> BackgroundFill)
-> Parser Int -> Parser (Int -> BackgroundFill)
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
"bottom_color"
      Parser (Int -> BackgroundFill)
-> Parser Int -> Parser BackgroundFill
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
"rotation_angle"
    Text
"freeform_gradient" -> Text -> [Int] -> BackgroundFill
BackgroundFillFreeformGradient
      (Text -> [Int] -> BackgroundFill)
-> Parser Text -> Parser ([Int] -> BackgroundFill)
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 ([Int] -> BackgroundFill)
-> Parser [Int] -> Parser BackgroundFill
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
"colors"
    Text
t -> String -> Parser BackgroundFill
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BackgroundFill)
-> String -> Parser BackgroundFill
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)