{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.GetFolder
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the contents of a specified folder in a repository.
module Amazonka.CodeCommit.GetFolder
  ( -- * Creating a Request
    GetFolder (..),
    newGetFolder,

    -- * Request Lenses
    getFolder_commitSpecifier,
    getFolder_repositoryName,
    getFolder_folderPath,

    -- * Destructuring the Response
    GetFolderResponse (..),
    newGetFolderResponse,

    -- * Response Lenses
    getFolderResponse_files,
    getFolderResponse_subFolders,
    getFolderResponse_subModules,
    getFolderResponse_symbolicLinks,
    getFolderResponse_treeId,
    getFolderResponse_httpStatus,
    getFolderResponse_commitId,
    getFolderResponse_folderPath,
  )
where

import Amazonka.CodeCommit.Types
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
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetFolder' smart constructor.
data GetFolder = GetFolder'
  { -- | A fully qualified reference used to identify a commit that contains the
    -- version of the folder\'s content to return. A fully qualified reference
    -- can be a commit ID, branch name, tag, or reference such as HEAD. If no
    -- specifier is provided, the folder content is returned as it exists in
    -- the HEAD commit.
    GetFolder -> Maybe Text
commitSpecifier :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository.
    GetFolder -> Text
repositoryName :: Prelude.Text,
    -- | The fully qualified path to the folder whose contents are returned,
    -- including the folder name. For example, \/examples is a fully-qualified
    -- path to a folder named examples that was created off of the root
    -- directory (\/) of a repository.
    GetFolder -> Text
folderPath :: Prelude.Text
  }
  deriving (GetFolder -> GetFolder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFolder -> GetFolder -> Bool
$c/= :: GetFolder -> GetFolder -> Bool
== :: GetFolder -> GetFolder -> Bool
$c== :: GetFolder -> GetFolder -> Bool
Prelude.Eq, ReadPrec [GetFolder]
ReadPrec GetFolder
Int -> ReadS GetFolder
ReadS [GetFolder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFolder]
$creadListPrec :: ReadPrec [GetFolder]
readPrec :: ReadPrec GetFolder
$creadPrec :: ReadPrec GetFolder
readList :: ReadS [GetFolder]
$creadList :: ReadS [GetFolder]
readsPrec :: Int -> ReadS GetFolder
$creadsPrec :: Int -> ReadS GetFolder
Prelude.Read, Int -> GetFolder -> ShowS
[GetFolder] -> ShowS
GetFolder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFolder] -> ShowS
$cshowList :: [GetFolder] -> ShowS
show :: GetFolder -> String
$cshow :: GetFolder -> String
showsPrec :: Int -> GetFolder -> ShowS
$cshowsPrec :: Int -> GetFolder -> ShowS
Prelude.Show, forall x. Rep GetFolder x -> GetFolder
forall x. GetFolder -> Rep GetFolder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFolder x -> GetFolder
$cfrom :: forall x. GetFolder -> Rep GetFolder x
Prelude.Generic)

-- |
-- Create a value of 'GetFolder' 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:
--
-- 'commitSpecifier', 'getFolder_commitSpecifier' - A fully qualified reference used to identify a commit that contains the
-- version of the folder\'s content to return. A fully qualified reference
-- can be a commit ID, branch name, tag, or reference such as HEAD. If no
-- specifier is provided, the folder content is returned as it exists in
-- the HEAD commit.
--
-- 'repositoryName', 'getFolder_repositoryName' - The name of the repository.
--
-- 'folderPath', 'getFolder_folderPath' - The fully qualified path to the folder whose contents are returned,
-- including the folder name. For example, \/examples is a fully-qualified
-- path to a folder named examples that was created off of the root
-- directory (\/) of a repository.
newGetFolder ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'folderPath'
  Prelude.Text ->
  GetFolder
newGetFolder :: Text -> Text -> GetFolder
newGetFolder Text
pRepositoryName_ Text
pFolderPath_ =
  GetFolder'
    { $sel:commitSpecifier:GetFolder' :: Maybe Text
commitSpecifier = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:GetFolder' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:folderPath:GetFolder' :: Text
folderPath = Text
pFolderPath_
    }

