{-# 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.Comprehend.DetectSyntax
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Inspects text for syntax and the part of speech of words in the
-- document. For more information, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-syntax.html Syntax>
-- in the Comprehend Developer Guide.
module Amazonka.Comprehend.DetectSyntax
  ( -- * Creating a Request
    DetectSyntax (..),
    newDetectSyntax,

    -- * Request Lenses
    detectSyntax_text,
    detectSyntax_languageCode,

    -- * Destructuring the Response
    DetectSyntaxResponse (..),
    newDetectSyntaxResponse,

    -- * Response Lenses
    detectSyntaxResponse_syntaxTokens,
    detectSyntaxResponse_httpStatus,
  )
where

import Amazonka.Comprehend.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:/ 'newDetectSyntax' smart constructor.
data DetectSyntax = DetectSyntax'
  { -- | A UTF-8 string. The maximum string size is 5 KB.
    DetectSyntax -> Sensitive Text
text :: Data.Sensitive Prelude.Text,
    -- | The language code of the input documents. You can specify any of the
    -- following languages supported by Amazon Comprehend: German (\"de\"),
    -- English (\"en\"), Spanish (\"es\"), French (\"fr\"), Italian (\"it\"),
    -- or Portuguese (\"pt\").
    DetectSyntax -> SyntaxLanguageCode
languageCode :: SyntaxLanguageCode
  }
  deriving (DetectSyntax -> DetectSyntax -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectSyntax -> DetectSyntax -> Bool
$c/= :: DetectSyntax -> DetectSyntax -> Bool
== :: DetectSyntax -> DetectSyntax -> Bool
$c== :: DetectSyntax -> DetectSyntax -> Bool
Prelude.Eq, Int -> DetectSyntax -> ShowS
[DetectSyntax] -> ShowS
DetectSyntax -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectSyntax] -> ShowS
$cshowList :: [DetectSyntax] -> ShowS
show :: DetectSyntax -> String
$cshow :: DetectSyntax -> String
showsPrec :: Int -> DetectSyntax -> ShowS
$cshowsPrec :: Int -> DetectSyntax -> ShowS
Prelude.Show, forall x. Rep DetectSyntax x -> DetectSyntax
forall x. DetectSyntax -> Rep DetectSyntax x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectSyntax x -> DetectSyntax
$cfrom :: forall x. DetectSyntax -> Rep DetectSyntax x
Prelude.Generic)

-- |
-- Create a value of 'DetectSyntax' 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:
--
-- 'text', 'detectSyntax_text' - A UTF-8 string. The maximum string size is 5 KB.
--
-- 'languageCode', 'detectSyntax_languageCode' - The language code of the input documents. You can specify any of the
-- following languages supported by Amazon Comprehend: German (\"de\"),
-- English (\"en\"), Spanish (\"es\"), French (\"fr\"), Italian (\"it\"),
-- or Portuguese (\"pt\").
newDetectSyntax ::
  -- | 'text'
  Prelude.Text ->
  -- | 'languageCode'
  SyntaxLanguageCode ->
  DetectSyntax
newDetectSyntax :: Text -> SyntaxLanguageCode -> DetectSyntax
newDetectSyntax Text
pText_ SyntaxLanguageCode
pLanguageCode_ =
  DetectSyntax'
    { $sel:text:DetectSyntax' :: Sensitive Text
text = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pText_,
      $sel:languageCode:DetectSyntax' :: SyntaxLanguageCode
languageCode = SyntaxLanguageCode
pLanguageCode_
    }

-- | A UTF-8 string. The maximum string size is 5 KB.
detectSyntax_text :: Lens.Lens' DetectSyntax Prelude.Text
detectSyntax_text :: Lens' DetectSyntax Text
detectSyntax_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSyntax' {Sensitive Text
text :: Sensitive Text
$sel:text:DetectSyntax' :: DetectSyntax -> Sensitive Text
text} -> Sensitive Text
text) (\s :: DetectSyntax
s@DetectSyntax' {} Sensitive Text
a -> DetectSyntax
s {$sel:text:DetectSyntax' :: Sensitive Text
text = Sensitive Text
a} :: DetectSyntax) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The language code of the input documents. You can specify any of the
-- following languages supported by Amazon Comprehend: German (\"de\"),
-- English (\"en\"), Spanish (\"es\"), French (\"fr\"), Italian (\"it\"),
-- or Portuguese (\"pt\").
detectSyntax_languageCode :: Lens.Lens' DetectSyntax SyntaxLanguageCode
detectSyntax_languageCode :: Lens' DetectSyntax SyntaxLanguageCode
detectSyntax_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSyntax' {SyntaxLanguageCode
languageCode :: SyntaxLanguageCode
$sel:languageCode:DetectSyntax' :: DetectSyntax -> SyntaxLanguageCode
languageCode} -> SyntaxLanguageCode
languageCode) (\s :: DetectSyntax
s@DetectSyntax' {} SyntaxLanguageCode
a -> DetectSyntax
s {$sel:languageCode:DetectSyntax' :: SyntaxLanguageCode
languageCode = SyntaxLanguageCode
a} :: DetectSyntax)

instance Core.AWSRequest DetectSyntax where
  type AWSResponse DetectSyntax = DetectSyntaxResponse
  request :: (Service -> Service) -> DetectSyntax -> Request DetectSyntax
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 DetectSyntax
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetectSyntax)))
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 [SyntaxToken] -> Int -> DetectSyntaxResponse
DetectSyntaxResponse'
            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
"SyntaxTokens" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DetectSyntax where
  hashWithSalt :: Int -> DetectSyntax -> Int
hashWithSalt Int
_salt DetectSyntax' {Sensitive Text
SyntaxLanguageCode
languageCode :: SyntaxLanguageCode
text :: Sensitive Text
$sel:languageCode:DetectSyntax' :: DetectSyntax -> SyntaxLanguageCode
$sel:text:DetectSyntax' :: DetectSyntax -> Sensitive Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
text
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SyntaxLanguageCode
languageCode

instance Prelude.NFData DetectSyntax where
  rnf :: DetectSyntax -> ()
rnf DetectSyntax' {Sensitive Text
SyntaxLanguageCode
languageCode :: SyntaxLanguageCode
text :: Sensitive Text
$sel:languageCode:DetectSyntax' :: DetectSyntax -> SyntaxLanguageCode
$sel:text:DetectSyntax' :: DetectSyntax -> Sensitive Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
text
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SyntaxLanguageCode
languageCode

instance Data.ToHeaders DetectSyntax where
  toHeaders :: DetectSyntax -> 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
"Comprehend_20171127.DetectSyntax" ::
                          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 DetectSyntax where
  toJSON :: DetectSyntax -> Value
toJSON DetectSyntax' {Sensitive Text
SyntaxLanguageCode
languageCode :: SyntaxLanguageCode
text :: Sensitive Text
$sel:languageCode:DetectSyntax' :: DetectSyntax -> SyntaxLanguageCode
$sel:text:DetectSyntax' :: DetectSyntax -> Sensitive Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
text),
            forall a. a -> Maybe a
Prelude.Just (Key
"LanguageCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SyntaxLanguageCode
languageCode)
          ]
      )

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

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

