{-|
Module      : KMonad.Util
Description : Various bits and bobs that I don't know where to put
Copyright   : (c) David Janssen, 2019
License     : MIT
Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : portable

Contains code for making it slighly easier to work with time, errors, and
Acquire datatypes.

-}
module KMonad.Util
  ( -- * Time units and utils
    -- $time
    Milliseconds
  , unMS
  , tDiff

    -- * Random utility helpers that have no better home
  , onErr
  , using
  , logRethrow

    -- * Some helpers to launch background process
  , withLaunch
  , withLaunch_
  , launch
  , launch_
  )

where

import KMonad.Prelude

import Data.Time.Clock
import Data.Time.Clock.System

--------------------------------------------------------------------------------
-- $time
--

-- | Newtype wrapper around 'Int' to add type safety to our time values
newtype Milliseconds = Milliseconds { Milliseconds -> Int
unMS :: Int }
  deriving (Milliseconds -> Milliseconds -> Bool
(Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool) -> Eq Milliseconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Milliseconds -> Milliseconds -> Bool
== :: Milliseconds -> Milliseconds -> Bool
$c/= :: Milliseconds -> Milliseconds -> Bool
/= :: Milliseconds -> Milliseconds -> Bool
Eq, Eq Milliseconds
Eq Milliseconds =>
(Milliseconds -> Milliseconds -> Ordering)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> Ord Milliseconds
Milliseconds -> Milliseconds -> Bool
Milliseconds -> Milliseconds -> Ordering
Milliseconds -> Milliseconds -> Milliseconds
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Milliseconds -> Milliseconds -> Ordering
compare :: Milliseconds -> Milliseconds -> Ordering
$c< :: Milliseconds -> Milliseconds -> Bool
< :: Milliseconds -> Milliseconds -> Bool
$c<= :: Milliseconds -> Milliseconds -> Bool
<= :: Milliseconds -> Milliseconds -> Bool
$c> :: Milliseconds -> Milliseconds -> Bool
> :: Milliseconds -> Milliseconds -> Bool
$c>= :: Milliseconds -> Milliseconds -> Bool
>= :: Milliseconds -> Milliseconds -> Bool
$cmax :: Milliseconds -> Milliseconds -> Milliseconds
max :: Milliseconds -> Milliseconds -> Milliseconds
$cmin :: Milliseconds -> Milliseconds -> Milliseconds
min :: Milliseconds -> Milliseconds -> Milliseconds
Ord, Integer -> Milliseconds
Milliseconds -> Milliseconds
Milliseconds -> Milliseconds -> Milliseconds
(Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Integer -> Milliseconds)
-> Num Milliseconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Milliseconds -> Milliseconds -> Milliseconds
+ :: Milliseconds -> Milliseconds -> Milliseconds
$c- :: Milliseconds -> Milliseconds -> Milliseconds
- :: Milliseconds -> Milliseconds -> Milliseconds
$c* :: Milliseconds -> Milliseconds -> Milliseconds
* :: Milliseconds -> Milliseconds -> Milliseconds
$cnegate :: Milliseconds -> Milliseconds
negate :: Milliseconds -> Milliseconds
$cabs :: Milliseconds -> Milliseconds
abs :: Milliseconds -> Milliseconds
$csignum :: Milliseconds -> Milliseconds
signum :: Milliseconds -> Milliseconds
$cfromInteger :: Integer -> Milliseconds
fromInteger :: Integer -> Milliseconds
Num, Num Milliseconds
Ord Milliseconds
(Num Milliseconds, Ord Milliseconds) =>
(Milliseconds -> Rational) -> Real Milliseconds
Milliseconds -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Milliseconds -> Rational
toRational :: Milliseconds -> Rational
Real, Int -> Milliseconds
Milliseconds -> Int
Milliseconds -> [Milliseconds]
Milliseconds -> Milliseconds
Milliseconds -> Milliseconds -> [Milliseconds]
Milliseconds -> Milliseconds -> Milliseconds -> [Milliseconds]
(Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Int -> Milliseconds)
-> (Milliseconds -> Int)
-> (Milliseconds -> [Milliseconds])
-> (Milliseconds -> Milliseconds -> [Milliseconds])
-> (Milliseconds -> Milliseconds -> [Milliseconds])
-> (Milliseconds -> Milliseconds -> Milliseconds -> [Milliseconds])
-> Enum Milliseconds
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Milliseconds -> Milliseconds
succ :: Milliseconds -> Milliseconds
$cpred :: Milliseconds -> Milliseconds
pred :: Milliseconds -> Milliseconds
$ctoEnum :: Int -> Milliseconds
toEnum :: Int -> Milliseconds
$cfromEnum :: Milliseconds -> Int
fromEnum :: Milliseconds -> Int
$cenumFrom :: Milliseconds -> [Milliseconds]
enumFrom :: Milliseconds -> [Milliseconds]
$cenumFromThen :: Milliseconds -> Milliseconds -> [Milliseconds]
enumFromThen :: Milliseconds -> Milliseconds -> [Milliseconds]
$cenumFromTo :: Milliseconds -> Milliseconds -> [Milliseconds]
enumFromTo :: Milliseconds -> Milliseconds -> [Milliseconds]
$cenumFromThenTo :: Milliseconds -> Milliseconds -> Milliseconds -> [Milliseconds]
enumFromThenTo :: Milliseconds -> Milliseconds -> Milliseconds -> [Milliseconds]
Enum, Enum Milliseconds
Real Milliseconds
(Real Milliseconds, Enum Milliseconds) =>
(Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds))
-> (Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds))
-> (Milliseconds -> Integer)
-> Integral Milliseconds
Milliseconds -> Integer
Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds)
Milliseconds -> Milliseconds -> Milliseconds
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Milliseconds -> Milliseconds -> Milliseconds
quot :: Milliseconds -> Milliseconds -> Milliseconds
$crem :: Milliseconds -> Milliseconds -> Milliseconds
rem :: Milliseconds -> Milliseconds -> Milliseconds
$cdiv :: Milliseconds -> Milliseconds -> Milliseconds
div :: Milliseconds -> Milliseconds -> Milliseconds
$cmod :: Milliseconds -> Milliseconds -> Milliseconds
mod :: Milliseconds -> Milliseconds -> Milliseconds
$cquotRem :: Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds)
quotRem :: Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds)
$cdivMod :: Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds)
divMod :: Milliseconds -> Milliseconds -> (Milliseconds, Milliseconds)
$ctoInteger :: Milliseconds -> Integer
toInteger :: Milliseconds -> Integer
Integral, Int -> Milliseconds -> ShowS
[Milliseconds] -> ShowS
Milliseconds -> String
(Int -> Milliseconds -> ShowS)
-> (Milliseconds -> String)
-> ([Milliseconds] -> ShowS)
-> Show Milliseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Milliseconds -> ShowS
showsPrec :: Int -> Milliseconds -> ShowS
$cshow :: Milliseconds -> String
show :: Milliseconds -> String
$cshowList :: [Milliseconds] -> ShowS
showList :: [Milliseconds] -> ShowS
Show, ReadPrec [Milliseconds]
ReadPrec Milliseconds
Int -> ReadS Milliseconds
ReadS [Milliseconds]
(Int -> ReadS Milliseconds)
-> ReadS [Milliseconds]
-> ReadPrec Milliseconds
-> ReadPrec [Milliseconds]
-> Read Milliseconds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Milliseconds
readsPrec :: Int -> ReadS Milliseconds
$creadList :: ReadS [Milliseconds]
readList :: ReadS [Milliseconds]
$creadPrec :: ReadPrec Milliseconds
readPrec :: ReadPrec Milliseconds
$creadListPrec :: ReadPrec [Milliseconds]
readListPrec :: ReadPrec [Milliseconds]
Read, (forall x. Milliseconds -> Rep Milliseconds x)
-> (forall x. Rep Milliseconds x -> Milliseconds)
-> Generic Milliseconds
forall x. Rep Milliseconds x -> Milliseconds
forall x. Milliseconds -> Rep Milliseconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Milliseconds -> Rep Milliseconds x
from :: forall x. Milliseconds -> Rep Milliseconds x
$cto :: forall x. Rep Milliseconds x -> Milliseconds
to :: forall x. Rep Milliseconds x -> Milliseconds
Generic, Milliseconds -> Text
Milliseconds -> Utf8Builder
(Milliseconds -> Utf8Builder)
-> (Milliseconds -> Text) -> Display Milliseconds
forall a. (a -> Utf8Builder) -> (a -> Text) -> Display a
$cdisplay :: Milliseconds -> Utf8Builder
display :: Milliseconds -> Utf8Builder
$ctextDisplay :: Milliseconds -> Text
textDisplay :: Milliseconds -> Text
Display, Typeable, Typeable Milliseconds
Typeable Milliseconds =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Milliseconds -> c Milliseconds)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Milliseconds)
-> (Milliseconds -> Constr)
-> (Milliseconds -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Milliseconds))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Milliseconds))
-> ((forall b. Data b => b -> b) -> Milliseconds -> Milliseconds)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Milliseconds -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Milliseconds -> r)
-> (forall u. (forall d. Data d => d -> u) -> Milliseconds -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Milliseconds -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds)
-> Data Milliseconds
Milliseconds -> Constr
Milliseconds -> DataType
(forall b. Data b => b -> b) -> Milliseconds -> Milliseconds
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Milliseconds -> u
forall u. (forall d. Data d => d -> u) -> Milliseconds -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Milliseconds -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Milliseconds -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Milliseconds
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Milliseconds -> c Milliseconds
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Milliseconds)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Milliseconds)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Milliseconds -> c Milliseconds
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Milliseconds -> c Milliseconds
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Milliseconds
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Milliseconds
$ctoConstr :: Milliseconds -> Constr
toConstr :: Milliseconds -> Constr
$cdataTypeOf :: Milliseconds -> DataType
dataTypeOf :: Milliseconds -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Milliseconds)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Milliseconds)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Milliseconds)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Milliseconds)
$cgmapT :: (forall b. Data b => b -> b) -> Milliseconds -> Milliseconds
gmapT :: (forall b. Data b => b -> b) -> Milliseconds -> Milliseconds
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Milliseconds -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Milliseconds -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Milliseconds -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Milliseconds -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Milliseconds -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Milliseconds -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Milliseconds -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Milliseconds -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Milliseconds -> m Milliseconds
Data)