-- | A fully qualified reference used to identify a commit that contains the
-- version of the folder\'s content to return. A fully qualified reference
-- can be a commit ID, branch name, tag, or reference such as HEAD. If no
-- specifier is provided, the folder content is returned as it exists in
-- the HEAD commit.
getFolder_commitSpecifier :: Lens.Lens' GetFolder (Prelude.Maybe Prelude.Text)
getFolder_commitSpecifier :: Lens' GetFolder (Maybe Text)
getFolder_commitSpecifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolder' {Maybe Text
commitSpecifier :: Maybe Text
$sel:commitSpecifier:GetFolder' :: GetFolder -> Maybe Text
commitSpecifier} -> Maybe Text
commitSpecifier) (\s :: GetFolder
s@GetFolder' {} Maybe Text
a -> GetFolder
s {$sel:commitSpecifier:GetFolder' :: Maybe Text
commitSpecifier = Maybe Text
a} :: GetFolder)

-- | The name of the repository.
getFolder_repositoryName :: Lens.Lens' GetFolder Prelude.Text
getFolder_repositoryName :: Lens' GetFolder Text
getFolder_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolder' {Text
repositoryName :: Text
$sel:repositoryName:GetFolder' :: GetFolder -> Text
repositoryName} -> Text
repositoryName) (\s :: GetFolder
s@GetFolder' {} Text
a -> GetFolder
s {$sel:repositoryName:GetFolder' :: Text
repositoryName = Text
a} :: GetFolder)

-- | The fully qualified path to the folder whose contents are returned,
-- including the folder name. For example, \/examples is a fully-qualified
-- path to a folder named examples that was created off of the root
-- directory (\/) of a repository.
getFolder_folderPath :: Lens.Lens' GetFolder Prelude.Text
getFolder_folderPath :: Lens' GetFolder Text
getFolder_folderPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolder' {Text
folderPath :: Text
$sel:folderPath:GetFolder' :: GetFolder -> Text
folderPath} -> Text
folderPath) (\s :: GetFolder
s@GetFolder' {} Text
a -> GetFolder
s {$sel:folderPath:GetFolder' :: Text
folderPath = Text
a} :: GetFolder)

instance Core.AWSRequest GetFolder where
  type AWSResponse GetFolder = GetFolderResponse
  request :: (Service -> Service) -> GetFolder -> Request GetFolder
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetFolder
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFolder)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [File]
-> Maybe [Folder]
-> Maybe [SubModule]
-> Maybe [SymbolicLink]
-> Maybe Text
-> Int
-> Text
-> Text
-> GetFolderResponse
GetFolderResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"files" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"subFolders" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"subModules" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"symbolicLinks" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"treeId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"commitId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"folderPath")
      )

instance Prelude.Hashable GetFolder where
  hashWithSalt :: Int -> GetFolder -> Int
hashWithSalt Int
_salt GetFolder' {Maybe Text
Text
folderPath :: Text
repositoryName :: Text
commitSpecifier :: Maybe Text
$sel:folderPath:GetFolder' :: GetFolder -> Text
$sel:repositoryName:GetFolder' :: GetFolder -> Text
$sel:commitSpecifier:GetFolder' :: GetFolder -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
commitSpecifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
folderPath

instance Prelude.NFData GetFolder where
  rnf :: GetFolder -> ()
rnf GetFolder' {Maybe Text
Text
folderPath :: Text
repositoryName :: Text
commitSpecifier :: Maybe Text
$sel:folderPath:GetFolder' :: GetFolder -> Text
$sel:repositoryName:GetFolder' :: GetFolder -> Text
$sel:commitSpecifier:GetFolder' :: GetFolder -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
commitSpecifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
folderPath

instance Data.ToHeaders GetFolder where
  toHeaders :: GetFolder -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"CodeCommit_20150413.GetFolder" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetFolder where
  toJSON :: GetFolder -> Value
