module Multitasking.Waiting
  ( -- ** Waiting
    waitDuration,
    waitForever,

    -- ** Duration
    Duration,
    fromMinutes,
    fromWholeMinutes,
    fromSeconds,
    fromWholeSeconds,
    fromMilliseconds,
    fromWholeMilliseconds,
    fromMicroseconds,
    durationToMicroseconds,
  )
where

import Control.Concurrent (threadDelay)
import Control.Monad (forever)
import Control.Monad.IO.Class

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

-- | Waits forever
waitDuration :: (MonadIO m) => Duration -> m ()
waitDuration :: forall (m :: * -> *). MonadIO m => Duration -> m ()
waitDuration Duration
duration = 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
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Duration -> Word
durationToMicroseconds Duration
duration

-- | 'Duration' is a time span. It is used for waiting and timeouts.
newtype Duration = Duration Word deriving (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Duration -> ShowS
showsPrec :: Int -> Duration -> ShowS
$cshow :: Duration -> String
show :: Duration -> String
$cshowList :: [Duration] -> ShowS
showList :: [Duration] -> ShowS
Show, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
/= :: Duration -> Duration -> Bool
Eq, Eq Duration
Eq Duration =>
(Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
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 :: Duration -> Duration -> Ordering
compare :: Duration -> Duration -> Ordering
$c< :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
>= :: Duration -> Duration -> Bool
$cmax :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
min :: Duration -> Duration -> Duration
Ord, Integer -> Duration
Duration -> Duration
Duration -> Duration -> Duration
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Integer -> Duration)
-> Num Duration
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Duration -> Duration -> Duration
+ :: Duration -> Duration -> Duration
$c- :: Duration -> Duration -> Duration
- :: Duration -> Duration -> Duration
$c* :: Duration -> Duration -> Duration
* :: Duration -> Duration -> Duration
$cnegate :: Duration -> Duration
negate :: Duration -> Duration
$cabs :: Duration -> Duration
abs :: Duration -> Duration
$csignum :: Duration -> Duration
signum :: Duration -> Duration
$cfromInteger :: Integer -> Duration
fromInteger :: Integer -> Duration
Num)

-- | Create a 'Duration' from minutes
fromMinutes :: Double -> Duration
fromMinutes :: Double -> Duration
fromMinutes Double
d = Double -> Duration
fromSeconds (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60)

-- | Create a 'Duration' from seconds
fromSeconds :: Double -> Duration
fromSeconds :: Double -> Duration
fromSeconds Double
d = Word -> Duration
Duration (Word -> Duration) -> Word -> Duration
forall a b. (a -> b) -> a -> b
$ Double -> Word
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word) -> Double -> Word
forall a b. (a -> b) -> a -> b
$ Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000

-- | Create a 'Duration' from milliseconds
fromMilliseconds :: Double -> Duration
fromMilliseconds :: Double -> Duration
fromMilliseconds Double
d = Word -> Duration
Duration (Word -> Duration) -> Word -> Duration
forall a b. (a -> b) -> a -> b
$ Double -> Word
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word) -> Double -> Word
forall a b. (a -> b) -> a -> b
$ Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000

-- | Create a 'Duration' from minutes
fromWholeMinutes :: Word -> Duration
fromWholeMinutes :: Word -> Duration
fromWholeMinutes Word
w = Word -> Duration
fromWholeSeconds (Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
60)

-- | Create a 'Duration' from seconds
fromWholeSeconds :: Word -> Duration
fromWholeSeconds :: Word -> Duration
fromWholeSeconds Word
w = Word -> Duration
Duration (Word -> Duration) -> Word -> Duration
forall a b. (a -> b) -> a -> b
$ Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
1000000

-- | Create a 'Duration' from milliseconds
fromWholeMilliseconds :: Word -> Duration
fromWholeMilliseconds :: Word -> Duration
fromWholeMilliseconds Word
w = Word -> Duration
Duration (Word -> Duration) -> Word -> Duration
forall a b. (a -> b) -> a -> b
$ Word
w Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
1000

-- | Create a 'Duration' from microseconds
fromMicroseconds :: Word -> Duration
fromMicroseconds :: Word -> Duration
fromMicroseconds Word
w = Word -> Duration
Duration Word
w

-- Get the 'Duration' in microseconds.
durationToMicroseconds :: Duration -> Word
durationToMicroseconds :: Duration -> Word
durationToMicroseconds (Duration Word
w) = Word
w