{-# 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.CodeCommit.Types.ConflictResolution
-- 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.CodeCommit.Types.ConflictResolution where

import Amazonka.CodeCommit.Types.DeleteFileEntry
import Amazonka.CodeCommit.Types.ReplaceContentEntry
import Amazonka.CodeCommit.Types.SetFileModeEntry
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

-- | If AUTOMERGE is the conflict resolution strategy, a list of inputs to
-- use when resolving conflicts during a merge.
--
-- /See:/ 'newConflictResolution' smart constructor.
data ConflictResolution = ConflictResolution'
  { -- | Files to be deleted as part of the merge conflict resolution.
    ConflictResolution -> Maybe [DeleteFileEntry]
deleteFiles :: Prelude.Maybe [DeleteFileEntry],
    -- | Files to have content replaced as part of the merge conflict resolution.
    ConflictResolution -> Maybe [ReplaceContentEntry]
replaceContents :: Prelude.Maybe [ReplaceContentEntry],
    -- | File modes that are set as part of the merge conflict resolution.
    ConflictResolution -> Maybe [SetFileModeEntry]
setFileModes :: Prelude.Maybe [SetFileModeEntry]
  }
  deriving (ConflictResolution -> ConflictResolution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConflictResolution -> ConflictResolution -> Bool
$c/= :: ConflictResolution -> ConflictResolution -> Bool
== :: ConflictResolution -> ConflictResolution -> Bool
$c== :: ConflictResolution -> ConflictResolution -> Bool
Prelude.Eq, ReadPrec [ConflictResolution]
ReadPrec ConflictResolution
Int -> ReadS ConflictResolution
ReadS [ConflictResolution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConflictResolution]
$creadListPrec :: ReadPrec [ConflictResolution]
readPrec :: ReadPrec ConflictResolution
$creadPrec :: ReadPrec ConflictResolution
readList :: ReadS [ConflictResolution]
$creadList :: ReadS [ConflictResolution]
readsPrec :: Int -> ReadS ConflictResolution
$creadsPrec :: Int -> ReadS ConflictResolution
Prelude.Read, Int -> ConflictResolution -> ShowS
[ConflictResolution] -> ShowS
ConflictResolution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConflictResolution] -> ShowS
$cshowList :: [ConflictResolution] -> ShowS
show :: ConflictResolution -> String
$cshow :: ConflictResolution -> String
showsPrec :: Int -> ConflictResolution -> ShowS
$cshowsPrec :: Int -> ConflictResolution -> ShowS
Prelude.Show, forall x. Rep ConflictResolution x -> ConflictResolution
forall x. ConflictResolution -> Rep ConflictResolution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConflictResolution x -> ConflictResolution
$cfrom :: forall x. ConflictResolution -> Rep ConflictResolution x
Prelude.Generic)

-- |
-- Create a value of 'ConflictResolution' 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:
--
-- 'deleteFiles', 'conflictResolution_deleteFiles' - Files to be deleted as part of the merge conflict resolution.
--
-- 'replaceContents', 'conflictResolution_replaceContents' - Files to have content replaced as part of the merge conflict resolution.
--
-- 'setFileModes', 'conflictResolution_setFileModes' - File modes that are set as part of the merge conflict resolution.
newConflictResolution ::
  ConflictResolution
newConflictResolution :: ConflictResolution
newConflictResolution =
  ConflictResolution'
    { $sel:deleteFiles:ConflictResolution' :: Maybe [DeleteFileEntry]
deleteFiles = forall a. Maybe a
Prelude.Nothing,
      $sel:replaceContents:ConflictResolution' :: Maybe [ReplaceContentEntry]
replaceContents = forall a. Maybe a
Prelude.Nothing,
      $sel:setFileModes:ConflictResolution' :: Maybe [SetFileModeEntry]
setFileModes = forall a. Maybe a
Prelude.Nothing
    }

-- | Files to be deleted as part of the merge conflict resolution.
conflictResolution_deleteFiles :: Lens.Lens' ConflictResolution (Prelude.Maybe [DeleteFileEntry])
conflictResolution_deleteFiles :: Lens' ConflictResolution (Maybe [DeleteFileEntry])
conflictResolution_deleteFiles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConflictResolution' {Maybe [DeleteFileEntry]
deleteFiles :: Maybe [DeleteFileEntry]
$sel:deleteFiles:ConflictResolution' :: ConflictResolution -> Maybe [DeleteFileEntry]
deleteFiles} -> Maybe [DeleteFileEntry]
deleteFiles) (\s :: ConflictResolution
s@ConflictResolution' {} Maybe [DeleteFileEntry]
a -> ConflictResolution
s {$sel:deleteFiles:ConflictResolution' :: Maybe [DeleteFileEntry]
deleteFiles = Maybe [DeleteFileEntry]
a} :: ConflictResolution) 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

-- | Files to have content replaced as part of the merge conflict resolution.
conflictResolution_replaceContents :: Lens.Lens' ConflictResolution (Prelude.Maybe [ReplaceContentEntry])
conflictResolution_replaceContents :: Lens' ConflictResolution (Maybe [ReplaceContentEntry])
conflictResolution_replaceContents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConflictResolution' {Maybe [ReplaceContentEntry]
replaceContents :: Maybe [ReplaceContentEntry]
$sel:replaceContents:ConflictResolution' :: ConflictResolution -> Maybe [ReplaceContentEntry]
replaceContents} -> Maybe [ReplaceContentEntry]
replaceContents) (\s :: ConflictResolution
s@ConflictResolution' {} Maybe [ReplaceContentEntry]
a -> ConflictResolution
s {$sel:replaceContents:ConflictResolution' :: Maybe [ReplaceContentEntry]
replaceContents = Maybe [ReplaceContentEntry]
a} :: ConflictResolution) 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

-- | File modes that are set as part of the merge conflict resolution.
conflictResolution_setFileModes :: Lens.Lens' ConflictResolution (Prelude.Maybe [SetFileModeEntry])
conflictResolution_setFileModes :: Lens' ConflictResolution (Maybe [SetFileModeEntry])
conflictResolution_setFileModes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConflictResolution' {Maybe [SetFileModeEntry]
setFileModes :: Maybe [SetFileModeEntry]
$sel:setFileModes:ConflictResolution' :: ConflictResolution -> Maybe [SetFileModeEntry]
setFileModes} -> Maybe [SetFileModeEntry]
setFileModes) (\s :: ConflictResolution
s@ConflictResolution' {} Maybe [SetFileModeEntry]
a -> ConflictResolution
s {$sel:setFileModes:ConflictResolution' :: Maybe [SetFileModeEntry]
setFileModes = Maybe [SetFileModeEntry]
a} :: ConflictResolution) 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 Prelude.Hashable ConflictResolution where
  hashWithSalt :: Int -> ConflictResolution -> Int
hashWithSalt Int
_salt ConflictResolution' {Maybe [DeleteFileEntry]
Maybe [ReplaceContentEntry]
Maybe [SetFileModeEntry]
setFileModes :: Maybe [SetFileModeEntry]
replaceContents :: Maybe [ReplaceContentEntry]
deleteFiles :: Maybe [DeleteFileEntry]
$sel:setFileModes:ConflictResolution' :: ConflictResolution -> Maybe [SetFileModeEntry]
$sel:replaceContents:ConflictResolution' :: ConflictResolution -> Maybe [ReplaceContentEntry]
$sel:deleteFiles:ConflictResolution' :: ConflictResolution -> Maybe [DeleteFileEntry]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DeleteFileEntry]
deleteFiles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ReplaceContentEntry]
replaceContents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SetFileModeEntry]
setFileModes

instance Prelude.NFData ConflictResolution where
  rnf :: ConflictResolution -> ()
rnf ConflictResolution' {Maybe [DeleteFileEntry]
Maybe [ReplaceContentEntry]
Maybe [SetFileModeEntry]
setFileModes :: Maybe [SetFileModeEntry]
replaceContents :: Maybe [ReplaceContentEntry]
deleteFiles :: Maybe [DeleteFileEntry]
$sel:setFileModes:ConflictResolution' :: ConflictResolution -> Maybe [SetFileModeEntry]
$sel:replaceContents:ConflictResolution' :: ConflictResolution -> Maybe [ReplaceContentEntry]
$sel:deleteFiles:ConflictResolution' :: ConflictResolution -> Maybe [DeleteFileEntry]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DeleteFileEntry]
deleteFiles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ReplaceContentEntry]
replaceContents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SetFileModeEntry]
setFileModes

instance Data.ToJSON ConflictResolution where
  toJSON :: ConflictResolution -> Value
toJSON ConflictResolution' {Maybe [DeleteFileEntry]
Maybe [ReplaceContentEntry]
Maybe [SetFileModeEntry]
setFileModes :: Maybe [SetFileModeEntry]
replaceContents :: Maybe [ReplaceContentEntry]
deleteFiles :: Maybe [DeleteFileEntry]
$sel:setFileModes:ConflictResolution' :: ConflictResolution -> Maybe [SetFileModeEntry]
$sel:replaceContents:ConflictResolution' :: ConflictResolution -> Maybe [ReplaceContentEntry]
$sel:deleteFiles:ConflictResolution' :: ConflictResolution -> Maybe [DeleteFileEntry]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"deleteFiles" 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 [DeleteFileEntry]
deleteFiles,
            (Key
"replaceContents" 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 [ReplaceContentEntry]
replaceContents,
            (Key
"setFileModes" 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 [SetFileModeEntry]
setFileModes
          ]
      )