{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppFlow.Types.PrefixConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.AppFlow.Types.PrefixConfig where

import Amazonka.AppFlow.Types.PathPrefix
import Amazonka.AppFlow.Types.PrefixFormat
import Amazonka.AppFlow.Types.PrefixType
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Specifies elements that Amazon AppFlow includes in the file and folder
-- names in the flow destination.
--
-- /See:/ 'newPrefixConfig' smart constructor.
data PrefixConfig = PrefixConfig'
  { -- | Specifies whether the destination file path includes either or both of
    -- the following elements:
    --
    -- [EXECUTION_ID]
    --     The ID that Amazon AppFlow assigns to the flow run.
    --
    -- [SCHEMA_VERSION]
    --     The version number of your data schema. Amazon AppFlow assigns this
    --     version number. The version number increases by one when you change
    --     any of the following settings in your flow configuration:
    --
    --     -   Source-to-destination field mappings
    --
    --     -   Field data types
    --
    --     -   Partition keys
    PrefixConfig -> Maybe [PathPrefix]
pathPrefixHierarchy :: Prelude.Maybe [PathPrefix],
    -- | Determines the level of granularity for the date and time that\'s
    -- included in the prefix.
    PrefixConfig -> Maybe PrefixFormat
prefixFormat :: Prelude.Maybe PrefixFormat,
    -- | Determines the format of the prefix, and whether it applies to the file
    -- name, file path, or both.
    PrefixConfig -> Maybe PrefixType
prefixType :: Prelude.Maybe PrefixType
  }
  deriving (PrefixConfig -> PrefixConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrefixConfig -> PrefixConfig -> Bool
$c/= :: PrefixConfig -> PrefixConfig -> Bool
== :: PrefixConfig -> PrefixConfig -> Bool
$c== :: PrefixConfig -> PrefixConfig -> Bool
Prelude.Eq, ReadPrec [PrefixConfig]
ReadPrec PrefixConfig
Int -> ReadS PrefixConfig
ReadS [PrefixConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrefixConfig]
$creadListPrec :: ReadPrec [PrefixConfig]
readPrec :: ReadPrec PrefixConfig
$creadPrec :: ReadPrec PrefixConfig
readList :: ReadS [PrefixConfig]
$creadList :: ReadS [PrefixConfig]
readsPrec :: Int -> ReadS PrefixConfig
$creadsPrec :: Int -> ReadS PrefixConfig
Prelude.Read, Int -> PrefixConfig -> ShowS
[PrefixConfig] -> ShowS
PrefixConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrefixConfig] -> ShowS
$cshowList :: [PrefixConfig] -> ShowS
show :: PrefixConfig -> String
$cshow :: PrefixConfig -> String
showsPrec :: Int -> PrefixConfig -> ShowS
$cshowsPrec :: Int -> PrefixConfig -> ShowS
Prelude.Show, forall x. Rep PrefixConfig x -> PrefixConfig
forall x. PrefixConfig -> Rep PrefixConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrefixConfig x -> PrefixConfig
$cfrom :: forall x. PrefixConfig -> Rep PrefixConfig x
Prelude.Generic)

-- |
-- Create a value of 'PrefixConfig' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'pathPrefixHierarchy', 'prefixConfig_pathPrefixHierarchy' - Specifies whether the destination file path includes either or both of
-- the following elements:
--
-- [EXECUTION_ID]
--     The ID that Amazon AppFlow assigns to the flow run.
--
-- [SCHEMA_VERSION]
--     The version number of your data schema. Amazon AppFlow assigns this
--     version number. The version number increases by one when you change
--     any of the following settings in your flow configuration:
--
--     -   Source-to-destination field mappings
--
--     -   Field data types
--
--     -   Partition keys
--
-- 'prefixFormat', 'prefixConfig_prefixFormat' - Determines the level of granularity for the date and time that\'s
-- included in the prefix.
--
-- 'prefixType', 'prefixConfig_prefixType' - Determines the format of the prefix, and whether it applies to the file
-- name, file path, or both.
newPrefixConfig ::
  PrefixConfig