-- | /See:/ 'newDetectSyntaxResponse' smart constructor.
data DetectSyntaxResponse = DetectSyntaxResponse'
  { -- | A collection of syntax tokens describing the text. For each token, the
    -- response provides the text, the token type, where the text begins and
    -- ends, and the level of confidence that Amazon Comprehend has that the
    -- token is correct. For a list of token types, see
    -- <https://docs.aws.amazon.com/comprehend/latest/dg/how-syntax.html Syntax>
    -- in the Comprehend Developer Guide.
    DetectSyntaxResponse -> Maybe [SyntaxToken]
syntaxTokens :: Prelude.Maybe [SyntaxToken],
    -- | The response's http status code.
    DetectSyntaxResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectSyntaxResponse -> DetectSyntaxResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectSyntaxResponse -> DetectSyntaxResponse -> Bool
$c/= :: DetectSyntaxResponse -> DetectSyntaxResponse -> Bool
== :: DetectSyntaxResponse -> DetectSyntaxResponse -> Bool
$c== :: DetectSyntaxResponse -> DetectSyntaxResponse -> Bool
Prelude.Eq, Int -> DetectSyntaxResponse -> ShowS
[DetectSyntaxResponse] -> ShowS
DetectSyntaxResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectSyntaxResponse] -> ShowS
$cshowList :: [DetectSyntaxResponse] -> ShowS
show :: DetectSyntaxResponse -> String
$cshow :: DetectSyntaxResponse -> String
showsPrec :: Int -> DetectSyntaxResponse -> ShowS
$cshowsPrec :: Int -> DetectSyntaxResponse -> ShowS
Prelude.Show, forall x. Rep DetectSyntaxResponse x -> DetectSyntaxResponse
forall x. DetectSyntaxResponse -> Rep DetectSyntaxResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectSyntaxResponse x -> DetectSyntaxResponse
$cfrom :: forall x. DetectSyntaxResponse -> Rep DetectSyntaxResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectSyntaxResponse' 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:
--
-- 'syntaxTokens', 'detectSyntaxResponse_syntaxTokens' - A collection of syntax tokens describing the text. For each token, the
-- response provides the text, the token type, where the text begins and
-- ends, and the level of confidence that Amazon Comprehend has that the
-- token is correct. For a list of token types, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-syntax.html Syntax>
-- in the Comprehend Developer Guide.
--
-- 'httpStatus', 'detectSyntaxResponse_httpStatus' - The response's http status code.
newDetectSyntaxResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectSyntaxResponse
newDetectSyntaxResponse :: Int -> DetectSyntaxResponse
newDetectSyntaxResponse Int
pHttpStatus_ =
  DetectSyntaxResponse'
    { $sel:syntaxTokens:DetectSyntaxResponse' :: Maybe [SyntaxToken]
syntaxTokens =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectSyntaxResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A collection of syntax tokens describing the text. For each token, the
-- response provides the text, the token type, where the text begins and
-- ends, and the level of confidence that Amazon Comprehend has that the
-- token is correct. For a list of token types, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-syntax.html Syntax>
-- in the Comprehend Developer Guide.
detectSyntaxResponse_syntaxTokens :: Lens.Lens' DetectSyntaxResponse (Prelude.Maybe [SyntaxToken])
detectSyntaxResponse_syntaxTokens :: Lens' DetectSyntaxResponse (Maybe [SyntaxToken])
detectSyntaxResponse_syntaxTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSyntaxResponse' {Maybe [SyntaxToken]
syntaxTokens :: Maybe [SyntaxToken]
$sel:syntaxTokens:DetectSyntaxResponse' :: DetectSyntaxResponse -> Maybe [SyntaxToken]
syntaxTokens} -> Maybe [SyntaxToken]
syntaxTokens) (\s :: DetectSyntaxResponse
s@DetectSyntaxResponse' {} Maybe [SyntaxToken]
a -> DetectSyntaxResponse
s {$sel:syntaxTokens:DetectSyntaxResponse' :: Maybe [SyntaxToken]
syntaxTokens = Maybe [SyntaxToken]
a} :: DetectSyntaxResponse) 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 response's http status code.
detectSyntaxResponse_httpStatus :: Lens.Lens' DetectSyntaxResponse Prelude.Int
detectSyntaxResponse_httpStatus :: Lens' DetectSyntaxResponse Int
detectSyntaxResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectSyntaxResponse' {Int
httpStatus :: Int
$sel:httpStatus:DetectSyntaxResponse' :: DetectSyntaxResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DetectSyntaxResponse
s@DetectSyntaxResponse' {} Int
a -> DetectSyntaxResponse
s {$sel:httpStatus:DetectSyntaxResponse' :: Int
httpStatus = Int
a} :: DetectSyntaxResponse)

instance Prelude.NFData DetectSyntaxResponse where
  rnf :: DetectSyntaxResponse -> ()
rnf DetectSyntaxResponse' {Int
Maybe [SyntaxToken]
httpStatus :: Int
syntaxTokens :: Maybe [SyntaxToken]
$sel:httpStatus:DetectSyntaxResponse' :: DetectSyntaxResponse -> Int
$sel:syntaxTokens:DetectSyntaxResponse' :: DetectSyntaxResponse -> Maybe [SyntaxToken]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SyntaxToken]
syntaxTokens
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus