{-# LANGUAGE RecursiveDo #-}

module ConIO.Race
  ( -- ** Race
    raceTwo,
    raceTwoMaybe,
    raceMany,
    raceManyMaybe,
    raceTwoTasks,
    raceTwoTasksMaybe,
    raceManyTasks,
    raceManyTasksMaybe,

    -- ** Timeout
    timeout,
    timeoutTask,

    -- ** Waiting
    waitDuration,
    waitForever,

    -- ** Duration
    Duration,
    fromSeconds,
    fromMilliseconds,
    fromMicroseconds,
    durationToMicroseconds,
  )
where

import ConIO.Core
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad (forever, void, when)
import Control.Monad.IO.Class
import Data.Foldable (traverse_)
import Data.Traversable (forM)

-- | Race two actions. The slower is canceled.
raceTwo :: IO a -> IO a -> ConIO (Task a)
raceTwo :: forall a. IO a -> IO a -> ConIO (Task a)
raceTwo IO a
action1 IO a
action2 = mdo
  result <- IO (TMVar a) -> ConIO (TMVar a)
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar a)
forall a. IO (TMVar a)
newEmptyTMVarIO
  task1 <- launch $ do
    value1 <- action1
    wasPut <- atomically $ tryPutTMVar result value1
    when wasPut $ cancel task2
  task2 <- launch $ do
    value2 <- action2
    wasPut <- atomically $ tryPutTMVar result value2
    when wasPut $ cancel task1
  pure $
    Task
      { payload = takeTMVar result,
        threadIds = task1.threadIds <> task2.threadIds
      }

-- | Race two actions which may produce results. If one action produces a result, the other one is cancelled.
-- If no actions produce a result, then the resulting task also produces nothing.
raceTwoMaybe :: IO (Maybe a) -> IO (Maybe a) -> ConIO (Task (Maybe a))
raceTwoMaybe :: forall a. IO (Maybe a) -> IO (Maybe a) -> ConIO (Task (Maybe a))
raceTwoMaybe IO (Maybe a)
action1 IO (Maybe a)
action2 = mdo
  result <- IO (TVar (Maybe a)) -> ConIO (TVar (Maybe a))
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe a -> IO (TVar (Maybe a))
forall a. a -> IO (TVar a)
newTVarIO Maybe a
forall a. Maybe a
Nothing)
  counter <- liftIO $ newTVarIO (2 :: Int)
  task1 <- launch $ do
    maybeValue1 <- action1
    atomically $ modifyTVar' counter pred
    case maybeValue1 of
      Just a
value1 -> do
        wasPut <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
          currentResult <- TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
readTVar TVar (Maybe a)
result
          case currentResult of
            Maybe a
Nothing -> TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
result (a -> Maybe a
forall a. a -> Maybe a
Just a
value1) STM () -> STM Bool -> STM Bool
forall a b. STM a -> STM b -> STM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            Just a
_ -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        when wasPut $ cancel task2
      Maybe a
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  task2 <- launch $ do
    maybeValue2 <- action2
    atomically $ modifyTVar' counter pred
    case maybeValue2 of
      Just a
value2 -> do
        wasPut <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
          currentResult <- TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
readTVar TVar (Maybe a)
result
          case currentResult of
            Maybe a
Nothing -> TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
result (a -> Maybe a
forall a. a -> Maybe a
Just a
value2) STM () -> STM Bool -> STM Bool
forall a b. STM a -> STM b -> STM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            Just a
_ -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        when wasPut $ cancel task1
      Maybe a
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure $
    Task
      { payload = do
          currentResult <- readTVar result
          case currentResult of
            Just a
r -> Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> STM (Maybe a)) -> Maybe a -> STM (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
r
            Maybe a
Nothing -> do
              currentCounter <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
counter
              if currentCounter == 0
                then pure Nothing
                else retry,
        threadIds = task1.threadIds <> task2.threadIds
      }

-- | Race many actions which may produce results. If one action produces a result, the other ones are cancelled.
-- If no actions produce a result, then the resulting task also produces nothing.
raceMany :: (Traversable t) => t (IO a) -> ConIO (Task a)
raceMany :: forall (t :: * -> *) a. Traversable t => t (IO a) -> ConIO (Task a)
raceMany t (IO a)
actions = do
  raceResult <- IO (TMVar a) -> ConIO (TMVar a)
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar a)
forall a. IO (TMVar a)
newEmptyTMVarIO
  tasksMVar <- liftIO $ newEmptyMVar
  tasks <- withConScope $ \ConScope s
scope -> t (IO a) -> (IO a -> IO (Task ())) -> IO (t (Task ()))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t (IO a)
actions ((IO a -> IO (Task ())) -> IO (t (Task ())))
-> (IO a -> IO (Task ())) -> IO (t (Task ()))
forall a b. (a -> b) -> a -> b
$ \IO a
action -> do
    task <- ConScope s -> ConIO (Task ()) -> IO (Task ())
forall {k} (s :: k) a. ConScope s -> ConIO a -> IO a
useConScope ConScope s
scope (ConIO (Task ()) -> IO (Task ()))
-> ConIO (Task ()) -> IO (Task ())
forall a b. (a -> b) -> a -> b
$ IO () -> ConIO (Task ())
forall a. IO a -> ConIO (Task a)
launch (IO () -> ConIO (Task ())) -> IO () -> ConIO (Task ())
forall a b. (a -> b) -> a -> b
$ do
      result <- IO a
action
      wasPut <- atomically $ tryPutTMVar raceResult result
      when wasPut $ do
        tasks <- readMVar tasksMVar
        useConScope scope $ void $ launch $ traverse cancel tasks
    pure task
  liftIO $ putMVar tasksMVar tasks
  pure $
    Task
      { payload = readTMVar raceResult,
        threadIds = foldMap (.threadIds) tasks
      }

-- | Race many actions. The slower ones are canceled.
raceManyMaybe :: (Traversable t) => t (IO (Maybe a)) -> ConIO (Task (Maybe a))
raceManyMaybe :: forall (t :: * -> *) a.
Traversable t =>
t (IO (Maybe a)) -> ConIO (Task (Maybe a))
raceManyMaybe t (IO (Maybe a))
actions = do
  raceResult <- IO (TMVar (Maybe a)) -> ConIO (TMVar (Maybe a))
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar (Maybe a))
forall a. IO (TMVar a)
newEmptyTMVarIO
  counter <- liftIO (newTVarIO (length actions))
  tasks <- withConScope $ \ConScope s
scope -> t (IO (Maybe a))
-> (IO (Maybe a) -> IO (Task Bool)) -> IO (t (Task Bool))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t (IO (Maybe a))
actions ((IO (Maybe a) -> IO (Task Bool)) -> IO (t (Task Bool)))
-> (IO (Maybe a) -> IO (Task Bool)) -> IO (t (Task Bool))
forall a b. (a -> b) -> a -> b
$ \IO (Maybe a)
action -> do
    task <- ConScope s -> ConIO (Task Bool) -> IO (Task Bool)
forall {k} (s :: k) a. ConScope s -> ConIO a -> IO a
useConScope ConScope s
scope (ConIO (Task Bool) -> IO (Task Bool))
-> ConIO (Task Bool) -> IO (Task Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> ConIO (Task Bool)
forall a. IO a -> ConIO (Task a)
launch (IO Bool -> ConIO (Task Bool)) -> IO Bool -> ConIO (Task Bool)
forall a b. (a -> b) -> a -> b
$ do
      maybeResult <- IO (Maybe a)
action
      atomically $ modifyTVar' counter pred
      case maybeResult of
        Just a
result -> STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe a) -> Maybe a -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar (Maybe a)
raceResult (a -> Maybe a
forall a. a -> Maybe a
Just a
result)
        Maybe a
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    pure task
  cancellerTask <- launch $ do
    shouldCancel <- atomically $ do
      currentRaceResult <- tryReadTMVar raceResult
      case currentRaceResult of
        Just Maybe a
_ -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Maybe (Maybe a)
Nothing -> do
          currentCounter <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
