{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Simplex.Messaging.Util
  ( AnyError (..),
    (<$?>),
    ($>>),
    (<$$),
    (<$$>),
    raceAny_,
    bshow,
    tshow,
    maybeWord,
    liftError,
    liftError',
    liftEitherWith,
    ifM,
    whenM,
    unlessM,
    anyM,
    ($>>=),
    mapME,
    bindRight,
    forME,
    mapAccumLM,
    mapAccumLM_List,
    mapAccumLM_NonEmpty,
    tryWriteTBQueue,
    catchAll,
    catchAll_,
    tryAllErrors,
    tryAllErrors',
    catchAllErrors,
    catchAllErrors',
    catchThrow,
    allFinally,
    isOwnException,
    isAsyncCancellation,
    catchOwn',
    catchOwn,
    tryAllOwnErrors,
    tryAllOwnErrors',
    catchAllOwnErrors,
    catchAllOwnErrors',
    eitherToMaybe,
    listToEither,
    firstRow,
    maybeFirstRow,
    maybeFirstRow',
    firstRow',
    groupOn,
    groupOn',
    eqOn,
    groupAllOn,
    toChunks,
    safeDecodeUtf8,
    timeoutThrow,
    threadDelay',
    diffToMicroseconds,
    diffToMilliseconds,
    labelMyThread,
    atomicModifyIORef'_,
    encodeJSON,
    decodeJSON,
    traverseWithKey_,
  ) where

import Control.Exception (AllocationLimitExceeded (..), AsyncException (..))
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Except
import Control.Monad.Trans.State.Strict (StateT (..))
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as J
import Data.Bifunctor (first, second)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.IORef
import Data.Int (Int64)
import Data.List (groupBy, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Time (NominalDiffTime)
import Data.Tuple (swap)
import GHC.Conc (labelThread, myThreadId, threadDelay)
import UnliftIO hiding (atomicModifyIORef')
import qualified UnliftIO.Exception as UE

raceAny_ :: MonadUnliftIO m => [m a] -> m ()
raceAny_ :: forall (m :: * -> *) a. MonadUnliftIO m => [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)
<$$> :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
(<$$>) = (g a -> g b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> f a -> f 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 a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINE (<$$>) #-}

(<$$) :: (Functor f, Functor g) => b -> f (g a) -> f (g b)
<$$ :: forall (f :: * -> *) (g :: * -> *) b a.
(Functor f, Functor g) =>
b -> f (g a) -> f (g b)
(<$$) = (g a -> g b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g a -> g b) -> f (g a) -> f (g b))
-> (b -> g a -> g b) -> b -> f (g a) -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> g a -> g b) -> (b -> a -> b) -> b -> g a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall a b. a -> b -> a
const
{-# INLINE (<$$) #-}

(<$?>) :: MonadFail m => (a -> Either String b) -> m a -> m b
a -> Either String b
f <$?> :: forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> m a
m = (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 a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail b -> m b
forall a. a -> m a
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 (a -> m b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
m
{-# INLINE (<$?>) #-}

bshow :: Show a => a -> ByteString
bshow :: forall a. Show a => 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
{-# INLINE bshow #-}

tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
{-# INLINE tshow #-}

maybeWord :: (a -> ByteString) -> Maybe a -> ByteString
maybeWord :: forall a. (a -> ByteString) -> Maybe a -> ByteString
maybeWord a -> ByteString
f = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ((a -> ByteString) -> Maybe a -> ByteString)
-> (a -> ByteString) -> Maybe a -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> ByteString
B.cons Char
' ' (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
f
{-# INLINE maybeWord #-}

liftError :: MonadIO m => (e -> e') -> ExceptT e IO a -> ExceptT e' m a
liftError :: forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> ExceptT e IO a -> ExceptT e' m a
liftError e -> e'
f = (e -> e') -> IO (Either e a) -> ExceptT e' m a
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> IO (Either e a) -> ExceptT e' m a
liftError' e -> e'
f (IO (Either e a) -> ExceptT e' m a)
-> (ExceptT e IO a -> IO (Either e a))
-> ExceptT e IO a
-> ExceptT e' 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
{-# INLINE liftError #-}

liftError' :: MonadIO m => (e -> e') -> IO (Either e a) -> ExceptT e' m a
liftError' :: forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> IO (Either e a) -> ExceptT e' m a
liftError' e -> e'
f = m (Either e' a) -> ExceptT e' m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e' a) -> ExceptT e' m a)
-> (IO (Either e a) -> m (Either e' a))
-> IO (Either e a)
-> ExceptT e' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either e a -> Either e' a) -> m (Either e a) -> m (Either e' a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> e') -> Either e a -> Either e' a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> e'
f) (m (Either e a) -> m (Either e' a))
-> (IO (Either e a) -> m (Either e a))
-> IO (Either e a)
-> m (Either e' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either e a) -> m (Either e a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE liftError' #-}

liftEitherWith :: MonadIO m => (e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith :: forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith e -> e'
f = Either e' a -> ExceptT e' m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either e' a -> ExceptT e' m a)
-> (Either e a -> Either e' a) -> Either e a -> ExceptT e' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> e') -> Either e a -> Either e' a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> e'
f
{-# INLINE liftEitherWith #-}

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
ba m a
t m a
f = m Bool
ba m Bool -> (Bool -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m a
t else m a
f
{-# INLINE ifM #-}

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
b m ()
a = m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
b m ()
a (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE whenM #-}

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
b = m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
b (m () -> m () -> m ()) -> m () -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE unlessM #-}

anyM :: Monad m => [m Bool] -> m Bool
anyM :: forall (m :: * -> *). Monad m => [m Bool] -> m Bool
anyM = (Bool -> m Bool -> m Bool) -> Bool -> [m Bool] -> m Bool
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Bool
r m Bool
a -> if Bool
r then Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
r else (Bool
r Bool -> Bool -> Bool
||) (Bool -> Bool) -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> m Bool
a) Bool
False
{-# INLINE anyM #-}

infixl 1 $>>, $>>=

($>>=) :: (Monad m, Monad f, Traversable f) => m (f a) -> (a -> m (f b)) -> m (f b)
m (f a)
f $>>= :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= a -> m (f b)
g = m (f a)
f m (f a) -> (f a -> m (f b)) -> m (f b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (f (f b) -> f b) -> m (f (f b)) -> m (f b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (f b) -> f b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (f (f b)) -> m (f b)) -> (f a -> m (f (f b))) -> f a -> m (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (f b)) -> f a -> m (f (f b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM a -> m (f b)
g
{-# INLINE ($>>=) #-}

($>>) :: (Monad m, Monad f, Traversable f) => m (f a) -> m (f b) -> m (f b)
m (f a)
f $>> :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> m (f b) -> m (f b)
$>> m (f b)
g = m (f a)
f m (f a) -> (a -> m (f b)) -> m (f b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \a
_ -> m (f b)
g
{-# INLINE ($>>) #-}

mapME :: (Monad m, Traversable t) => (a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b))
mapME :: forall (m :: * -> *) (t :: * -> *) a e b.
(Monad m, Traversable t) =>
(a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b))
mapME a -> m (Either e b)
f = (Either e a -> m (Either e b))
-> t (Either e a) -> m (t (Either e b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM ((a -> m (Either e b)) -> Either e a -> m (Either e b)
forall (m :: * -> *) a e b.
Monad m =>
(a -> m (Either e b)) -> Either e a -> m (Either e b)
bindRight a -> m (Either e b)
f)
{-# INLINE mapME #-}

bindRight :: Monad m => (a -> m (Either e b)) -> Either e a -> m (Either e b)
bindRight :: forall (m :: * -> *) a e b.
Monad m =>
(a -> m (Either e b)) -> Either e a -> m (Either e b)
bindRight = (e -> m (Either e b))
-> (a -> m (Either e b)) -> Either e a -> m (Either e b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e b -> m (Either e b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e b -> m (Either e b))
-> (e -> Either e b) -> e -> m (Either e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e b
forall a b. a -> Either a b
Left)
{-# INLINE bindRight #-}

forME :: (Monad m, Traversable t) => t (Either e a) -> (a -> m (Either e b)) -> m (t (Either e b))
forME :: forall (m :: * -> *) (t :: * -> *) e a b.
(Monad m, Traversable t) =>
t (Either e a) -> (a -> m (Either e b)) -> m (t (Either e b))
forME = ((a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b)))
-> t (Either e a) -> (a -> m (Either e b)) -> m (t (Either e b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b))
forall (m :: * -> *) (t :: * -> *) a e b.
(Monad m, Traversable t) =>
(a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b))
mapME
{-# INLINE forME #-}

-- | Monadic version of mapAccumL
-- Copied from ghc-9.6.3 package: https://hackage.haskell.org/package/ghc-9.12.1/docs/GHC-Utils-Monad.html#v:mapAccumLM
-- for backward compatibility with 8.10.7.
mapAccumLM ::
  (Monad m, Traversable t) =>
  -- | combining function
  (acc -> x -> m (acc, y)) ->
  -- | initial state
  acc ->
  -- | inputs
  t x ->
  -- | final state, outputs
  m (acc, t y)
{-# INLINE [1] mapAccumLM #-}
-- INLINE pragma.  mapAccumLM is called in inner loops.  Like 'map',
-- we inline it so that we can take advantage of knowing 'f'.
-- This makes a few percent difference (in compiler allocations)
-- when compiling perf/compiler/T9675
mapAccumLM :: forall (m :: * -> *) (t :: * -> *) acc x y.
(Monad m, Traversable t) =>
(acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
mapAccumLM acc -> x -> m (acc, y)
f acc
s = ((t y, acc) -> (acc, t y)) -> m (t y, acc) -> m (acc, t y)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t y, acc) -> (acc, t y)
forall a b. (a, b) -> (b, a)
swap (m (t y, acc) -> m (acc, t y))
-> (t x -> m (t y, acc)) -> t x -> m (acc, t y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT acc m (t y) -> acc -> m (t y, acc))
-> acc -> StateT acc m (t y) -> m (t y, acc)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT acc m (t y) -> acc -> m (t y, acc)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT acc
s (StateT acc m (t y) -> m (t y, acc))
-> (t x -> StateT acc m (t y)) -> t x -> m (t y, acc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> StateT acc m y) -> t x -> StateT acc m (t y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse x -> StateT acc m y
f'
  where
    f' :: x -> StateT acc m y
f' = (acc -> m (y, acc)) -> StateT acc m y
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((acc -> m (y, acc)) -> StateT acc m y)
-> (x -> acc -> m (y, acc)) -> x -> StateT acc m y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((m (acc, y) -> m (y, acc))
-> (acc -> m (acc, y)) -> acc -> m (y, acc)
forall a b. (a -> b) -> (acc -> a) -> acc -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m (acc, y) -> m (y, acc))
 -> (acc -> m (acc, y)) -> acc -> m (y, acc))
-> (((acc, y) -> (y, acc)) -> m (acc, y) -> m (y, acc))
-> ((acc, y) -> (y, acc))
-> (acc -> m (acc, y))
-> acc
-> m (y, acc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((acc, y) -> (y, acc)) -> m (acc, y) -> m (y, acc)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (acc, y) -> (y, acc)
forall a b. (a, b) -> (b, a)
swap ((acc -> m (acc, y)) -> acc -> m (y, acc))
-> (x -> acc -> m (acc, y)) -> x -> acc -> m (y, acc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (acc -> x -> m (acc, y)) -> x -> acc -> m (acc, y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip acc -> x -> m (acc, y)
f

{-# RULES "mapAccumLM/List" mapAccumLM = mapAccumLM_List #-}
{-# RULES "mapAccumLM/NonEmpty" mapAccumLM = mapAccumLM_NonEmpty #-}

mapAccumLM_List ::
  Monad m =>
  (acc -> x -> m (acc, y)) ->
  acc ->
  [x] ->
  m (acc, [y])
{-# INLINE mapAccumLM_List #-}
mapAccumLM_List :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM_List acc -> x -> m (acc, y)
f = acc -> [x] -> m (acc, [y])
go
  where
    go :: acc -> [x] -> m (acc, [y])
go acc
s (x
x : [x]
xs) = do
      (acc
s1, y
x') <- acc -> x -> m (acc, y)
f acc
s x
x
      (acc
s2, [y]
xs') <- acc -> [x] -> m (acc, [y])
go acc
s1 [x]
xs
      (acc, [y]) -> m (acc, [y])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s2, y
x' y -> [y] -> [y]
forall a. a -> [a] -> [a]
: [y]
xs')
    go acc
s [] = (acc, [y]) -> m (acc, [y])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, [])

mapAccumLM_NonEmpty ::
  Monad m =>
  (acc -> x -> m (acc, y)) ->
  acc ->
  NonEmpty x ->
  m (acc, NonEmpty y)
{-# INLINE mapAccumLM_NonEmpty #-}
mapAccumLM_NonEmpty :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y))
-> acc -> NonEmpty x -> m (acc, NonEmpty y)
mapAccumLM_NonEmpty acc -> x -> m (acc, y)
f acc
s (x
x :| [x]
xs) =
  [(acc
s2, y
x' y -> [y] -> NonEmpty y
forall a. a -> [a] -> NonEmpty a
:| [y]
xs') | (acc
s1, y
x') <- acc -> x -> m (acc, y)
f acc
s x
x, (acc
s2, [y]
xs') <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM_List acc -> x -> m (acc, y)
f acc
s1 [x]
xs]

tryWriteTBQueue :: TBQueue a -> a -> STM Bool
tryWriteTBQueue :: forall a. TBQueue a -> a -> STM Bool
tryWriteTBQueue TBQueue a
q a
a = do
  Bool
full <- TBQueue a -> STM Bool
forall a. TBQueue a -> STM Bool
isFullTBQueue TBQueue a
q
  Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
full (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ TBQueue a -> a -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue a
q a
a
  Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> STM Bool) -> Bool -> STM Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
full
{-# INLINE tryWriteTBQueue #-}

catchAll :: IO a -> (E.SomeException -> IO a) -> IO a
catchAll :: forall a. IO a -> (SomeException -> IO a) -> IO a
catchAll = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
{-# INLINE catchAll #-}

catchAll_ :: IO a -> IO a -> IO a
catchAll_ :: forall a. IO a -> IO a -> IO a
catchAll_ IO a
a = IO a -> (SomeException -> IO a) -> IO a
forall a. IO a -> (SomeException -> IO a) -> IO a
catchAll IO a
a ((SomeException -> IO a) -> IO a)
-> (IO a -> SomeException -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> SomeException -> IO a
forall a b. a -> b -> a
const
{-# INLINE catchAll_ #-}

class Show e => AnyError e where fromSomeException :: E.SomeException -> e

tryAllErrors :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ExceptT e m a
action = m (Either e (Either e a)) -> ExceptT e m (Either e a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e (Either e a)) -> ExceptT e m (Either e a))
-> m (Either e (Either e a)) -> ExceptT e m (Either e a)
forall a b. (a -> b) -> a -> b
$ Either e a -> Either e (Either e a)
forall a b. b -> Either a b
Right (Either e a -> Either e (Either e a))
-> m (Either e a) -> m (Either e (Either e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
action m (Either e a)
-> (SomeException -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`UE.catch` (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (SomeException -> Either e a) -> SomeException -> 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 (e -> Either e a)
-> (SomeException -> e) -> SomeException -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> e
forall e. AnyError e => SomeException -> e
fromSomeException)
{-# INLINE tryAllErrors #-}

tryAllErrors' :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> m (Either e a)
tryAllErrors' :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> m (Either e a)
tryAllErrors' ExceptT e m a
action = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
action m (Either e a)
-> (SomeException -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`UE.catch` (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (SomeException -> Either e a) -> SomeException -> 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 (e -> Either e a)
-> (SomeException -> e) -> SomeException -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> e
forall e. AnyError e => SomeException -> e
fromSomeException)
{-# INLINE tryAllErrors' #-}

catchAllErrors :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllErrors :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllErrors ExceptT e m a
action e -> ExceptT e m a
handler = ExceptT e m a -> ExceptT e m (Either e a)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ExceptT e m a
action ExceptT e m (Either e a)
-> (Either e a -> ExceptT e m a) -> ExceptT e m a
forall a b. ExceptT e m a -> (a -> ExceptT e m b) -> ExceptT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> ExceptT e m a)
-> (a -> ExceptT e m a) -> Either e a -> ExceptT e m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> ExceptT e m a
handler a -> ExceptT e m a
forall a. a -> ExceptT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE catchAllErrors #-}

catchAllErrors' :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> (e -> m a) -> m a
catchAllErrors' :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> m a) -> m a
catchAllErrors' ExceptT e m a
action e -> m a
handler = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> m (Either e a)
tryAllErrors' ExceptT e m a
action m (Either e a) -> (Either e a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
handler a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE catchAllErrors' #-}

catchThrow :: MonadUnliftIO m => ExceptT e m a -> (SomeException -> e) -> ExceptT e m a
ExceptT e m a
action catchThrow :: forall (m :: * -> *) e a.
MonadUnliftIO m =>
ExceptT e m a -> (SomeException -> e) -> ExceptT e m a
`catchThrow` SomeException -> e
err = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
action m (Either e a)
-> (SomeException -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`UE.catch` (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (SomeException -> Either e a) -> SomeException -> 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 (e -> Either e a)
-> (SomeException -> e) -> SomeException -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> e
err)
{-# INLINE catchThrow #-}

allFinally :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> ExceptT e m b -> ExceptT e m a
allFinally :: forall e (m :: * -> *) a b.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m b -> ExceptT e m a
allFinally ExceptT e m a
action ExceptT e m b
final = ExceptT e m a -> ExceptT e m (Either e a)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ExceptT e m a
action ExceptT e m (Either e a)
-> (Either e a -> ExceptT e m a) -> ExceptT e m a
forall a b. ExceptT e m a -> (a -> ExceptT e m b) -> ExceptT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either e a
r -> ExceptT e m b
final ExceptT e m b -> ExceptT e m a -> ExceptT e m a
forall a b. ExceptT e m a -> ExceptT e m b -> ExceptT e m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either e a -> ExceptT e m a
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except Either e a
r
{-# INLINE allFinally #-}

isOwnException :: E.SomeException -> Bool
isOwnException :: SomeException -> Bool
isOwnException SomeException
e = case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
e of
  Just AsyncException
StackOverflow -> Bool
True
  Just AsyncException
HeapOverflow -> Bool
True
  Maybe AsyncException
_ -> case SomeException -> Maybe AllocationLimitExceeded
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
e of
    Just AllocationLimitExceeded
AllocationLimitExceeded -> Bool
True
    Maybe AllocationLimitExceeded
_ -> Bool
False
{-# INLINE isOwnException #-}

isAsyncCancellation :: E.SomeException -> Bool
isAsyncCancellation :: SomeException -> Bool
isAsyncCancellation SomeException
e = case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
e of
  Just (SomeAsyncException
_ :: SomeAsyncException) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SomeException -> Bool
isOwnException SomeException
e
  Maybe SomeAsyncException
Nothing -> Bool
False
{-# INLINE isAsyncCancellation #-}

catchOwn' :: IO a -> (E.SomeException -> IO a) -> IO a
catchOwn' :: forall a. IO a -> (SomeException -> IO a) -> IO a
catchOwn' IO a
action SomeException -> IO a
handleInternal = IO a
action IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> if SomeException -> Bool
isAsyncCancellation SomeException
e then SomeException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e else SomeException -> IO a
handleInternal SomeException
e
{-# INLINE catchOwn' #-}

catchOwn :: MonadUnliftIO m => m a -> (E.SomeException -> m a) -> m a
catchOwn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
catchOwn m a
action SomeException -> m a
handleInternal =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall 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 a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
    m a -> IO a
forall a. m a -> IO a
run m a
action IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> if SomeException -> Bool
isAsyncCancellation SomeException
e then SomeException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e else m a -> IO a
forall a. m a -> IO a
run (SomeException -> m a
handleInternal SomeException
e)
{-# INLINE catchOwn #-}

tryAllOwnErrors :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> ExceptT e m (Either e a)
tryAllOwnErrors :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllOwnErrors ExceptT e m a
action = m (Either e (Either e a)) -> ExceptT e m (Either e a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e (Either e a)) -> ExceptT e m (Either e a))
-> m (Either e (Either e a)) -> ExceptT e m (Either e a)
forall a b. (a -> b) -> a -> b
$ Either e a -> Either e (Either e a)
forall a b. b -> Either a b
Right (Either e a -> Either e (Either e a))
-> m (Either e a) -> m (Either e (Either e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
action m (Either e a)
-> (SomeException -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchOwn` (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (SomeException -> Either e a) -> SomeException -> 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 (e -> Either e a)
-> (SomeException -> e) -> SomeException -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> e
forall e. AnyError e => SomeException -> e
fromSomeException)
{-# INLINE tryAllOwnErrors #-}

tryAllOwnErrors' :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> m (Either e a)
tryAllOwnErrors' :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> m (Either e a)
tryAllOwnErrors' ExceptT e m a
action = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
action m (Either e a)
-> (SomeException -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchOwn` (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (SomeException -> Either e a) -> SomeException -> 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 (e -> Either e a)
-> (SomeException -> e) -> SomeException -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> e
forall e. AnyError e => SomeException -> e
fromSomeException)
{-# INLINE tryAllOwnErrors' #-}

catchAllOwnErrors :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllOwnErrors :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllOwnErrors ExceptT e m a
action e -> ExceptT e m a
handler = ExceptT e m a -> ExceptT e m (Either e a)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllOwnErrors ExceptT e m a
action ExceptT e m (Either e a)
-> (Either e a -> ExceptT e m a) -> ExceptT e m a
forall a b. ExceptT e m a -> (a -> ExceptT e m b) -> ExceptT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> ExceptT e m a)
-> (a -> ExceptT e m a) -> Either e a -> ExceptT e m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> ExceptT e m a
handler a -> ExceptT e m a
forall a. a -> ExceptT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE catchAllOwnErrors #-}

catchAllOwnErrors' :: (AnyError e, MonadUnliftIO m) => ExceptT e m a -> (e -> m a) -> m a
catchAllOwnErrors' :: forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> m a) -> m a
catchAllOwnErrors' ExceptT e m a
action e -> m a
handler = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> m (Either e a)
tryAllOwnErrors' ExceptT e m a
action m (Either e a) -> (Either e a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
handler a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE catchAllOwnErrors' #-}

eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: forall a b. Either a b -> Maybe b
eitherToMaybe = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just
{-# INLINE eitherToMaybe #-}

listToEither :: e -> [a] -> Either e a
listToEither :: forall e a. e -> [a] -> Either e a
listToEither e
_ (a
x : [a]
_) = a -> Either e a
forall a b. b -> Either a b
Right a
x
listToEither e
e [a]
_ = e -> Either e a
forall a b. a -> Either a b
Left e
e

firstRow :: (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow :: forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow a -> b
f e
e IO [a]
a = (a -> b) -> Either e a -> Either e b
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second a -> b
f (Either e a -> Either e b)
-> ([a] -> Either e a) -> [a] -> Either e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> [a] -> Either e a
forall e a. e -> [a] -> Either e a
listToEither e
e ([a] -> Either e b) -> IO [a] -> IO (Either e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [a]
a

maybeFirstRow :: Functor f => (a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow a -> b
f f [a]
q = (a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b) -> ([a] -> Maybe a) -> [a] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe b) -> f [a] -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
q

maybeFirstRow' :: Functor f => b -> (a -> b) -> f [a] -> f b
maybeFirstRow' :: forall (f :: * -> *) b a.
Functor f =>
b -> (a -> b) -> f [a] -> f b
maybeFirstRow' b
def a -> b
f f [a]
q = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
def a -> b
f (Maybe a -> b) -> ([a] -> Maybe a) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> b) -> f [a] -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
q

firstRow' :: (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' :: forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' a -> Either e b
f e
e IO [a]
a = (a -> Either e b
f (a -> Either e b) -> ([a] -> Either e a) -> [a] -> Either e b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< e -> [a] -> Either e a
forall e a. e -> [a] -> Either e a
listToEither e
e) ([a] -> Either e b) -> IO [a] -> IO (Either e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [a]
a

groupOn :: Eq k => (a -> k) -> [a] -> [[a]]
groupOn :: forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((a -> a -> Bool) -> [a] -> [[a]])
-> ((a -> k) -> a -> a -> Bool) -> (a -> k) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> a -> a -> Bool
forall k a. Eq k => (a -> k) -> a -> a -> Bool
eqOn

groupOn' :: Eq k => (a -> k) -> [a] -> [NonEmpty a]
groupOn' :: forall k a. Eq k => (a -> k) -> [a] -> [NonEmpty a]
groupOn' = (a -> a -> Bool) -> [a] -> [NonEmpty a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
L.groupBy ((a -> a -> Bool) -> [a] -> [NonEmpty a])
-> ((a -> k) -> a -> a -> Bool) -> (a -> k) -> [a] -> [NonEmpty a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> a -> a -> Bool
forall k a. Eq k => (a -> k) -> a -> a -> Bool
eqOn

-- it is equivalent to groupBy ((==) `on` f),
-- but it redefines `on` to avoid duplicate computation for most values.
-- source: https://hackage.haskell.org/package/extra-1.7.13/docs/src/Data.List.Extra.html#groupOn
-- the on2 in this package is specialized to only use `==` as the function, `eqOn f` is equivalent to `(==) `on` f`
eqOn :: Eq k => (a -> k) -> a -> a -> Bool
eqOn :: forall k a. Eq k => (a -> k) -> a -> a -> Bool
eqOn a -> k
f a
x = let fx :: k
fx = a -> k
f a
x in \a
y -> k
fx k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== a -> k
f a
y
{-# INLINE eqOn #-}

groupAllOn :: Ord k => (a -> k) -> [a] -> [[a]]
groupAllOn :: forall k a. Ord k => (a -> k) -> [a] -> [[a]]
groupAllOn a -> k
f = (a -> k) -> [a] -> [[a]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn a -> k
f ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn a -> k
f

-- n must be > 0
toChunks :: Int -> [a] -> [NonEmpty a]
toChunks :: forall a. Int -> [a] -> [NonEmpty a]
toChunks Int
_ [] = []
toChunks Int
0 (a
x : [a]
xs) = [a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs]
toChunks Int
n [a]
xs =
  let ([a]
ys, [a]
xs') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
   in ([NonEmpty a] -> [NonEmpty a])
-> (NonEmpty a -> [NonEmpty a] -> [NonEmpty a])
-> Maybe (NonEmpty a)
-> [NonEmpty a]
-> [NonEmpty a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [NonEmpty a] -> [NonEmpty a]
forall a. a -> a
id (:) ([a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [a]
ys) (Int -> [a] -> [NonEmpty a]
forall a. Int -> [a] -> [NonEmpty a]
toChunks Int
n [a]
xs')

safeDecodeUtf8 :: ByteString -> Text
safeDecodeUtf8 :: ByteString -> Text
safeDecodeUtf8 = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
forall {p} {p}. p -> p -> Maybe Char
onError
  where
    onError :: p -> p -> Maybe Char
onError p
_ p
_ = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'?'
{-# INLINE safeDecodeUtf8 #-}

timeoutThrow :: MonadUnliftIO m => e -> Int -> ExceptT e m a -> ExceptT e m a
timeoutThrow :: forall (m :: * -> *) e a.
MonadUnliftIO m =>
e -> Int -> ExceptT e m a -> ExceptT e m a
timeoutThrow e
e Int
ms ExceptT e m a
action = m (Either e (Maybe a)) -> ExceptT e m (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Maybe (Either e a) -> Either e (Maybe a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence (Maybe (Either e a) -> Either e (Maybe a))
-> m (Maybe (Either e a)) -> m (Either e (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
ms Int -> m (Either e a) -> m (Maybe (Either e a))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
`timeout` ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
action)) ExceptT e m (Maybe a)
-> (Maybe a -> ExceptT e m a) -> ExceptT e m a
forall a b. ExceptT e m a -> (a -> ExceptT e m b) -> ExceptT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT e m a -> (a -> ExceptT e m a) -> Maybe a -> ExceptT e m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> ExceptT e m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e) a -> ExceptT e m a
forall a. a -> ExceptT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

threadDelay' :: Int64 -> IO ()
threadDelay' :: Int64 -> IO ()
threadDelay' = Int64 -> IO ()
forall {a}. Integral a => a -> IO ()
loop
  where
    loop :: a -> IO ()
loop a
time
      | a
time a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
          let maxWait :: a
maxWait = a -> a -> a
forall a. Ord a => a -> a -> a
min a
time (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
          Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
maxWait
          a -> IO ()
loop (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ a
time a -> a -> a
forall a. Num a => a -> a -> a
- a
maxWait

diffToMicroseconds :: NominalDiffTime -> Int64
diffToMicroseconds :: NominalDiffTime -> Int64
diffToMicroseconds NominalDiffTime
diff = NominalDiffTime -> Int64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> Int64) -> NominalDiffTime -> Int64
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
diff NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000000
{-# INLINE diffToMicroseconds #-}

diffToMilliseconds :: NominalDiffTime -> Int64
diffToMilliseconds :: NominalDiffTime -> Int64
diffToMilliseconds NominalDiffTime
diff = NominalDiffTime -> Int64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> Int64) -> NominalDiffTime -> Int64
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
diff NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000
{-# INLINE diffToMilliseconds #-}

labelMyThread :: MonadIO m => String -> m ()
labelMyThread :: forall (m :: * -> *). MonadIO m => String -> m ()
labelMyThread String
label = 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
$ IO ThreadId
myThreadId IO ThreadId -> (ThreadId -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ThreadId -> String -> IO ()
`labelThread` String
label)

atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ :: forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef a
r a -> a
f = IORef a -> (a -> (a, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef a
r (\a
v -> (a -> a
f a
v, ()))

encodeJSON :: ToJSON a => a -> Text
encodeJSON :: forall a. ToJSON a => a -> Text
encodeJSON = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode
{-# INLINE encodeJSON #-}

decodeJSON :: FromJSON a => Text -> Maybe a
decodeJSON :: forall a. FromJSON a => Text -> Maybe a
decodeJSON = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
J.decodeStrict (ByteString -> Maybe a) -> (Text -> ByteString) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
{-# INLINE decodeJSON #-}

traverseWithKey_ :: Monad m => (k -> v -> m ()) -> Map k v -> m ()
traverseWithKey_ :: forall (m :: * -> *) k v.
Monad m =>
(k -> v -> m ()) -> Map k v -> m ()
traverseWithKey_ k -> v -> m ()
f = (k -> v -> m () -> m ()) -> m () -> Map k v -> m ()
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\k
k v
v -> (k -> v -> m ()
f k
k v
v m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE traverseWithKey_ #-}