module Freckle.App.Async
  ( async
  , immortalCreate
  , immortalCreateLogged
  )
where

import Freckle.App.Prelude

import Blammo.Logging
import qualified Control.Immortal as Immortal
import Control.Monad (forever)
import qualified Data.Aeson.Compat as KeyMap
import UnliftIO.Async (Async)
import qualified UnliftIO.Async as UnliftIO
import UnliftIO.Concurrent (threadDelay)

-- | 'UnliftIO.Async.async' but passing the thread context along
async :: (MonadMask m, MonadUnliftIO m) => m a -> m (Async a)
async :: forall (m :: * -> *) a.
(MonadMask m, MonadUnliftIO m) =>
m a -> m (Async a)
async m a
f = do
  [(Key, Value)]
tc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KeyMap.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (MonadIO m, MonadThrow m) => m (KeyMap Value)
myThreadContext
  forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
UnliftIO.async forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[(Key, Value)] -> m a -> m a
withThreadContext [(Key, Value)]
tc m a
f

-- | Wrapper around creating "Control.Immortal" processes
--
-- Features:
--
-- - Ensures the thread context is correctly passed to both your spawned action
--   and your error handler
-- - Blocks forever after spawning your thread.
immortalCreate
  :: (MonadMask m, MonadUnliftIO m)
  => (Either SomeException () -> m ())
  -- ^ How to handle unexpected finish
  -> m ()
  -- ^ The action to run persistently
  -> m a
immortalCreate :: forall (m :: * -> *) a.
(MonadMask m, MonadUnliftIO m) =>
(Either SomeException () -> m ()) -> m () -> m a
immortalCreate Either SomeException () -> m ()
onUnexpected m ()
act = do
  [(Key, Value)]
tc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KeyMap.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (MonadIO m, MonadThrow m) => m (KeyMap Value)
myThreadContext

  let
    act' :: m ()
act' = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[(Key, Value)] -> m a -> m a
withThreadContext [(Key, Value)]
tc m ()
act
    onUnexpected' :: Either SomeException () -> m ()
onUnexpected' = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[(Key, Value)] -> m a -> m a
withThreadContext [(Key, Value)]
tc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException () -> m ()
onUnexpected

  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadUnliftIO m =>
(Thread -> m ()) -> m Thread
Immortal.create forall a b. (a -> b) -> a -> b
$ \Thread
thread -> do
    forall (m :: * -> *).
MonadUnliftIO m =>
Thread -> (Either SomeException () -> m ()) -> m () -> m ()
Immortal.onUnexpectedFinish Thread
thread Either SomeException () -> m ()
onUnexpected' m ()
act'

  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay forall a. Bounded a => a
maxBound

-- | 'immortalCreate' with logging of unexpected finishes
immortalCreateLogged
  :: (MonadMask m, MonadUnliftIO m, MonadLogger m) => m () -> m a
immortalCreateLogged :: forall (m :: * -> *) a.
(MonadMask m, MonadUnliftIO m, MonadLogger m) =>
m () -> m a
immortalCreateLogged = forall (m :: * -> *) a.
(MonadMask m, MonadUnliftIO m) =>
(Either SomeException () -> m ()) -> m () -> m a
immortalCreate forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {e}. (MonadLogger m, Exception e) => e -> m ()
logEx forall (f :: * -> *) a. Applicative f => a -> f a
pure
 where
  logEx :: e -> m ()
logEx e
ex = forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ Text
"Unexpected Finish" Text -> [SeriesElem] -> Message
:# [Key
"exception" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall e. Exception e => e -> String
displayException e
ex]