{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}

{- HLINT ignore "Use <&>" -}

module Data.RdsData.Types.Param
  ( Param(..)
  , toSqlParameter
  ) where

import Control.Lens
import Data.Generics.Product.Any
import Data.RdsData.Types.Value
import Data.Text
import GHC.Generics

import qualified Amazonka.RDSData as AWS
import qualified Data.Aeson       as J

data Param = Param
  { Param -> Maybe Text
name :: Maybe Text
  , Param -> Maybe TypeHint
hint  :: Maybe AWS.TypeHint
  , Param -> Value
value :: Value
  } deriving (Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
/= :: Param -> Param -> Bool
Eq, (forall x. Param -> Rep Param x)
-> (forall x. Rep Param x -> Param) -> Generic Param
forall x. Rep Param x -> Param
forall x. Param -> Rep Param x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Param -> Rep Param x
from :: forall x. Param -> Rep Param x
$cto :: forall x. Rep Param x -> Param
to :: forall x. Rep Param x -> Param
Generic, Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
(Int -> Param -> ShowS)
-> (Param -> String) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Param -> ShowS
showsPrec :: Int -> Param -> ShowS
$cshow :: Param -> String
show :: Param -> String
$cshowList :: [Param] -> ShowS
showList :: [Param] -> ShowS
Show)

instance J.ToJSON Param where

toSqlParameter :: Param -> AWS.SqlParameter
toSqlParameter :: Param -> SqlParameter
toSqlParameter (Param Maybe Text
n Maybe TypeHint
h Value
v) =
  SqlParameter
AWS.newSqlParameter SqlParameter -> (SqlParameter -> SqlParameter) -> SqlParameter
forall a b. a -> (a -> b) -> b
& forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"name" ((Maybe Text -> Identity (Maybe Text))
 -> SqlParameter -> Identity SqlParameter)
-> Maybe Text -> SqlParameter -> SqlParameter
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
n SqlParameter -> (SqlParameter -> SqlParameter) -> SqlParameter
forall a b. a -> (a -> b) -> b
& forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"typeHint" ((Maybe TypeHint -> Identity (Maybe TypeHint))
 -> SqlParameter -> Identity SqlParameter)
-> Maybe TypeHint -> SqlParameter -> SqlParameter
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe TypeHint
h SqlParameter -> (SqlParameter -> SqlParameter) -> SqlParameter
forall a b. a -> (a -> b) -> b
& forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"value" ((Maybe Field -> Identity (Maybe Field))
 -> SqlParameter -> Identity SqlParameter)
-> Field -> SqlParameter -> SqlParameter
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value -> Field
toField Value
v