module Polysemy.Conc.Async where

import qualified Control.Concurrent.Async as Base
import Polysemy.Async (Async, async, cancel)
import Polysemy.Resource (Resource, bracket)
import Polysemy.Time (MilliSeconds (MilliSeconds), TimeUnit)

import Polysemy.Conc.Effect.Race (Race)
import qualified Polysemy.Conc.Race as Race

-- |Run the first action asynchronously while the second action executes, then cancel the first action.
-- Passes the handle into the action to allow it to await its result.
--
-- When cancelling, this variant will wait indefinitely for the thread to be gone.
withAsyncBlock ::
  Members [Resource, Async] r =>
  Sem r b ->
  (Base.Async (Maybe b) -> Sem r a) ->
  Sem r a
withAsyncBlock :: Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
withAsyncBlock Sem r b
mb =
  Sem r (Async (Maybe b))
-> (Async (Maybe b) -> Sem r ())
-> (Async (Maybe b) -> Sem r a)
-> Sem r a
forall (r :: [Effect]) a c b.
MemberWithError Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (Sem r b -> Sem r (Async (Maybe b))
forall (r :: [Effect]) a.
MemberWithError Async r =>
Sem r a -> Sem r (Async (Maybe a))
async Sem r b
mb) Async (Maybe b) -> Sem r ()
forall (r :: [Effect]) a.
MemberWithError Async r =>
Async a -> Sem r ()
cancel

-- |Run the first action asynchronously while the second action executes, then cancel the first action.
-- Passes the handle into the action to allow it to await its result.
--
-- When cancelling, this variant will wait for the specified interval for the thread to be gone.
withAsyncWait ::
  TimeUnit u =>
  Members [Resource, Race, Async] r =>
  u ->
  Sem r b ->
  (Base.Async (Maybe b) -> Sem r a) ->
  Sem r a
withAsyncWait :: u -> Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
withAsyncWait u
interval Sem r b
mb =
  Sem r (Async (Maybe b))
-> (Async (Maybe b) -> Sem r ())
-> (Async (Maybe b) -> Sem r a)
-> Sem r a
forall (r :: [Effect]) a c b.
MemberWithError Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (Sem r b -> Sem r (Async (Maybe b))
forall (r :: [Effect]) a.
MemberWithError Async r =>
Sem r a -> Sem r (Async (Maybe a))
async Sem r b
mb) (u -> Sem r () -> Sem r ()
forall u (r :: [Effect]).
(TimeUnit u, Member Race r) =>
u -> Sem r () -> Sem r ()
Race.timeoutU u
interval (Sem r () -> Sem r ())
-> (Async (Maybe b) -> Sem r ()) -> Async (Maybe b) -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (Maybe b) -> Sem r ()
forall (r :: [Effect]) a.
MemberWithError Async r =>
Async a -> Sem r ()
cancel)

-- |Run the first action asynchronously while the second action executes, then cancel the first action.
-- Passes the handle into the action to allow it to await its result.
--
-- When cancelling, this variant will wait for 500ms for the thread to be gone.
withAsync ::
  Members [Resource, Race, Async] r =>
  Sem r b ->
  (Base.Async (Maybe b) -> Sem r a) ->
  Sem r a
withAsync :: Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
withAsync =
  MilliSeconds -> Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
forall u (r :: [Effect]) b a.
(TimeUnit u, Members '[Resource, Race, Async] r) =>
u -> Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
withAsyncWait (Int64 -> MilliSeconds
MilliSeconds Int64
500)

-- |Run the first action asynchronously while the second action executes, then cancel the first action.
-- Discards the handle, expecting the async action to either terminate or be cancelled.
--
-- When cancelling, this variant will wait for 500ms for the thread to be gone.
withAsync_ ::
  Members [Resource, Race, Async] r =>
  Sem r b ->
  Sem r a ->
  Sem r a
withAsync_ :: Sem r b -> Sem r a -> Sem r a
withAsync_ Sem r b
mb =
  Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
forall (r :: [Effect]) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> (Async (Maybe b) -> Sem r a) -> Sem r a
withAsync Sem r b
mb ((Async (Maybe b) -> Sem r a) -> Sem r a)
-> (Sem r a -> Async (Maybe b) -> Sem r a) -> Sem r a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r a -> Async (Maybe b) -> Sem r a
forall a b. a -> b -> a
const