newPrefixConfig :: PrefixConfig
newPrefixConfig =
  PrefixConfig'
    { $sel:pathPrefixHierarchy:PrefixConfig' :: Maybe [PathPrefix]
pathPrefixHierarchy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:prefixFormat:PrefixConfig' :: Maybe PrefixFormat
prefixFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:prefixType:PrefixConfig' :: Maybe PrefixType
prefixType = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies whether the destination file path includes either or both of
-- the following elements:
--
-- [EXECUTION_ID]
--     The ID that Amazon AppFlow assigns to the flow run.
--
-- [SCHEMA_VERSION]
--     The version number of your data schema. Amazon AppFlow assigns this
--     version number. The version number increases by one when you change
--     any of the following settings in your flow configuration:
--
--     -   Source-to-destination field mappings
--
--     -   Field data types
--
--     -   Partition keys
prefixConfig_pathPrefixHierarchy :: Lens.Lens' PrefixConfig (Prelude.Maybe [PathPrefix])
prefixConfig_pathPrefixHierarchy :: Lens' PrefixConfig (Maybe [PathPrefix])
prefixConfig_pathPrefixHierarchy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrefixConfig' {Maybe [PathPrefix]
pathPrefixHierarchy :: Maybe [PathPrefix]
$sel:pathPrefixHierarchy:PrefixConfig' :: PrefixConfig -> Maybe [PathPrefix]
pathPrefixHierarchy} -> Maybe [PathPrefix]
pathPrefixHierarchy) (\s :: PrefixConfig
s@PrefixConfig' {} Maybe [PathPrefix]
a -> PrefixConfig
s {$sel:pathPrefixHierarchy:PrefixConfig' :: Maybe [PathPrefix]
pathPrefixHierarchy = Maybe [PathPrefix]
a} :: PrefixConfig) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Determines the level of granularity for the date and time that\'s
-- included in the prefix.
prefixConfig_prefixFormat :: Lens.Lens' PrefixConfig (Prelude.Maybe PrefixFormat)
prefixConfig_prefixFormat :: Lens' PrefixConfig (Maybe PrefixFormat)
prefixConfig_prefixFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrefixConfig' {Maybe PrefixFormat
prefixFormat :: Maybe PrefixFormat
$sel:prefixFormat:PrefixConfig' :: PrefixConfig -> Maybe PrefixFormat
prefixFormat} -> Maybe PrefixFormat
prefixFormat) (\s :: PrefixConfig
s@PrefixConfig' {} Maybe PrefixFormat
a -> PrefixConfig
s {$sel:prefixFormat:PrefixConfig' :: Maybe PrefixFormat
prefixFormat = Maybe PrefixFormat
a} :: PrefixConfig)

-- | Determines the format of the prefix, and whether it applies to the file
-- name, file path, or both.
prefixConfig_prefixType :: Lens.Lens' PrefixConfig (Prelude.Maybe PrefixType)
prefixConfig_prefixType :: Lens' PrefixConfig (Maybe PrefixType)
prefixConfig_prefixType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrefixConfig' {Maybe PrefixType
prefixType :: Maybe PrefixType
$sel:prefixType:PrefixConfig' :: PrefixConfig -> Maybe PrefixType
prefixType} -> Maybe PrefixType
prefixType) (\s :: PrefixConfig
s@PrefixConfig' {} Maybe PrefixType
a -> PrefixConfig
s {$sel:prefixType:PrefixConfig' :: Maybe PrefixType
prefixType = Maybe PrefixType
a} :: PrefixConfig)

instance Data.FromJSON PrefixConfig where
  parseJSON :: Value -> Parser PrefixConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PrefixConfig"
      ( \Object
x ->
          Maybe [PathPrefix]
-> Maybe PrefixFormat -> Maybe PrefixType -> PrefixConfig
PrefixConfig'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pathPrefixHierarchy"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"prefixFormat")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"prefixType")
      )

instance Prelude.Hashable PrefixConfig where
  hashWithSalt :: Int -> PrefixConfig -> Int
hashWithSalt Int
_salt PrefixConfig' {Maybe [PathPrefix]
Maybe PrefixFormat
Maybe PrefixType
prefixType :: Maybe PrefixType
prefixFormat :: Maybe PrefixFormat
pathPrefixHierarchy :: Maybe [PathPrefix]
$sel:prefixType:PrefixConfig' :: PrefixConfig -> Maybe PrefixType
$sel:prefixFormat:PrefixConfig' :: PrefixConfig -> Maybe PrefixFormat
$sel:pathPrefixHierarchy:PrefixConfig' :: PrefixConfig -> Maybe [PathPrefix]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PathPrefix]
pathPrefixHierarchy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PrefixFormat
prefixFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PrefixType
prefixType

instance Prelude.NFData PrefixConfig where
  rnf :: PrefixConfig -> ()
rnf PrefixConfig' {Maybe [PathPrefix]
Maybe PrefixFormat
Maybe PrefixType
prefixType :: Maybe PrefixType
prefixFormat :: Maybe PrefixFormat
pathPrefixHierarchy :: Maybe [PathPrefix]
$sel:prefixType:PrefixConfig' :: PrefixConfig -> Maybe PrefixType
$sel:prefixFormat:PrefixConfig' :: PrefixConfig -> Maybe PrefixFormat
$sel:pathPrefixHierarchy:PrefixConfig' :: PrefixConfig -> Maybe [PathPrefix]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PathPrefix]
pathPrefixHierarchy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PrefixFormat
prefixFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PrefixType
prefixType

instance Data.ToJSON PrefixConfig where
  toJSON :: PrefixConfig -> Value
toJSON PrefixConfig' {Maybe [PathPrefix]
Maybe PrefixFormat
Maybe PrefixType
prefixType :: Maybe PrefixType
prefixFormat :: Maybe PrefixFormat
pathPrefixHierarchy :: Maybe [PathPrefix]
$sel:prefixType:PrefixConfig' :: PrefixConfig -> Maybe PrefixType
$sel:prefixFormat:PrefixConfig' :: PrefixConfig -> Maybe PrefixFormat
$sel:pathPrefixHierarchy:PrefixConfig' :: PrefixConfig -> Maybe [PathPrefix]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"pathPrefixHierarchy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [PathPrefix]
pathPrefixHierarchy,
            (Key
"prefixFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe PrefixFormat
prefixFormat,
            (Key
"prefixType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe PrefixType
prefixType
          ]
      )