{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module AWS.Transcribe.Item where

import Control.Lens (makeLenses)
import Data.Aeson (FromJSON (..), Value (..), (.:?))
import qualified Data.Text as T

{- | A word, phrase, or punctuation mark that is transcribed from the input audio.
 https://docs.aws.amazon.com/transcribe/latest/dg/API_streaming_Item.html
-}
data Item = MkItem
    { -- | A value between 0 and 1 for an `Item` that is a confidence
      -- score that Amazon Transcribe assigns to each word or phrase that it transcribes.
      Item -> Maybe Double
_confidence :: !(Maybe Double)
    , -- | The word or punctuation that was recognized in the input audio.
      Item -> Maybe Text
_content :: !(Maybe T.Text)
    , -- | The offset from the beginning of the audio stream to the end of the
      -- audio that resulted in the item.
      Item -> Maybe Double
_iEndTime :: !(Maybe Double)
    , -- | If speaker identification is enabled, shows the speakers identified
      -- in the real-time stream.
      Item -> Maybe Text
_speaker :: !(Maybe T.Text)
    , -- | If partial result stabilization has been enabled,
      -- indicates whether the word or phrase in the `Item` is stable.
      -- If Stable is true, the result is stable.
      Item -> Maybe Bool
_stable :: !(Maybe Bool)
    , -- | The offset from the beginning of the audio stream to the beginning
      -- of the audio that resulted in the item.
      Item -> Maybe Double
_iStartTime :: !(Maybe Double)
    , -- | The type of the `Item`
      Item -> Maybe ItemType
_itemType :: !(Maybe ItemType)
    , -- | Indicates whether a word in the item matches a word in the vocabulary
      -- filter you've chosen for your real-time stream. If true then a word in
      -- the item matches your vocabulary filter.
      Item -> Maybe Bool
_vocabularyFilterMatch :: !(Maybe Bool)
    }
    deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show, Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq)

-- | The type of the `Item`
data ItemType
    = -- | Indicates that the `Item` is a word that was recognized in the input audio
      Pronunciation
    | -- | Indicates that the `Item` was interpreted as a pause in the input audio
      Punctuation
    deriving (Int -> ItemType -> ShowS
[ItemType] -> ShowS
ItemType -> String
(Int -> ItemType -> ShowS)
-> (ItemType -> String) -> ([ItemType] -> ShowS) -> Show ItemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemType] -> ShowS
$cshowList :: [ItemType] -> ShowS
show :: ItemType -> String
$cshow :: ItemType -> String
showsPrec :: Int -> ItemType -> ShowS
$cshowsPrec :: Int -> ItemType -> ShowS
Show, ItemType -> ItemType -> Bool
(ItemType -> ItemType -> Bool)
-> (ItemType -> ItemType -> Bool) -> Eq ItemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemType -> ItemType -> Bool
$c/= :: ItemType -> ItemType -> Bool
== :: ItemType -> ItemType -> Bool
$c== :: ItemType -> ItemType -> Bool
Eq)

makeLenses ''Item

instance FromJSON ItemType where
    parseJSON :: Value -> Parser ItemType
parseJSON (String Text
s) =
        case Text
s of
            Text
"pronunciation" -> ItemType -> Parser ItemType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ItemType
Pronunciation
            Text
"punctuation" -> ItemType -> Parser ItemType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ItemType
Punctuation
            Text
_ -> String -> Parser ItemType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an ItemType"
    parseJSON Value
_ = String -> Parser ItemType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an ItemType"

instance FromJSON Item where
    parseJSON :: Value -> Parser Item
parseJSON (Object Object
o) = do
        Maybe Double
cnf <- Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Confidence"
        Maybe Text
cnt <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Content"
        Maybe Double
endT <- Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"EndTime"
        Maybe Text
spk <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Speaker"
        Maybe Bool
stb <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Stable"
        Maybe Double
startT <- Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"StartTime"
        Maybe ItemType
tp <- Object
o Object -> Text -> Parser (Maybe ItemType)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Type"
        Maybe Bool
voc <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"VocabularyFilterMatch"
        Item -> Parser Item
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item -> Parser Item) -> Item -> Parser Item
forall a b. (a -> b) -> a -> b
$ Maybe Double
-> Maybe Text
-> Maybe Double
-> Maybe Text
-> Maybe Bool
-> Maybe Double
-> Maybe ItemType
-> Maybe Bool
-> Item
MkItem Maybe Double
cnf Maybe Text
cnt Maybe Double
endT Maybe Text
spk Maybe Bool
stb Maybe Double
startT Maybe ItemType
tp Maybe Bool
voc
    parseJSON Value
_ = String -> Parser Item
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Item"