module AWS.Transcribe.Channel where

import AWS.Transcribe.StreamingResponse (StreamingResponse)
import Control.Concurrent.STM (TQueue, atomically, isEmptyTQueue, newTQueue, readTQueue, tryReadTQueue, writeTQueue)
import qualified Data.ByteString.Lazy as BL

{- | An AWS Transcribe channel abstraction.
 Audio `BL.Bytestring`s are written to the channel to be transcribed.
 Transcribed `StreamingResponse`s are read from the channel.
-}
data Channel = MkChannel
    { Channel -> TQueue ByteString
audioQueue :: !(TQueue BL.ByteString)
    , Channel -> TQueue StreamingResponse
responseQueue :: !(TQueue StreamingResponse)
    }

-- | Create a new `Channel`.
newChannel :: IO Channel
newChannel :: IO Channel
newChannel = STM Channel -> IO Channel
forall a. STM a -> IO a
atomically (STM Channel -> IO Channel) -> STM Channel -> IO Channel
forall a b. (a -> b) -> a -> b
$ TQueue ByteString -> TQueue StreamingResponse -> Channel
MkChannel (TQueue ByteString -> TQueue StreamingResponse -> Channel)
-> STM (TQueue ByteString)
-> STM (TQueue StreamingResponse -> Channel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (TQueue ByteString)
forall a. STM (TQueue a)
newTQueue STM (TQueue StreamingResponse -> Channel)
-> STM (TQueue StreamingResponse) -> STM Channel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STM (TQueue StreamingResponse)
forall a. STM (TQueue a)
newTQueue

-- | Read a `StreamingResponse` from the `Channel`
readChannel :: Channel -> IO StreamingResponse
readChannel :: Channel -> IO StreamingResponse
readChannel (MkChannel TQueue ByteString
_ TQueue StreamingResponse
rQ) = STM StreamingResponse -> IO StreamingResponse
forall a. STM a -> IO a
atomically (STM StreamingResponse -> IO StreamingResponse)
-> STM StreamingResponse -> IO StreamingResponse
forall a b. (a -> b) -> a -> b
$ TQueue StreamingResponse -> STM StreamingResponse
forall a. TQueue a -> STM a
readTQueue TQueue StreamingResponse
rQ

-- | Read a `StreamingResponse` from the `Channel` if one is available
tryReadChannel :: Channel -> IO (Maybe StreamingResponse)
tryReadChannel :: Channel -> IO (Maybe StreamingResponse)
tryReadChannel (MkChannel TQueue ByteString
_ TQueue StreamingResponse
rQ) = STM (Maybe StreamingResponse) -> IO (Maybe StreamingResponse)
forall a. STM a -> IO a
atomically (STM (Maybe StreamingResponse) -> IO (Maybe StreamingResponse))
-> STM (Maybe StreamingResponse) -> IO (Maybe StreamingResponse)
forall a b. (a -> b) -> a -> b
$ TQueue StreamingResponse -> STM (Maybe StreamingResponse)
forall a. TQueue a -> STM (Maybe a)
tryReadTQueue TQueue StreamingResponse
rQ

-- | Write an audio `BL.ByteString` to the channel
writeChannel :: Channel -> BL.ByteString -> IO ()
writeChannel :: Channel -> ByteString -> IO ()
writeChannel (MkChannel TQueue ByteString
wQ TQueue StreamingResponse
_) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (ByteString -> STM ()) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue ByteString -> ByteString -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue ByteString
wQ

-- | Is the reading side of the channel empty?
isEmpty :: Channel -> IO Bool
isEmpty :: Channel -> IO Bool
isEmpty (MkChannel TQueue ByteString
_ TQueue StreamingResponse
rQ) = STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TQueue StreamingResponse -> STM Bool
forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue StreamingResponse
rQ