{-# 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.DataBrew.Types.PathOptions
-- 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.DataBrew.Types.PathOptions where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataBrew.Types.DatasetParameter
import Amazonka.DataBrew.Types.FilesLimit
import Amazonka.DataBrew.Types.FilterExpression
import qualified Amazonka.Prelude as Prelude

-- | Represents a set of options that define how DataBrew selects files for a
-- given Amazon S3 path in a dataset.
--
-- /See:/ 'newPathOptions' smart constructor.
data PathOptions = PathOptions'
  { -- | If provided, this structure imposes a limit on a number of files that
    -- should be selected.
    PathOptions -> Maybe FilesLimit
filesLimit :: Prelude.Maybe FilesLimit,
    -- | If provided, this structure defines a date range for matching Amazon S3
    -- objects based on their LastModifiedDate attribute in Amazon S3.
    PathOptions -> Maybe FilterExpression
lastModifiedDateCondition :: Prelude.Maybe FilterExpression,
    -- | A structure that maps names of parameters used in the Amazon S3 path of
    -- a dataset to their definitions.
    PathOptions -> Maybe (HashMap Text DatasetParameter)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text DatasetParameter)
  }
  deriving (PathOptions -> PathOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathOptions -> PathOptions -> Bool
$c/= :: PathOptions -> PathOptions -> Bool
== :: PathOptions -> PathOptions -> Bool
$c== :: PathOptions -> PathOptions -> Bool
Prelude.Eq, ReadPrec [PathOptions]
ReadPrec PathOptions
Int -> ReadS PathOptions
ReadS [PathOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PathOptions]
$creadListPrec :: ReadPrec [PathOptions]
readPrec :: ReadPrec PathOptions
$creadPrec :: ReadPrec PathOptions
readList :: ReadS [PathOptions]
$creadList :: ReadS [PathOptions]
readsPrec :: Int -> ReadS PathOptions
$creadsPrec :: Int -> ReadS PathOptions
Prelude.Read, Int -> PathOptions -> ShowS
[PathOptions] -> ShowS
PathOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathOptions] -> ShowS
$cshowList :: [PathOptions] -> ShowS
show :: PathOptions -> String
$cshow :: PathOptions -> String
showsPrec :: Int -> PathOptions -> ShowS
$cshowsPrec :: Int -> PathOptions -> ShowS
Prelude.Show, forall x. Rep PathOptions x -> PathOptions
forall x. PathOptions -> Rep PathOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathOptions x -> PathOptions
$cfrom :: forall x. PathOptions -> Rep PathOptions x
Prelude.Generic)

-- |
-- Create a value of 'PathOptions' 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:
--
-- 'filesLimit', 'pathOptions_filesLimit' - If provided, this structure imposes a limit on a number of files that
-- should be selected.
--
-- 'lastModifiedDateCondition', 'pathOptions_lastModifiedDateCondition' - If provided, this structure defines a date range for matching Amazon S3
-- objects based on their LastModifiedDate attribute in Amazon S3.
--
-- 'parameters', 'pathOptions_parameters' - A structure that maps names of parameters used in the Amazon S3 path of
-- a dataset to their definitions.
newPathOptions ::
  PathOptions
newPathOptions :: PathOptions
newPathOptions =
  PathOptions'
    { $sel:filesLimit:PathOptions' :: Maybe FilesLimit
filesLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDateCondition:PathOptions' :: Maybe FilterExpression
lastModifiedDateCondition = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:PathOptions' :: Maybe (HashMap Text DatasetParameter)
parameters = forall a. Maybe a
Prelude.Nothing
    }

-- | If provided, this structure imposes a limit on a number of files that
-- should be selected.
pathOptions_filesLimit :: Lens.Lens' PathOptions (Prelude.Maybe FilesLimit)
pathOptions_filesLimit :: Lens' PathOptions (Maybe FilesLimit)
pathOptions_filesLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PathOptions' {Maybe FilesLimit
filesLimit :: Maybe FilesLimit
$sel:filesLimit:PathOptions' :: PathOptions -> Maybe FilesLimit
filesLimit} -> Maybe FilesLimit
filesLimit) (\s :: PathOptions
s@PathOptions' {} Maybe FilesLimit
a -> PathOptions
s {$sel:filesLimit:PathOptions' :: Maybe FilesLimit
filesLimit = Maybe FilesLimit
a} :: PathOptions)

