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

module AWS.Transcribe.StreamingResponse (
    StreamingResponse (..),
    StreamingError (..),
    TranscriptEvent,
    transcript,
    Transcript,
    results,
    Result,
    alternatives,
    channelId,
    endTime,
    isPartial,
    resultId,
    startTime,
    Alternative,
    items,
    altTranscript,
    Item,
    confidence,
    content,
    iEndTime,
    speaker,
    stable,
    iStartTime,
    itemType,
    vocabularyFilterMatch,
    ItemType (..),
) where

import AWS.Transcribe.Alternative
import AWS.Transcribe.EventStream (Message)
import AWS.Transcribe.Item
import Control.Lens (makeLenses, (^.))
import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.:), (.:?), (.=))
import qualified Data.Text as T

newtype TranscriptEvent = MkTranscriptEvent
    {TranscriptEvent -> Transcript
_transcript :: Transcript}
    deriving (TranscriptEvent -> TranscriptEvent -> Bool
(TranscriptEvent -> TranscriptEvent -> Bool)
-> (TranscriptEvent -> TranscriptEvent -> Bool)
-> Eq TranscriptEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TranscriptEvent -> TranscriptEvent -> Bool
$c/= :: TranscriptEvent -> TranscriptEvent -> Bool
== :: TranscriptEvent -> TranscriptEvent -> Bool
$c== :: TranscriptEvent -> TranscriptEvent -> Bool
Eq, Int -> TranscriptEvent -> ShowS
[TranscriptEvent] -> ShowS
TranscriptEvent -> String
(Int -> TranscriptEvent -> ShowS)
-> (TranscriptEvent -> String)
-> ([TranscriptEvent] -> ShowS)
-> Show TranscriptEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TranscriptEvent] -> ShowS
$cshowList :: [TranscriptEvent] -> ShowS
show :: TranscriptEvent -> String
$cshow :: TranscriptEvent -> String
showsPrec :: Int -> TranscriptEvent -> ShowS
$cshowsPrec :: Int -> TranscriptEvent -> ShowS
Show)

instance FromJSON TranscriptEvent where
    parseJSON :: Value -> Parser TranscriptEvent
parseJSON (Object Object
o) =
        Transcript -> TranscriptEvent
MkTranscriptEvent
            (Transcript -> TranscriptEvent)
-> Parser Transcript -> Parser TranscriptEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Transcript
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Transcript"
    parseJSON Value
_ = String -> Parser TranscriptEvent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
" Not a Transcribed"

newtype Transcript = MkTranscript
    {Transcript -> [Result]
_results :: [Result]}
    deriving (Transcript -> Transcript -> Bool
(Transcript -> Transcript -> Bool)
-> (Transcript -> Transcript -> Bool) -> Eq Transcript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transcript -> Transcript -> Bool
$c/= :: Transcript -> Transcript -> Bool
== :: Transcript -> Transcript -> Bool
$c== :: Transcript -> Transcript -> Bool
Eq, Int -> Transcript -> ShowS
[Transcript] -> ShowS
Transcript -> String
(Int -> Transcript -> ShowS)
-> (Transcript -> String)
-> ([Transcript] -> ShowS)
-> Show Transcript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transcript] -> ShowS
$cshowList :: [Transcript] -> ShowS
show :: Transcript -> String
$cshow :: Transcript -> String
showsPrec :: Int -> Transcript -> ShowS
$cshowsPrec :: Int -> Transcript -> ShowS
Show)

instance FromJSON Transcript where
    parseJSON :: Value -> Parser Transcript
parseJSON (Object Object
o) =
        [Result] -> Transcript
MkTranscript
            ([Result] -> Transcript) -> Parser [Result] -> Parser Transcript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Result]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Results"
    parseJSON Value
_ = String -> Parser Transcript
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
" Not a Transcript"

data Result = MkResult
    { Result -> [Alternative]
_alternatives :: ![Alternative]
    , Result -> Maybe Text
_channelId :: !(Maybe T.Text)
    , Result -> Double
_endTime :: !Double
    , Result -> Bool
_isPartial :: !Bool
    , Result -> Text
_resultId :: !T.Text
    , Result -> Double
_startTime :: !Double
    }
    deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