toJSON GetFolder' {Maybe Text
Text
folderPath :: Text
repositoryName :: Text
commitSpecifier :: Maybe Text
$sel:folderPath:GetFolder' :: GetFolder -> Text
$sel:repositoryName:GetFolder' :: GetFolder -> Text
$sel:commitSpecifier:GetFolder' :: GetFolder -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"commitSpecifier" 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 Text
commitSpecifier,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just (Key
"folderPath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
folderPath)
          ]
      )

instance Data.ToPath GetFolder where
  toPath :: GetFolder -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery GetFolder where
  toQuery :: GetFolder -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetFolderResponse' smart constructor.
data GetFolderResponse = GetFolderResponse'
  { -- | The list of files in the specified folder, if any.
    GetFolderResponse -> Maybe [File]
files :: Prelude.Maybe [File],
    -- | The list of folders that exist under the specified folder, if any.
    GetFolderResponse -> Maybe [Folder]
subFolders :: Prelude.Maybe [Folder],
    -- | The list of submodules in the specified folder, if any.
    GetFolderResponse -> Maybe [SubModule]
subModules :: Prelude.Maybe [SubModule],
    -- | The list of symbolic links to other files and folders in the specified
    -- folder, if any.
    GetFolderResponse -> Maybe [SymbolicLink]
symbolicLinks :: Prelude.Maybe [SymbolicLink],
    -- | The full SHA-1 pointer of the tree information for the commit that
    -- contains the folder.
    GetFolderResponse -> Maybe Text
treeId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetFolderResponse -> Int
httpStatus :: Prelude.Int,
    -- | The full commit ID used as a reference for the returned version of the
    -- folder content.
    GetFolderResponse -> Text
commitId :: Prelude.Text,
    -- | The fully qualified path of the folder whose contents are returned.
    GetFolderResponse -> Text
folderPath :: Prelude.Text
  }
  deriving (GetFolderResponse -> GetFolderResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFolderResponse -> GetFolderResponse -> Bool
$c/= :: GetFolderResponse -> GetFolderResponse -> Bool
== :: GetFolderResponse -> GetFolderResponse -> Bool
$c== :: GetFolderResponse -> GetFolderResponse -> Bool
Prelude.Eq, ReadPrec [GetFolderResponse]
ReadPrec GetFolderResponse
Int -> ReadS GetFolderResponse
ReadS [GetFolderResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFolderResponse]
$creadListPrec :: ReadPrec [GetFolderResponse]
readPrec :: ReadPrec GetFolderResponse
$creadPrec :: ReadPrec GetFolderResponse
readList :: ReadS [GetFolderResponse]
$creadList :: ReadS [GetFolderResponse]
readsPrec :: Int -> ReadS GetFolderResponse
$creadsPrec :: Int -> ReadS GetFolderResponse
Prelude.Read, Int -> GetFolderResponse -> ShowS
[GetFolderResponse] -> ShowS
GetFolderResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFolderResponse] -> ShowS
$cshowList :: [GetFolderResponse] -> ShowS
show :: GetFolderResponse -> String
$cshow :: GetFolderResponse -> String
showsPrec :: Int -> GetFolderResponse -> ShowS
$cshowsPrec :: Int -> GetFolderResponse -> ShowS
Prelude.Show, forall x. Rep GetFolderResponse x -> GetFolderResponse
forall x. GetFolderResponse -> Rep GetFolderResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFolderResponse x -> GetFolderResponse
$cfrom :: forall x. GetFolderResponse -> Rep GetFolderResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFolderResponse' 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:
--
-- 'files', 'getFolderResponse_files' - The list of files in the specified folder, if any.
--
-- 'subFolders', 'getFolderResponse_subFolders' - The list of folders that exist under the specified folder, if any.
--
-- 'subModules', 'getFolderResponse_subModules' - The list of submodules in the specified folder, if any.
--
-- 'symbolicLinks', 'getFolderResponse_symbolicLinks' - The list of symbolic links to other files and folders in the specified
-- folder, if any.
--
-- 'treeId', 'getFolderResponse_treeId' - The full SHA-1 pointer of the tree information for the commit that
-- contains the folder.
--
-- 'httpStatus', 'getFolderResponse_httpStatus' - The response's http status code.
--
-- 'commitId', 'getFolderResponse_commitId' - The full commit ID used as a reference for the returned version of the
-- folder content.
--
-- 'folderPath', 'getFolderResponse_folderPath' - The fully qualified path of the folder whose contents are returned.
newGetFolderResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'commitId'
  Prelude.Text ->
  -- | 'folderPath'
  Prelude.Text ->
  GetFolderResponse