counter
          if currentCounter == 0
            then do
              putTMVar raceResult Nothing
              pure False
            else retry
    when shouldCancel $ traverse_ cancel tasks
  pure $
    Task
      { payload = readTMVar raceResult,
        threadIds = foldMap (.threadIds) tasks <> cancellerTask.threadIds
      }

-- | Time out an action.
timeout :: Duration -> IO a -> ConIO (Maybe a)
timeout :: forall a. Duration -> IO a -> ConIO (Maybe a)
timeout Duration
duration IO a
action = do
  t <- IO (Maybe a) -> IO (Maybe a) -> ConIO (Task (Maybe a))
forall a. IO a -> IO a -> ConIO (Task a)
raceTwo (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action) (Int -> IO ()
threadDelay Int
maxWaitTime IO () -> IO (Maybe a) -> IO (Maybe a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
  wait t
  where
    maxWaitTime :: Int
maxWaitTime = 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

-- | Race two already started 'Task's. The slower one is cancelled.
--
-- Keep in mind that cancelling the resulting 'Task' will cancel both given 'Task's.
raceTwoTasks :: Task a -> Task a -> ConIO (Task a)
raceTwoTasks :: forall a. Task a -> Task a -> ConIO (Task a)
raceTwoTasks Task a
task1 Task a
task2 = mdo
  result <- IO (MVar a) -> ConIO (MVar a)
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  checkTask1 <- launch $ do
    value1 <- wait task1
    wasPut <- tryPutMVar result value1
    when wasPut $ cancel task2 >> cancel checkTask2
  checkTask2 <- launch $ do
    value2 <- wait task2
    wasPut <- tryPutMVar result value2
    when wasPut $ cancel task1 >> cancel checkTask1
  task <- launch $ takeMVar result
  pure $
    Task
      { payload = wait task,
        threadIds =
          task.threadIds
            <> foldMap (.threadIds) [task1, task2]
            <> foldMap (.threadIds) [checkTask1, checkTask2]
      }

-- | Race already started 'Task's and use the first produced Just value. The slower task is cancelled.
--
-- Keep in mind that cancelling the resulting 'Task' will cancel both given 'Task's.
raceTwoTasksMaybe :: Task (Maybe a) -> Task (Maybe a) -> ConIO (Task (Maybe a))
raceTwoTasksMaybe :: forall a.
Task (Maybe a) -> Task (Maybe a) -> ConIO (Task (Maybe a))
raceTwoTasksMaybe Task (Maybe a)
task1 Task (Maybe a)
task2 = [Task (Maybe a)] -> ConIO (Task (Maybe a))
forall (t :: * -> *) a.
Traversable t =>
t (Task (Maybe a)) -> ConIO (Task (Maybe a))
raceManyTasksMaybe [Task (Maybe a)
task1, Task (Maybe a)
task2]

-- | Race already started 'Task's. The slower ones are cancelled.
--
-- Keep in mind that cancelling the resulting 'Task' will all given 'Task's.
raceManyTasks :: (Traversable t) => t (Task a) -> ConIO (Task a)
raceManyTasks :: forall (t :: * -> *) a.
Traversable t =>
t (Task a) -> ConIO (Task a)
raceManyTasks t (Task a)
tasks = do
  raceResult <- IO (MVar a) -> ConIO (MVar a)
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  checkTasks <- forM tasks $ \Task a
task -> do
    checkTask <- IO Bool -> ConIO (Task Bool)
forall a. IO a -> ConIO (Task a)
launch (IO Bool -> ConIO (Task Bool)) -> IO Bool -> ConIO (Task Bool)
forall a b. (a -> b) -> a -> b
$ do
      result <- Task a -> IO a
forall (m :: * -> *) a. MonadSTM m => Task a -> m a
wait Task a
task
      tryPutMVar raceResult result
    pure checkTask
  task <- launch $ do
    a <- takeMVar raceResult
    traverse_ cancel tasks
    traverse_ cancel checkTasks
    pure a
  pure $
    Task
      { payload = wait task,
        threadIds =
          task.threadIds
            <> foldMap (.threadIds) tasks
            <> foldMap (.threadIds) checkTasks
      }

-- | Race already started 'Task's and use the first produced Just value. The slower tasks are cancelled.
--
-- Keep in mind that cancelling the resulting 'Task' will all given 'Task's.
raceManyTasksMaybe :: (Traversable t) => t (Task (Maybe a)) -> ConIO (Task (Maybe a))
raceManyTasksMaybe :: forall (t :: * -> *) a.
Traversable t =>
t (Task (Maybe a)) -> ConIO (Task (Maybe a))
raceManyTasksMaybe t (Task (Maybe a))
tasks = do
  raceResult <- IO (TMVar (Maybe a)) -> ConIO (TMVar (Maybe a))
forall a. IO a -> ConIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar (Maybe a))
forall a. IO (TMVar a)
newEmptyTMVarIO
  counter <- liftIO (newTVarIO (length tasks))
  checkTasks <- withConScope $ \ConScope s
scope -> t (Task (Maybe a))
-> (Task (Maybe a) -> IO (Task Bool)) -> IO (t (Task Bool))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t (Task (Maybe a))
tasks ((Task (Maybe a) -> IO (Task Bool)) -> IO (t (Task Bool)))
-> (Task (Maybe a) -> IO (Task Bool)) -> IO (t (Task Bool))
forall a b. (a -> b) -> a -> b
$ \Task (Maybe a)
task -> do
    task <- ConScope s -> ConIO (Task Bool) -> IO (Task Bool)
forall {k} (s :: k) a. ConScope s -> ConIO a -> IO a
useConScope ConScope s
scope (ConIO (Task Bool) -> IO (Task Bool))
-> ConIO (Task Bool) -> IO (Task Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> ConIO (Task Bool)
forall a. IO a -> ConIO (Task a)
launch (IO Bool -> ConIO (Task Bool)) -> IO Bool -> ConIO (Task Bool)
forall a b. (a -> b) -> a -> b
$ do
      maybeResult <- Task (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a. MonadSTM m => Task a -> m a
wait Task (Maybe a)
task
      atomically $ modifyTVar' counter pred
      case maybeResult of
        Just a
result -> STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe a) -> Maybe a -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar (Maybe a)
raceResult (a -> Maybe a
forall a. a -> Maybe a
Just a
result)
        Maybe a
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    pure task
  cancellerTask <- launch $ do
    shouldCancel <- atomically $ do
      currentRaceResult <- tryReadTMVar raceResult
      case currentRaceResult of
        Just Maybe a
_ -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Maybe (Maybe a)
Nothing -> do
          currentCounter <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
counter
          if currentCounter == 0
            then do
              putTMVar raceResult Nothing
              pure False
            else retry
    when shouldCancel $ do
      traverse_ cancel tasks
      traverse_ cancel checkTasks
  pure $
    Task
      { payload = readTMVar raceResult,
        threadIds = foldMap (.threadIds) tasks <> foldMap (.threadIds) checkTasks <> cancellerTask.threadIds
      }

-- | Time out a 'Task', counting the 'Duration' down from the moment that 'timeoutTask' is executed.
-- The total runtime of the 'Task' does not matter.
timeoutTask :: Duration -> Task a -> ConIO (Task (Maybe a))
timeoutTask :: forall a. Duration -> Task a -> ConIO (Task (Maybe a))
timeoutTask Duration
duration Task a
task = do
  timer <- IO (Maybe a) -> ConIO (Task (Maybe a))
forall a. IO a -> ConIO (Task a)
launch (Int -> IO ()
threadDelay Int
maxWaitTime IO () -> IO (Maybe a) -> IO (Maybe a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
  raceTwoTasks (Just <$> task) timer
  where
    maxWaitTime :: Int
maxWaitTime = 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

-- | 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

-- | 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)

-- | '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 seconds
fromSeconds :: Word -> Duration
fromSeconds :: Word -> Duration
fromSeconds 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
fromMilliseconds :: Word -> Duration
fromMilliseconds :: Word -> Duration
fromMilliseconds 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