module Buffet.Toolbox.ExceptionTools
  ( eitherThrow
  , sequenceAccumulatingExceptions
  ) where

import qualified Control.Exception as Exception
import qualified Data.Either as Either
import qualified Data.Foldable as Foldable
import qualified Data.List.NonEmpty as NonEmpty
import Prelude
  ( Either
  , IO
  , Show
  , Traversable
  , ($)
  , (.)
  , (>>=)
  , either
  , fmap
  , maybe
  , pure
  , show
  , traverse
  , undefined
  , unlines
  )

newtype ExceptionList =
  ExceptionList (NonEmpty.NonEmpty Exception.SomeException)

instance Show ExceptionList where
  show :: ExceptionList -> String
show (ExceptionList NonEmpty SomeException
exceptions) =
    [String] -> String
unlines ([String] -> String)
-> (NonEmpty String -> [String]) -> NonEmpty String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty String -> String) -> NonEmpty String -> String
forall a b. (a -> b) -> a -> b
$ (SomeException -> String)
-> NonEmpty SomeException -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeException -> String
forall a. Show a => a -> String
show NonEmpty SomeException
exceptions

instance Exception.Exception ExceptionList

eitherThrow :: Exception.Exception e => (a -> e) -> IO (Either a b) -> IO b
eitherThrow :: (a -> e) -> IO (Either a b) -> IO b
eitherThrow a -> e
toException = (IO (Either a b) -> (Either a b -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> IO b) -> (b -> IO b) -> Either a b -> IO b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> IO b
forall e a. Exception e => e -> IO a
Exception.throwIO (e -> IO b) -> (a -> e) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
toException) b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

sequenceAccumulatingExceptions :: Traversable t => t (IO a) -> IO (t a)
sequenceAccumulatingExceptions :: t (IO a) -> IO (t a)
sequenceAccumulatingExceptions t (IO a)
actions = do
  t (Either SomeException a)
results <- (IO a -> IO (Either SomeException a))
-> t (IO a) -> IO (t (Either SomeException a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try t (IO a)
actions
  let successes :: t a
successes = (Either SomeException a -> a) -> t (Either SomeException a) -> t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Either SomeException a -> a
forall b a. b -> Either a b -> b
Either.fromRight a
forall a. HasCallStack => a
undefined) t (Either SomeException a)
results
      failures :: [SomeException]
failures = [Either SomeException a] -> [SomeException]
forall a b. [Either a b] -> [a]
Either.lefts ([Either SomeException a] -> [SomeException])
-> [Either SomeException a] -> [SomeException]
forall a b. (a -> b) -> a -> b
$ t (Either SomeException a) -> [Either SomeException a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList t (Either SomeException a)
results
  IO (t a)
-> (NonEmpty SomeException -> IO (t a))
-> Maybe (NonEmpty SomeException)
-> IO (t a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (t a -> IO (t a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure t a
successes) (ExceptionList -> IO (t a)
forall e a. Exception e => e -> IO a
Exception.throwIO (ExceptionList -> IO (t a))
-> (NonEmpty SomeException -> ExceptionList)
-> NonEmpty SomeException
-> IO (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty SomeException -> ExceptionList
ExceptionList) (Maybe (NonEmpty SomeException) -> IO (t a))
-> Maybe (NonEmpty SomeException) -> IO (t a)
forall a b. (a -> b) -> a -> b
$
    [SomeException] -> Maybe (NonEmpty SomeException)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [SomeException]
failures