newGetFolderResponse :: Int -> Text -> Text -> GetFolderResponse
newGetFolderResponse
  Int
pHttpStatus_
  Text
pCommitId_
  Text
pFolderPath_ =
    GetFolderResponse'
      { $sel:files:GetFolderResponse' :: Maybe [File]
files = forall a. Maybe a
Prelude.Nothing,
        $sel:subFolders:GetFolderResponse' :: Maybe [Folder]
subFolders = forall a. Maybe a
Prelude.Nothing,
        $sel:subModules:GetFolderResponse' :: Maybe [SubModule]
subModules = forall a. Maybe a
Prelude.Nothing,
        $sel:symbolicLinks:GetFolderResponse' :: Maybe [SymbolicLink]
symbolicLinks = forall a. Maybe a
Prelude.Nothing,
        $sel:treeId:GetFolderResponse' :: Maybe Text
treeId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetFolderResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:commitId:GetFolderResponse' :: Text
commitId = Text
pCommitId_,
        $sel:folderPath:GetFolderResponse' :: Text
folderPath = Text
pFolderPath_
      }

-- | The list of files in the specified folder, if any.
getFolderResponse_files :: Lens.Lens' GetFolderResponse (Prelude.Maybe [File])
getFolderResponse_files :: Lens' GetFolderResponse (Maybe [File])
getFolderResponse_files = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe [File]
files :: Maybe [File]
$sel:files:GetFolderResponse' :: GetFolderResponse -> Maybe [File]
files} -> Maybe [File]
files) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe [File]
a -> GetFolderResponse
s {$sel:files:GetFolderResponse' :: Maybe [File]
files = Maybe [File]
a} :: GetFolderResponse) 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

-- | The list of folders that exist under the specified folder, if any.
getFolderResponse_subFolders :: Lens.Lens' GetFolderResponse (Prelude.Maybe [Folder])
getFolderResponse_subFolders :: Lens' GetFolderResponse (Maybe [Folder])
getFolderResponse_subFolders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe [Folder]
subFolders :: Maybe [Folder]
$sel:subFolders:GetFolderResponse' :: GetFolderResponse -> Maybe [Folder]
subFolders} -> Maybe [Folder]
subFolders) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe [Folder]
a -> GetFolderResponse
s {$sel:subFolders:GetFolderResponse' :: Maybe [Folder]
subFolders = Maybe [Folder]
a} :: GetFolderResponse) 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

-- | The list of submodules in the specified folder, if any.
getFolderResponse_subModules :: Lens.Lens' GetFolderResponse (Prelude.Maybe [SubModule])
getFolderResponse_subModules :: Lens' GetFolderResponse (Maybe [SubModule])
getFolderResponse_subModules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe [SubModule]
subModules :: Maybe [SubModule]
$sel:subModules:GetFolderResponse' :: GetFolderResponse -> Maybe [SubModule]
subModules} -> Maybe [SubModule]
subModules) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe [SubModule]
a -> GetFolderResponse
s {$sel:subModules:GetFolderResponse' :: Maybe [SubModule]
subModules = Maybe [SubModule]
a} :: GetFolderResponse) 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

-- | The list of symbolic links to other files and folders in the specified
-- folder, if any.
getFolderResponse_symbolicLinks :: Lens.Lens' GetFolderResponse (Prelude.Maybe [SymbolicLink])
getFolderResponse_symbolicLinks :: Lens' GetFolderResponse (Maybe [SymbolicLink])
getFolderResponse_symbolicLinks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe [SymbolicLink]
symbolicLinks :: Maybe [SymbolicLink]
$sel:symbolicLinks:GetFolderResponse' :: GetFolderResponse -> Maybe [SymbolicLink]
symbolicLinks} -> Maybe [SymbolicLink]
symbolicLinks) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe [SymbolicLink]
a -> GetFolderResponse
s {$sel:symbolicLinks:GetFolderResponse' :: Maybe [SymbolicLink]
symbolicLinks = Maybe [SymbolicLink]
a} :: GetFolderResponse) 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

