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

module AWS.Transcribe.Alternative where

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

data Alternative = MkAlternative
    { Alternative -> [Item]
_items :: ![Item]
    , Alternative -> Maybe Text
_altTranscript :: !(Maybe T.Text)
    }
    deriving (Alternative -> Alternative -> Bool
(Alternative -> Alternative -> Bool)
-> (Alternative -> Alternative -> Bool) -> Eq Alternative
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alternative -> Alternative -> Bool
$c/= :: Alternative -> Alternative -> Bool
== :: Alternative -> Alternative -> Bool
$c== :: Alternative -> Alternative -> Bool
Eq, Int -> Alternative -> ShowS
[Alternative] -> ShowS
Alternative -> String
(Int -> Alternative -> ShowS)
-> (Alternative -> String)
-> ([Alternative] -> ShowS)
-> Show Alternative
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alternative] -> ShowS
$cshowList :: [Alternative] -> ShowS
show :: Alternative -> String
$cshow :: Alternative -> String
showsPrec :: Int -> Alternative -> ShowS
$cshowsPrec :: Int -> Alternative -> ShowS
Show)
makeLenses ''Alternative

instance FromJSON Alternative where
    parseJSON :: Value -> Parser Alternative
parseJSON (Object Object
o) =
        [Item] -> Maybe Text -> Alternative
MkAlternative
            ([Item] -> Maybe Text -> Alternative)
-> Parser [Item] -> Parser (Maybe Text -> Alternative)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Item]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Items"
            Parser (Maybe Text -> Alternative)
-> Parser (Maybe Text) -> Parser Alternative
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Transcript"
    parseJSON Value
_ = String -> Parser Alternative
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Alternative"

-- For now only send the transcription field and ignore the
-- `Item`s
instance ToJSON Alternative where
    toJSON :: Alternative -> Value
toJSON Alternative
alt =
        [Pair] -> Value
object
            [Text
"Transcript" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Alternative
alt Alternative
-> Getting (Maybe Text) Alternative (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Alternative (Maybe Text)
Lens' Alternative (Maybe Text)
altTranscript)]