-- | If provided, this structure defines a date range for matching Amazon S3
-- objects based on their LastModifiedDate attribute in Amazon S3.
pathOptions_lastModifiedDateCondition :: Lens.Lens' PathOptions (Prelude.Maybe FilterExpression)
pathOptions_lastModifiedDateCondition :: Lens' PathOptions (Maybe FilterExpression)
pathOptions_lastModifiedDateCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PathOptions' {Maybe FilterExpression
lastModifiedDateCondition :: Maybe FilterExpression
$sel:lastModifiedDateCondition:PathOptions' :: PathOptions -> Maybe FilterExpression
lastModifiedDateCondition} -> Maybe FilterExpression
lastModifiedDateCondition) (\s :: PathOptions
s@PathOptions' {} Maybe FilterExpression
a -> PathOptions
s {$sel:lastModifiedDateCondition:PathOptions' :: Maybe FilterExpression
lastModifiedDateCondition = Maybe FilterExpression
a} :: PathOptions)

-- | A structure that maps names of parameters used in the Amazon S3 path of
-- a dataset to their definitions.
pathOptions_parameters :: Lens.Lens' PathOptions (Prelude.Maybe (Prelude.HashMap Prelude.Text DatasetParameter))
pathOptions_parameters :: Lens' PathOptions (Maybe (HashMap Text DatasetParameter))
pathOptions_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PathOptions' {Maybe (HashMap Text DatasetParameter)
parameters :: Maybe (HashMap Text DatasetParameter)
$sel:parameters:PathOptions' :: PathOptions -> Maybe (HashMap Text DatasetParameter)
parameters} -> Maybe (HashMap Text DatasetParameter)
parameters) (\s :: PathOptions
s@PathOptions' {} Maybe (HashMap Text DatasetParameter)
a -> PathOptions
s {$sel:parameters:PathOptions' :: Maybe (HashMap Text DatasetParameter)
parameters = Maybe (HashMap Text DatasetParameter)
a} :: PathOptions) 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

instance Data.FromJSON PathOptions where
  parseJSON :: Value -> Parser PathOptions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PathOptions"
      ( \Object
x ->
          Maybe FilesLimit
-> Maybe FilterExpression
-> Maybe (HashMap Text DatasetParameter)
-> PathOptions
PathOptions'
            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
"FilesLimit")
            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
"LastModifiedDateCondition")
            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
"Parameters" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable PathOptions where
  hashWithSalt :: Int -> PathOptions -> Int
hashWithSalt Int
_salt PathOptions' {Maybe (HashMap Text DatasetParameter)
Maybe FilterExpression
Maybe FilesLimit
parameters :: Maybe (HashMap Text DatasetParameter)
lastModifiedDateCondition :: Maybe FilterExpression
filesLimit :: Maybe FilesLimit
$sel:parameters:PathOptions' :: PathOptions -> Maybe (HashMap Text DatasetParameter)
$sel:lastModifiedDateCondition:PathOptions' :: PathOptions -> Maybe FilterExpression
$sel:filesLimit:PathOptions' :: PathOptions -> Maybe FilesLimit
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FilesLimit
filesLimit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FilterExpression
lastModifiedDateCondition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text DatasetParameter)
parameters

instance Prelude.NFData PathOptions where
  rnf :: PathOptions -> ()
rnf PathOptions' {Maybe (HashMap Text DatasetParameter)
Maybe FilterExpression
Maybe FilesLimit
parameters :: Maybe (HashMap Text DatasetParameter)
lastModifiedDateCondition :: Maybe FilterExpression
filesLimit :: Maybe FilesLimit
$sel:parameters:PathOptions' :: PathOptions -> Maybe (HashMap Text DatasetParameter)
$sel:lastModifiedDateCondition:PathOptions' :: PathOptions -> Maybe FilterExpression
$sel:filesLimit:PathOptions' :: PathOptions -> Maybe FilesLimit
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FilesLimit
filesLimit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FilterExpression
lastModifiedDateCondition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text DatasetParameter)
parameters

instance Data.ToJSON PathOptions where
  toJSON :: PathOptions -> Value
toJSON PathOptions' {Maybe (HashMap Text DatasetParameter)
Maybe FilterExpression
Maybe FilesLimit
parameters :: Maybe (HashMap Text DatasetParameter)
lastModifiedDateCondition :: Maybe FilterExpression
filesLimit :: Maybe FilesLimit
$sel:parameters:PathOptions' :: PathOptions -> Maybe (HashMap Text DatasetParameter)
$sel:lastModifiedDateCondition:PathOptions' :: PathOptions -> Maybe FilterExpression
$sel:filesLimit:PathOptions' :: PathOptions -> Maybe FilesLimit
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FilesLimit" 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 FilesLimit
filesLimit,
            (Key
"LastModifiedDateCondition" 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 FilterExpression
lastModifiedDateCondition,
            (Key
"Parameters" 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 (HashMap Text DatasetParameter)
parameters
          ]
      )