-- | The full SHA-1 pointer of the tree information for the commit that
-- contains the folder.
getFolderResponse_treeId :: Lens.Lens' GetFolderResponse (Prelude.Maybe Prelude.Text)
getFolderResponse_treeId :: Lens' GetFolderResponse (Maybe Text)
getFolderResponse_treeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Maybe Text
treeId :: Maybe Text
$sel:treeId:GetFolderResponse' :: GetFolderResponse -> Maybe Text
treeId} -> Maybe Text
treeId) (\s :: GetFolderResponse
s@GetFolderResponse' {} Maybe Text
a -> GetFolderResponse
s {$sel:treeId:GetFolderResponse' :: Maybe Text
treeId = Maybe Text
a} :: GetFolderResponse)

-- | The response's http status code.
getFolderResponse_httpStatus :: Lens.Lens' GetFolderResponse Prelude.Int
getFolderResponse_httpStatus :: Lens' GetFolderResponse Int
getFolderResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetFolderResponse' :: GetFolderResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetFolderResponse
s@GetFolderResponse' {} Int
a -> GetFolderResponse
s {$sel:httpStatus:GetFolderResponse' :: Int
httpStatus = Int
a} :: GetFolderResponse)

-- | The full commit ID used as a reference for the returned version of the
-- folder content.
getFolderResponse_commitId :: Lens.Lens' GetFolderResponse Prelude.Text
getFolderResponse_commitId :: Lens' GetFolderResponse Text
getFolderResponse_commitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Text
commitId :: Text
$sel:commitId:GetFolderResponse' :: GetFolderResponse -> Text
commitId} -> Text
commitId) (\s :: GetFolderResponse
s@GetFolderResponse' {} Text
a -> GetFolderResponse
s {$sel:commitId:GetFolderResponse' :: Text
commitId = Text
a} :: GetFolderResponse)

-- | The fully qualified path of the folder whose contents are returned.
getFolderResponse_folderPath :: Lens.Lens' GetFolderResponse Prelude.Text
getFolderResponse_folderPath :: Lens' GetFolderResponse Text
getFolderResponse_folderPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFolderResponse' {Text
folderPath :: Text
$sel:folderPath:GetFolderResponse' :: GetFolderResponse -> Text
folderPath} -> Text
folderPath) (\s :: GetFolderResponse
s@GetFolderResponse' {} Text
a -> GetFolderResponse
s {$sel:folderPath:GetFolderResponse' :: Text
folderPath = Text
a} :: GetFolderResponse)

instance Prelude.NFData GetFolderResponse where
  rnf :: GetFolderResponse -> ()
rnf GetFolderResponse' {Int
Maybe [File]
Maybe [Folder]
Maybe [SubModule]
Maybe [SymbolicLink]
Maybe Text
Text
folderPath :: Text
commitId :: Text
httpStatus :: Int
treeId :: Maybe Text
symbolicLinks :: Maybe [SymbolicLink]
subModules :: Maybe [SubModule]
subFolders :: Maybe [Folder]
files :: Maybe [File]
$sel:folderPath:GetFolderResponse' :: GetFolderResponse -> Text
$sel:commitId:GetFolderResponse' :: GetFolderResponse -> Text
$sel:httpStatus:GetFolderResponse' :: GetFolderResponse -> Int
$sel:treeId:GetFolderResponse' :: GetFolderResponse -> Maybe Text
$sel:symbolicLinks:GetFolderResponse' :: GetFolderResponse -> Maybe [SymbolicLink]
$sel:subModules:GetFolderResponse' :: GetFolderResponse -> Maybe [SubModule]
$sel:subFolders:GetFolderResponse' :: GetFolderResponse -> Maybe [Folder]
$sel:files:GetFolderResponse' :: GetFolderResponse -> Maybe [File]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [File]
files
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Folder]
subFolders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SubModule]
subModules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SymbolicLink]
symbolicLinks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
treeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
commitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
folderPath