{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module      : Discord.Internal.Voice.CommonUtils
Description : Strictly for internal use only. See Discord.Voice for the public interface.
Copyright   : (c) Yuto Takano (2021)
License     : MIT
Maintainer  : moa17stock@gmail.com

= WARNING

This module is considered __internal__.

The Package Versioning Policy __does not apply__.

The contents of this module may change __in any way whatsoever__ and __without__
__any warning__ between minor versions of this package.

= Description

This module provides useful utility functions used in discord-haskell-voice.
-}
module Discord.Internal.Voice.CommonUtils where

import Control.Concurrent
import Control.Concurrent.Async ( race )
import Control.Lens
import Data.Text qualified as T
import Data.Time.Clock.POSIX
import Data.Time
import GHC.Weak

-- | @tshow@ is a shorthand alias for @T.pack . show@.
tshow :: Show a => a -> T.Text
tshow :: 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

-- | @maybeToRight@ puts the maybe value into the right hand side of the Either,
-- with a default value provided for the Left as the first argument.
maybeToRight :: a -> Maybe b -> Either a b
maybeToRight :: a -> Maybe b -> Either a b
maybeToRight a
a = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
a) b -> Either a b
forall a b. b -> Either a b
Right

-- | @doOrTimeout@ performs an IO action for a maximum of @millisec@ milliseconds.
doOrTimeout :: Int -> IO a -> IO (Maybe a)
doOrTimeout :: Int -> IO a -> IO (Maybe a)
doOrTimeout Int
millisec IO a
longAction = (Either (Maybe Any) a
-> Getting (First a) (Either (Maybe Any) a) a -> Maybe a
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First a) (Either (Maybe Any) a) a
forall c a b. Prism (Either c a) (Either c b) a b
_Right) (Either (Maybe Any) a -> Maybe a)
-> IO (Either (Maybe Any) a) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Any) -> IO a -> IO (Either (Maybe Any) a)
forall a b. IO a -> IO b -> IO (Either a b)
race IO (Maybe Any)
forall b. IO (Maybe b)
waitSecs IO a
longAction
  where
    waitSecs :: IO (Maybe b)
    waitSecs :: IO (Maybe b)
waitSecs = Int -> IO ()
threadDelay (Int
millisec Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3 :: Int)) IO () -> IO (Maybe b) -> IO (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe b -> IO (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing

-- | @killWkThread@ kills a thread referenced by Weak ThreadId. If the thread is
-- no longer alive (that is, if @deRefWeak@ is Nothing), this function will do
-- nothing.
killWkThread :: Weak ThreadId -> IO ()
killWkThread :: Weak ThreadId -> IO ()
killWkThread Weak ThreadId
tid = Weak ThreadId -> IO (Maybe ThreadId)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak ThreadId
tid IO (Maybe ThreadId) -> (Maybe ThreadId -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ThreadId
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ThreadId
x  -> ThreadId -> IO ()
killThread ThreadId
x