-- | Calculate how much time has elapsed between 2 time points
tDiff :: ()
  => SystemTime   -- ^ The earlier timepoint
  -> SystemTime   -- ^ The later timepoint
  -> Milliseconds -- ^ The time in milliseconds between the two
tDiff :: SystemTime -> SystemTime -> Milliseconds
tDiff SystemTime
a SystemTime
b = let
  a' :: UTCTime
a' = SystemTime -> UTCTime
systemToUTCTime SystemTime
a
  b' :: UTCTime
b' = SystemTime -> UTCTime
systemToUTCTime SystemTime
b
  d :: NominalDiffTime
d  = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
b' UTCTime
a'
  in NominalDiffTime -> Milliseconds
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> Milliseconds)
-> NominalDiffTime -> Milliseconds
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
d NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000
-- tDiff (MkSystemTime s_a ns_a) (MkSystemTime s_b ns_b) = let
  -- s  = fromIntegral $ (s_b  - s_a) * 1000
  -- ns = fromIntegral $ (ns_b - ns_a) `div` 1000000
  -- in s + ns

--------------------------------------------------------------------------------
-- $util

-- | A helper function that helps to throw errors when a return code is -1.
-- Easiest when used as infix like this:
--
-- > someFFIcall `onErr` MyCallFailedError someData
--
onErr :: (MonadUnliftIO m, Exception e) => m Int -> e -> m ()
onErr :: forall (m :: * -> *) e.
(MonadUnliftIO m, Exception e) =>
m Int -> e -> m ()
onErr m Int
a e
err = m Int
a m Int -> (Int -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
ret -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ret Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ e -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO e
err

-- | Embed the action of using an 'Acquire' in a continuation monad
using :: Acquire a -> ContT r (RIO e) a
using :: forall a r e. Acquire a -> ContT r (RIO e) a
using Acquire a
dat = ((a -> RIO e r) -> RIO e r) -> ContT r (RIO e) a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (\a -> RIO e r
next -> Acquire a -> (a -> RIO e r) -> RIO e r
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with Acquire a
dat ((a -> RIO e r) -> RIO e r) -> (a -> RIO e r) -> RIO e r
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> RIO e r
next a
a)


-- | Log an error message and then rethrow the error
--
-- Particularly useful as a suffix using `catch`. i.e.
--
-- > doSomething `catch` logRethrow "I caught something"
logRethrow :: HasLogFunc e
  => Text
  -> SomeException -- ^ The error to throw
  -> RIO e a
logRethrow :: forall e a. HasLogFunc e => Text -> SomeException -> RIO e a
logRethrow Text
t SomeException
e = do
  Utf8Builder -> RIO e ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError (Utf8Builder -> RIO e ()) -> Utf8Builder -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> SomeException -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display SomeException
e
  SomeException -> RIO e a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e

-- | Launch a process that repeats an action indefinitely. If an error ever
-- occurs, print it and rethrow it. Ensure the process is cleaned up upon error
-- and/or shutdown.
withLaunch :: HasLogFunc e
  => Text                   -- ^ The name of this process (for logging)
  -> RIO e a                -- ^ The action to repeat forever
  -> (Async a -> RIO e b) -- ^ The foreground action to run
  -> RIO e b                -- ^ The resulting action
withLaunch :: forall e a b.
HasLogFunc e =>
Text -> RIO e a -> (Async a -> RIO e b) -> RIO e b
withLaunch Text
n RIO e a
a Async a -> RIO e b
f = do
  Utf8Builder -> RIO e ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO e ()) -> Utf8Builder -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Launching process: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
