{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Simplex.Messaging.Util where

import Control.Monad.Except
import Control.Monad.IO.Unlift
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import UnliftIO.Async
import UnliftIO.Exception (Exception)
import qualified UnliftIO.Exception as E

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

instance Exception e => Exception (InternalException e)

instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
  withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b
  withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b
withRunInIO (forall a. ExceptT e m a -> IO a) -> IO b
exceptToIO =
    (InternalException e -> e)
-> ExceptT (InternalException e) m b -> ExceptT e m b
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT InternalException e -> e
forall e. InternalException e -> e
unInternalException (ExceptT (InternalException e) m b -> ExceptT e m b)
-> (m b -> ExceptT (InternalException e) m b)
-> m b
-> ExceptT e m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (InternalException e) b)
-> ExceptT (InternalException e) m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either (InternalException e) b)
 -> ExceptT (InternalException e) m b)
-> (m b -> m (Either (InternalException e) b))
-> m b
-> ExceptT (InternalException e) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> m (Either (InternalException e) b)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try (m b -> ExceptT e m b) -> m b -> ExceptT e m b
forall a b. (a -> b) -> a -> b
$
      ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        (forall a. ExceptT e m a -> IO a) -> IO b
exceptToIO ((forall a. ExceptT e m a -> IO a) -> IO b)
-> (forall a. ExceptT e m a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> (ExceptT e m a -> m a) -> ExceptT e m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (InternalException e -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (InternalException e -> m a)
-> (e -> InternalException e) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> InternalException e
forall e. e -> InternalException e
InternalException) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m a)
-> (ExceptT e m a -> m (Either e a)) -> ExceptT e m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT)

raceAny_ :: MonadUnliftIO m => [m a] -> m ()
raceAny_ :: [m a] -> m ()
raceAny_ = [Async a] -> [m a] -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
[Async a] -> [m a] -> m ()
r []
  where
    r :: [Async a] -> [m a] -> m ()
r [Async a]
as (m a
m : [m a]
ms) = m a -> (Async a -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync m a
m ((Async a -> m ()) -> m ()) -> (Async a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Async a
a -> [Async a] -> [m a] -> m ()
r (Async a
a Async a -> [Async a] -> [Async a]
forall a. a -> [a] -> [a]
: [Async a]
as) [m a]
ms
    r [Async a]
as [] = m (Async a, a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async a, a) -> m ()) -> m (Async a, a) -> m ()
forall a b. (a -> b) -> a -> b
$ [Async a] -> m (Async a, a)
forall (m :: * -> *) a. MonadIO m => [Async a] -> m (Async a, a)
waitAnyCancel [Async a]
as

infixl 4 <$$>, <$?>

(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
<$$> :: (a -> b) -> f (g a) -> f (g b)
(<$$>) = (g a -> g b) -> f (g a) -> f (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g a -> g b) -> f (g a) -> f (g b))
-> ((a -> b) -> g a -> g b) -> (a -> b) -> f (g a) -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

(<$?>) :: MonadFail m => (a -> Either String b) -> m a -> m b
a -> Either String b
f <$?> :: (a -> Either String b) -> m a -> m b
<$?> m a
m = m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> m b) -> (b -> m b) -> Either String b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> m b) -> (a -> Either String b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
f

bshow :: Show a => a -> ByteString
bshow :: a -> ByteString
bshow = String -> ByteString
B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a
liftIOEither :: IO (Either e a) -> m a
liftIOEither IO (Either e a)
a = IO (Either e a) -> m (Either e a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either e a)
a m (Either e a) -> (Either e a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither

liftError :: (MonadIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a
liftError :: (e -> e') -> ExceptT e IO a -> m a
liftError e -> e'
f = (e -> e') -> IO (Either e a) -> m a
forall (m :: * -> *) e' e a.
(MonadIO m, MonadError e' m) =>
(e -> e') -> IO (Either e a) -> m a
liftEitherError e -> e'
f (IO (Either e a) -> m a)
-> (ExceptT e IO a -> IO (Either e a)) -> ExceptT e IO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e IO a -> IO (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

liftEitherError :: (MonadIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a
liftEitherError :: (e -> e') -> IO (Either e a) -> m a
liftEitherError e -> e'
f IO (Either e a)
a = IO (Either e' a) -> m a
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither ((e -> e') -> Either e a -> Either e' a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> e'
f (Either e a -> Either e' a) -> IO (Either e a) -> IO (Either e' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either e a)
a)

tryError :: MonadError e m => m a -> m (Either e a)
tryError :: m a -> m (Either e a)
tryError m a
action = (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action) m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)