{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  BroadcastChan.Throw
-- Copyright   :  (C) 2014-2022 Merijn Verstraaten
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Merijn Verstraaten <merijn@inconsistent.nl>
-- Stability   :  experimental
-- Portability :  haha
--
-- This module is identical to "BroadcastChan", but with
-- @BroadcastChan.@'BroadcastChan.writeBChan' and
-- @BroadcastChan.@'BroadcastChan.readBChan' replaced with versions that throw
-- an exception, rather than returning results that the user has to inspect to
-- check for success.
-------------------------------------------------------------------------------
module BroadcastChan.Throw
    ( BChanError(..)
    , readBChan
    , tryReadBChan
    , writeBChan
    -- * Re-exports from "BroadcastChan"
    -- ** Datatypes
    , BroadcastChan
    , Direction(..)
    , In
    , Out
    -- ** Construction
    , newBroadcastChan
    , newBChanListener
    -- ** Basic Operations
    , closeBChan
    , isClosedBChan
    , getBChanContents
    -- ** Parallel processing
    , Action(..)
    , Handler(..)
    , parMapM_
    , parFoldMap
    , parFoldMapM
    -- ** Foldl combinators
    -- | Combinators for use with Tekmo's @foldl@ package.
    , foldBChan
    , foldBChanM
    ) where

import Control.Monad (when)
import Control.Monad.IO.Unlift (MonadIO(..))
import Control.Exception (Exception, throwIO)
import Data.Typeable (Typeable)

import BroadcastChan hiding (writeBChan, readBChan, tryReadBChan)
import qualified BroadcastChan as Internal

-- | Exception type for 'BroadcastChan' operations.
--
-- @since 0.2.0
data BChanError
    = WriteFailed   -- ^ Attempted to write to closed 'BroadcastChan'
    | ReadFailed    -- ^ Attempted to read from an empty closed 'BroadcastChan'
    deriving (BChanError -> BChanError -> Bool
(BChanError -> BChanError -> Bool)
-> (BChanError -> BChanError -> Bool) -> Eq BChanError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BChanError -> BChanError -> Bool
== :: BChanError -> BChanError -> Bool
$c/= :: BChanError -> BChanError -> Bool
/= :: BChanError -> BChanError -> Bool
Eq, ReadPrec [BChanError]
ReadPrec BChanError
Int -> ReadS BChanError
ReadS [BChanError]
(Int -> ReadS BChanError)
-> ReadS [BChanError]
-> ReadPrec BChanError
-> ReadPrec [BChanError]
-> Read BChanError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BChanError
readsPrec :: Int -> ReadS BChanError
$creadList :: ReadS [BChanError]
readList :: ReadS [BChanError]
$creadPrec :: ReadPrec BChanError
readPrec :: ReadPrec BChanError
$creadListPrec :: ReadPrec [BChanError]
readListPrec :: ReadPrec [BChanError]
Read, Int -> BChanError -> ShowS
[BChanError] -> ShowS
BChanError -> String
(Int -> BChanError -> ShowS)
-> (BChanError -> String)
-> ([BChanError] -> ShowS)
-> Show BChanError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BChanError -> ShowS
showsPrec :: Int -> BChanError -> ShowS
$cshow :: BChanError -> String
show :: BChanError -> String
$cshowList :: [BChanError] -> ShowS
showList :: [BChanError] -> ShowS
Show, Typeable)

instance Exception BChanError

-- | Like 'Internal.readBChan', but throws a 'ReadFailed' exception when
-- reading from a closed and empty 'BroadcastChan'.
--
-- @since 0.2.0
readBChan :: MonadIO m => BroadcastChan Out a -> m a
readBChan :: forall (m :: * -> *) a. MonadIO m => BroadcastChan Out a -> m a
readBChan BroadcastChan Out a
ch = do
    Maybe a
result <- BroadcastChan Out a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan Out a -> m (Maybe a)
Internal.readBChan BroadcastChan Out a
ch
    case Maybe a
result of
        Maybe a
Nothing -> IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ BChanError -> IO a
forall e a. Exception e => e -> IO a
throwIO BChanError
ReadFailed
        Just a
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
{-# INLINE readBChan #-}
--
-- | Like 'Internal.tryReadBChan', but throws a 'ReadFailed' exception when
-- reading from a closed and empty 'BroadcastChan'.
--
-- @since 0.3.0
tryReadBChan :: MonadIO m => BroadcastChan Out a -> m (Maybe a)
tryReadBChan :: forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan Out a -> m (Maybe a)
tryReadBChan BroadcastChan Out a
ch = do
    Maybe (Maybe a)
result <- BroadcastChan Out a -> m (Maybe (Maybe a))
forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan Out a -> m (Maybe (Maybe a))
Internal.tryReadBChan BroadcastChan Out a
ch
    case Maybe (Maybe a)
result of
        Maybe (Maybe a)
Nothing -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Just Maybe a
Nothing -> IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ BChanError -> IO (Maybe a)
forall e a. Exception e => e -> IO a
throwIO BChanError
ReadFailed
        Just Maybe a
v -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v
{-# INLINE tryReadBChan #-}

-- | Like 'Internal.writeBChan', but throws a 'WriteFailed' exception when
-- writing to closed 'BroadcastChan'.
--
-- @since 0.2.0
writeBChan :: MonadIO m => BroadcastChan In a -> a -> m ()
writeBChan :: forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan In a -> a -> m ()
writeBChan BroadcastChan In a
ch a
val = do
    Bool
success <- BroadcastChan In a -> a -> m Bool
forall (m :: * -> *) a.
MonadIO m =>
BroadcastChan In a -> a -> m Bool
Internal.writeBChan BroadcastChan In a
ch a
val
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
success) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BChanError -> IO ()
forall e a. Exception e => e -> IO a
throwIO BChanError
WriteFailed
{-# INLINE writeBChan #-}