n
  RIO e a -> (Async a -> RIO e b) -> RIO e b
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync
   (RIO e a -> RIO e a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever RIO e a
a
    RIO e a -> (SomeException -> RIO e a) -> RIO e a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch`   Text -> SomeException -> RIO e a
forall e a. HasLogFunc e => Text -> SomeException -> RIO e a
logRethrow (Text
"Encountered error in <" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Display a => a -> Text
textDisplay Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">")
    RIO e a -> RIO e () -> RIO e a
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` Utf8Builder -> RIO e ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo    (Utf8Builder
"Closing process: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
n))
   (\Async a
a' -> Async a -> RIO e ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link Async a
a' RIO e () -> RIO e b -> RIO e b
forall a b. RIO e a -> RIO e b -> RIO e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Async a -> RIO e b
f Async a
a')

-- | Like withLaunch, but without ever needing access to the async process
withLaunch_ :: HasLogFunc e
  => Text    -- ^ The name of this process (for logging)
  -> RIO e a -- ^ The action to repeat forever
  -> RIO e b -- ^ The foreground action to run
  -> RIO e b -- ^ The resulting action
withLaunch_ :: forall e a b. HasLogFunc e => Text -> RIO e a -> RIO e b -> RIO e b
withLaunch_ Text
n RIO e a
a RIO e b
f = Text -> RIO e a -> (Async a -> RIO e b) -> RIO e b
forall e a b.
HasLogFunc e =>
Text -> RIO e a -> (Async a -> RIO e b) -> RIO e b
withLaunch Text
n RIO e a
a (RIO e b -> Async a -> RIO e b
forall a b. a -> b -> a
const RIO e b
f)

-- | Like 'withLaunch', but in the ContT monad
launch :: HasLogFunc e
  => Text    -- ^ The name of this process (for logging)
  -> RIO e a -- ^ The action to repeat forever
  -> ContT r (RIO e) (Async a)
launch :: forall e a r.
HasLogFunc e =>
Text -> RIO e a -> ContT r (RIO e) (Async a)
launch Text
n = ((Async a -> RIO e r) -> RIO e r) -> ContT r (RIO e) (Async a)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Async a -> RIO e r) -> RIO e r) -> ContT r (RIO e) (Async a))
-> (RIO e a -> (Async a -> RIO e r) -> RIO e r)
-> RIO e a
-> ContT r (RIO e) (Async a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RIO e a -> (Async a -> RIO e r) -> RIO e r
forall e a b.
HasLogFunc e =>
Text -> RIO e a -> (Async a -> RIO e b) -> RIO e b
withLaunch Text
n

-- | Like 'withLaunch_', but in the ContT monad
launch_ :: HasLogFunc e
  => Text    -- ^ The name of this process (for logging)
  -> RIO e a -- ^ The action to repeat forever
  -> ContT r (RIO e) ()
launch_ :: forall e a r. HasLogFunc e => Text -> RIO e a -> ContT r (RIO e) ()
launch_ Text
n RIO e a
a = ((() -> RIO e r) -> RIO e r) -> ContT r (RIO e) ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> RIO e r) -> RIO e r) -> ContT r (RIO e) ())
-> ((() -> RIO e r) -> RIO e r) -> ContT r (RIO e) ()
forall a b. (a -> b) -> a -> b
$ \() -> RIO e r
next -> Text -> RIO e a -> RIO e r -> RIO e r
forall e a b. HasLogFunc e => Text -> RIO e a -> RIO e b -> RIO e b
withLaunch_ Text
n RIO e a
a (() -> RIO e r
next ())