makeLenses ''TranscriptEvent
makeLenses ''Transcript
makeLenses ''Result

instance FromJSON Result where
    parseJSON :: Value -> Parser Result
parseJSON (Object Object
o) = do
        [Alternative]
alt <- Object
o Object -> Text -> Parser [Alternative]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Alternatives"
        Maybe Text
cid <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ChannelId"
        Double
endT <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"EndTime"
        Bool
partial <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"IsPartial"
        Text
rid <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ResultId"
        Double
startT <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"StartTime"
        Result -> Parser Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> Parser Result) -> Result -> Parser Result
forall a b. (a -> b) -> a -> b
$ [Alternative]
-> Maybe Text -> Double -> Bool -> Text -> Double -> Result
MkResult [Alternative]
alt Maybe Text
cid Double
endT Bool
partial Text
rid Double
startT
    parseJSON Value
_ = String -> Parser Result
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
" Not a Result"

instance ToJSON Result where
    toJSON :: Result -> Value
toJSON Result
r =
        [Pair] -> Value
object
            [ Text
"Alternatives" Text -> [Alternative] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Result
r Result
-> Getting [Alternative] Result [Alternative] -> [Alternative]
forall s a. s -> Getting a s a -> a
^. Getting [Alternative] Result [Alternative]
Lens' Result [Alternative]
alternatives)
            , Text
"IsPartial" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Result
r Result -> Getting Bool Result Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Result Bool
Lens' Result Bool
isPartial)
            , Text
"ResultId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Result
r Result -> Getting Text Result Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Result Text
Lens' Result Text
resultId)
            ]

-- |
data StreamingError
    = BadRequestException
    | InternalFailureException
    | LimitExceededException
    | UnrecognizedClientException
    | -- | An error in decoding a `TranscriptEvent`
      TranscriptEventError String
    | -- | An unrecognised exception type or a binary decoding
      -- error. The original message is returned along with a
      -- possible description of the error
      OtherStreamingError Message String
    deriving (StreamingError -> StreamingError -> Bool
(StreamingError -> StreamingError -> Bool)
-> (StreamingError -> StreamingError -> Bool) -> Eq StreamingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamingError -> StreamingError -> Bool
$c/= :: StreamingError -> StreamingError -> Bool
== :: StreamingError -> StreamingError -> Bool
$c== :: StreamingError -> StreamingError -> Bool
Eq, Int -> StreamingError -> ShowS
[StreamingError] -> ShowS
StreamingError -> String
(Int -> StreamingError -> ShowS)
-> (StreamingError -> String)
-> ([StreamingError] -> ShowS)
-> Show StreamingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamingError] -> ShowS
$cshowList :: [StreamingError] -> ShowS
show :: StreamingError -> String
$cshow :: StreamingError -> String
showsPrec :: Int -> StreamingError -> ShowS
$cshowsPrec :: Int -> StreamingError -> ShowS
Show)

data StreamingResponse
    = Event TranscriptEvent
    | Error StreamingError
    | EndOfStream
    deriving (StreamingResponse -> StreamingResponse -> Bool
(StreamingResponse -> StreamingResponse -> Bool)
-> (StreamingResponse -> StreamingResponse -> Bool)
-> Eq StreamingResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamingResponse -> StreamingResponse -> Bool
$c/= :: StreamingResponse -> StreamingResponse -> Bool
== :: StreamingResponse -> StreamingResponse -> Bool
$c== :: StreamingResponse -> StreamingResponse -> Bool
Eq, Int -> StreamingResponse -> ShowS
[StreamingResponse] -> ShowS
StreamingResponse -> String
(Int -> StreamingResponse -> ShowS)
-> (StreamingResponse -> String)
-> ([StreamingResponse] -> ShowS)
-> Show StreamingResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamingResponse] -> ShowS
$cshowList :: [StreamingResponse] -> ShowS
show :: StreamingResponse -> String
$cshow :: StreamingResponse -> String
showsPrec :: Int -> StreamingResponse -> ShowS
$cshowsPrec :: Int -> StreamingResponse -> ShowS
Show)