-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
--
-- SPDX-License-Identifier: MPL-2.0

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE ExplicitForAll             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
#if ( __GLASGOW_HASKELL__ >= 806 )
{-# LANGUAGE NoStarIsType               #-}
#endif
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | This module contains time unit data structures
-- and functions to work with time.

module Time.Units
       ( -- * Time
         Time (..)

         -- ** Time data types
       , Second
       , Millisecond
       , Microsecond
       , Nanosecond
       , Picosecond
       , Minute
       , Hour
       , Day
       , Week
       , Fortnight

       , UnitName
       , KnownUnitName
       , KnownRatName
       , unitNameVal

        -- ** Creation helpers
       , time
       , floorUnit
       , floorRat
       , toNum

       , sec
       , ms
       , mcs
       , ns
       , ps

       , minute
       , hour
       , day
       , week
       , fortnight

        -- ** Functions
       , toUnit
       , threadDelay
       , getCPUTime
       , timeout
       ) where

import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Char (isDigit, isLetter)
import Data.Foldable (foldl')
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import GHC.Prim (coerce)
import GHC.Read (Read (readPrec))
import GHC.Real (denominator, numerator, (%))
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Text.ParserCombinators.ReadP (ReadP, char, munch1, option, pfail, (+++))
import Text.ParserCombinators.ReadPrec (ReadPrec, lift)

#ifdef HAS_aeson
import Data.Aeson (ToJSON (..), FromJSON (..), withText)
import Text.Read (readMaybe)
import qualified Data.Text as Text
#endif

import Time.Rational (type (*), type (/), type (:%), KnownDivRat, Rat, RatioNat, KnownRat, ratVal)

import qualified Control.Concurrent as Concurrent
import qualified System.CPUTime as CPUTime
import qualified System.Timeout as Timeout

----------------------------------------------------------------------------
-- Units
----------------------------------------------------------------------------

type Second      = 1 / 1
type Millisecond = Second      / 1000
type Microsecond = Millisecond / 1000
type Nanosecond  = Microsecond / 1000
type Picosecond  = Nanosecond  / 1000

type Minute      = 60 * Second
type Hour        = 60 * Minute
type Day         = 24 * Hour
type Week        = 7  * Day
type Fortnight   = 2  * Week

----------------------------------------------------------------------------
-- Time data type
----------------------------------------------------------------------------

-- | Time unit is represented as type level rational multiplier with kind 'Rat'.
newtype Time (rat :: Rat) = Time { Time rat -> RatioNat
unTime :: RatioNat }
    deriving (Time rat -> Time rat -> Bool
(Time rat -> Time rat -> Bool)
-> (Time rat -> Time rat -> Bool) -> Eq (Time rat)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (rat :: Rat). Time rat -> Time rat -> Bool
/= :: Time rat -> Time rat -> Bool
$c/= :: forall (rat :: Rat). Time rat -> Time rat -> Bool
== :: Time rat -> Time rat -> Bool
$c== :: forall (rat :: Rat). Time rat -> Time rat -> Bool
Eq, Eq (Time rat)
Eq (Time rat)
-> (Time rat -> Time rat -> Ordering)
-> (Time rat -> Time rat -> Bool)
-> (Time rat -> Time rat -> Bool)
-> (Time rat -> Time rat -> Bool)
-> (Time rat -> Time rat -> Bool)
-> (Time rat -> Time rat -> Time rat)
-> (Time rat -> Time rat -> Time rat)
-> Ord (Time rat)
Time rat -> Time rat -> Bool
Time rat -> Time rat -> Ordering
Time rat -> Time rat -> Time rat
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
forall (rat :: Rat). Eq (Time rat)
forall (rat :: Rat). Time rat -> Time rat -> Bool
forall (rat :: Rat). Time rat -> Time rat -> Ordering
forall (rat :: Rat). Time rat -> Time rat -> Time rat
min :: Time rat -> Time rat -> Time rat
$cmin :: forall (rat :: Rat). Time rat -> Time rat -> Time rat
max :: Time rat -> Time rat -> Time rat
$cmax :: forall (rat :: Rat). Time rat -> Time rat -> Time rat
>= :: Time rat -> Time rat -> Bool
$c>= :: forall (rat :: Rat). Time rat -> Time rat -> Bool
> :: Time rat -> Time rat -> Bool
$c> :: forall (rat :: Rat). Time rat -> Time rat -> Bool
<= :: Time rat -> Time rat -> Bool
$c<= :: forall (rat :: Rat). Time rat -> Time rat -> Bool
< :: Time rat -> Time rat -> Bool
$c< :: forall (rat :: Rat). Time rat -> Time rat -> Bool
compare :: Time rat -> Time rat -> Ordering
$ccompare :: forall (rat :: Rat). Time rat -> Time rat -> Ordering
$cp1Ord :: forall (rat :: Rat). Eq (Time rat)
Ord, Int -> Time rat
Time rat -> Int
Time rat -> [Time rat]
Time rat -> Time rat
Time rat -> Time rat -> [Time rat]
Time rat -> Time rat -> Time rat -> [Time rat]
(Time rat -> Time rat)
-> (Time rat -> Time rat)
-> (Int -> Time rat)
-> (Time rat -> Int)
-> (Time rat -> [Time rat])
-> (Time rat -> Time rat -> [Time rat])
-> (Time rat -> Time rat -> [Time rat])
-> (Time rat -> Time rat -> Time rat -> [Time rat])
-> Enum (Time rat)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (rat :: Rat). Int -> Time rat
forall (rat :: Rat). Time rat -> Int
forall (rat :: Rat). Time rat -> [Time rat]
forall (rat :: Rat). Time rat -> Time rat
forall (rat :: Rat). Time rat -> Time rat -> [Time rat]
forall (rat :: Rat). Time rat -> Time rat -> Time rat -> [Time rat]
enumFromThenTo :: Time rat -> Time rat -> Time rat -> [Time rat]
$cenumFromThenTo :: forall (rat :: Rat). Time rat -> Time rat -> Time rat -> [Time rat]
enumFromTo :: Time rat -> Time rat -> [Time rat]
$cenumFromTo :: forall (rat :: Rat). Time rat -> Time rat -> [Time rat]
enumFromThen :: Time rat -> Time rat -> [Time rat]
$cenumFromThen :: forall (rat :: Rat). Time rat -> Time rat -> [Time rat]
enumFrom :: Time rat -> [Time rat]
$cenumFrom :: forall (rat :: Rat). Time rat -> [Time rat]
fromEnum :: Time rat -> Int
$cfromEnum :: forall (rat :: Rat). Time rat -> Int
toEnum :: Int -> Time rat
$ctoEnum :: forall (rat :: Rat). Int -> Time rat
pred :: Time rat -> Time rat
$cpred :: forall (rat :: Rat). Time rat -> Time rat
succ :: Time rat -> Time rat
$csucc :: forall (rat :: Rat). Time rat -> Time rat
Enum, (forall x. Time rat -> Rep (Time rat) x)
-> (forall x. Rep (Time rat) x -> Time rat) -> Generic (Time rat)
forall x. Rep (Time rat) x -> Time rat
forall x. Time rat -> Rep (Time rat) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (rat :: Rat) x. Rep (Time rat) x -> Time rat
forall (rat :: Rat) x. Time rat -> Rep (Time rat) x
$cto :: forall (rat :: Rat) x. Rep (Time rat) x -> Time rat
$cfrom :: forall (rat :: Rat) x. Time rat -> Rep (Time rat) x
Generic)

-- | Addition is associative binary operation for 'Semigroup' of 'Time'.
instance Semigroup (Time (rat :: Rat)) where
    <> :: Time rat -> Time rat -> Time rat
(<>) = (RatioNat -> RatioNat -> RatioNat)
-> Time rat -> Time rat -> Time rat
coerce (RatioNat -> RatioNat -> RatioNat
forall a. Num a => a -> a -> a
(+) :: RatioNat -> RatioNat -> RatioNat)
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty (Time rat) -> Time rat
sconcat = (Time rat -> Time rat -> Time rat)
-> Time rat -> NonEmpty (Time rat) -> Time rat
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Time rat -> Time rat -> Time rat
forall a. Semigroup a => a -> a -> a
(<>) Time rat
forall a. Monoid a => a
mempty
    {-# INLINE sconcat #-}
    stimes :: b -> Time rat -> Time rat
stimes b
n (Time RatioNat
t) = RatioNat -> Time rat
forall (rat :: Rat). RatioNat -> Time rat
Time (b -> RatioNat
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n RatioNat -> RatioNat -> RatioNat
forall a. Num a => a -> a -> a
* RatioNat
t)
    {-# INLINE stimes #-}

instance Monoid (Time (rat :: Rat)) where
    mempty :: Time rat
mempty  = RatioNat -> Time rat
forall (rat :: Rat). RatioNat -> Time rat
Time RatioNat
0
    {-# INLINE mempty #-}
    mappend :: Time rat -> Time rat -> Time rat
mappend = Time rat -> Time rat -> Time rat
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}
    mconcat :: [Time rat] -> Time rat
mconcat = (Time rat -> Time rat -> Time rat)
-> Time rat -> [Time rat] -> Time rat
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Time rat -> Time rat -> Time rat
forall a. Semigroup a => a -> a -> a
(<>) Time rat
forall a. Monoid a => a
mempty
    {-# INLINE mconcat #-}

#ifdef HAS_aeson
instance (KnownUnitName unit) => ToJSON (Time (unit :: Rat)) where
    toJSON = toJSON . show

instance (KnownUnitName unit) => FromJSON (Time (unit :: Rat)) where
    parseJSON = withText "time" $ maybe parseFail pure . maybeTime
      where
        parseFail = fail $ "Can not parse Time. Expected unit: " ++ unitNameVal @unit
        maybeTime = readMaybe @(Time unit) . Text.unpack
#endif

-- | Type family for prettier 'show' of time units.
type family UnitName (unit :: Rat) :: Symbol

type instance UnitName (1 :% 1)             = "s"   -- second unit
type instance UnitName (1 :% 1000)          = "ms"  -- millisecond unit
type instance UnitName (1 :% 1000000)       = "mcs" -- microsecond unit
type instance UnitName (1 :% 1000000000)    = "ns"  -- nanosecond unit
type instance UnitName (1 :% 1000000000000) = "ps"  -- picosecond unit

type instance UnitName (60      :% 1) = "m"  -- minute unit
type instance UnitName (3600    :% 1) = "h"  -- hour unit
type instance UnitName (86400   :% 1) = "d"  -- day unit
type instance UnitName (604800  :% 1) = "w"  -- week unit
type instance UnitName (1209600 :% 1) = "fn" -- fortnight unit

-- | Constraint alias for 'KnownSymbol' 'UnitName'.
type KnownUnitName unit = KnownSymbol (UnitName unit)

-- | Constraint alias for 'KnownUnitName' and 'KnownRat' for time unit.
type KnownRatName unit = (KnownUnitName unit, KnownRat unit)

-- | Returns type-level 'Symbol' of the time unit converted to 'String'.
unitNameVal :: forall (unit :: Rat) . (KnownUnitName unit) => String
unitNameVal :: String
unitNameVal = Proxy (UnitName unit) -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (UnitName unit)
forall k (t :: k). Proxy t
Proxy @(UnitName unit))

instance KnownUnitName unit => Show (Time unit) where
    showsPrec :: Int -> Time unit -> ShowS
showsPrec Int
p (Time RatioNat
t) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6)
                              (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ RatioNat -> ShowS
forall a. (Integral a, Show a) => Ratio a -> ShowS
showsMixed RatioNat
t
                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (KnownUnitName unit => String
forall (unit :: Rat). KnownUnitName unit => String
unitNameVal @unit)
      where
        showsMixed :: Ratio a -> ShowS
showsMixed Ratio a
0 = String -> ShowS
showString String
"0"
        showsMixed Ratio a
rat =
          let (a
n,a
d) = (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
rat, Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
rat)
              (a
q,a
r) = a
n a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
d
              op :: String
op = if a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then String
"" else String
"+"
              quotStr :: ShowS
quotStr = if a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                          then ShowS
forall a. a -> a
id -- NB id === showString ""
                          else a -> ShowS
forall a. Show a => a -> ShowS
shows a
q
              remStr :: ShowS
remStr = if a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                         then ShowS
forall a. a -> a
id
                         else a -> ShowS
forall a. Show a => a -> ShowS
shows a
r
                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"/"
                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
d
          in
              ShowS
quotStr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
op ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
remStr

instance KnownUnitName unit => Read (Time unit) where
    readPrec :: ReadPrec (Time unit)
    readPrec :: ReadPrec (Time unit)
readPrec = ReadP (Time unit) -> ReadPrec (Time unit)
forall a. ReadP a -> ReadPrec a
lift ReadP (Time unit)
readP
      where
        readP :: ReadP (Time unit)
        readP :: ReadP (Time unit)
readP = do
            let naturalP :: ReadP Natural
naturalP = String -> Natural
forall a. Read a => String -> a
read (String -> Natural) -> ReadP String -> ReadP Natural
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
            -- If a '+' is parsed as part of a mixed fraction, the other parts
            -- are no longer optional.  This separation is required to prevent
            -- e.g. "3+2" successfully parsing.
            let fullMixedExpr :: ReadP (Natural, Natural, Natural)
fullMixedExpr = (,,) (Natural -> Natural -> Natural -> (Natural, Natural, Natural))
-> ReadP Natural
-> ReadP (Natural -> Natural -> (Natural, Natural, Natural))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP Natural
naturalP ReadP Natural -> ReadP Char -> ReadP Natural
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
'+')
                                     ReadP (Natural -> Natural -> (Natural, Natural, Natural))
-> ReadP Natural -> ReadP (Natural -> (Natural, Natural, Natural))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (ReadP Natural
naturalP ReadP Natural -> ReadP Char -> ReadP Natural
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
'/')
                                     ReadP (Natural -> (Natural, Natural, Natural))
-> ReadP Natural -> ReadP (Natural, Natural, Natural)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ReadP Natural
naturalP
            let improperExpr :: ReadP (Natural, Natural, Natural)
improperExpr = (,,) Natural
0 (Natural -> Natural -> (Natural, Natural, Natural))
-> ReadP Natural -> ReadP (Natural -> (Natural, Natural, Natural))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Natural
naturalP
                                      ReadP (Natural -> (Natural, Natural, Natural))
-> ReadP Natural -> ReadP (Natural, Natural, Natural)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Natural -> ReadP Natural -> ReadP Natural
forall a. a -> ReadP a -> ReadP a
option Natural
1 (Char -> ReadP Char
char Char
'/' ReadP Char -> ReadP Natural -> ReadP Natural
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ReadP Natural
naturalP)
            (Natural
q,Natural
r,Natural
d) <- ReadP (Natural, Natural, Natural)
fullMixedExpr ReadP (Natural, Natural, Natural)
-> ReadP (Natural, Natural, Natural)
-> ReadP (Natural, Natural, Natural)
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP (Natural, Natural, Natural)
improperExpr
            let n :: Natural
n = (Natural
q Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
d Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
r)
            String
timeUnitStr <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isLetter
            Bool -> ReadP () -> ReadP ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (String
timeUnitStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== KnownUnitName unit => String
forall (unit :: Rat). KnownUnitName unit => String
unitNameVal @unit) ReadP ()
forall a. ReadP a
pfail
            Time unit -> ReadP (Time unit)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Time unit -> ReadP (Time unit)) -> Time unit -> ReadP (Time unit)
forall a b. (a -> b) -> a -> b
$ RatioNat -> Time unit
forall (rat :: Rat). RatioNat -> Time rat
Time (Natural
n Natural -> Natural -> RatioNat
forall a. Integral a => a -> a -> Ratio a
% Natural
d)

----------------------------------------------------------------------------
-- Creation helpers
----------------------------------------------------------------------------

-- | Creates 'Time' of some type from given 'Natural'.
time :: RatioNat -> Time unit
time :: RatioNat -> Time unit
time RatioNat
n = RatioNat -> Time unit
forall (rat :: Rat). RatioNat -> Time rat
Time RatioNat
n
{-# INLINE time #-}

-- | Creates 'Second' from given 'Natural'.
--
-- >>> sec 42
-- 42s
sec :: RatioNat -> Time Second
sec :: RatioNat -> Time Second
sec = RatioNat -> Time Second
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE sec #-}

-- | Creates 'Millisecond' from given 'Natural'.
--
-- >>> ms 42
-- 42ms
ms :: RatioNat -> Time Millisecond
ms :: RatioNat -> Time Millisecond
ms = RatioNat -> Time Millisecond
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE ms #-}

-- | Creates 'Microsecond' from given 'Natural'.
--
-- >>> mcs 42
-- 42mcs
mcs :: RatioNat -> Time Microsecond
mcs :: RatioNat -> Time Microsecond
mcs = RatioNat -> Time Microsecond
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE mcs #-}

-- | Creates 'Nanosecond' from given 'Natural'.
--
-- >>> ns 42
-- 42ns
ns :: RatioNat -> Time Nanosecond
ns :: RatioNat -> Time Nanosecond
ns = RatioNat -> Time Nanosecond
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE ns #-}

-- | Creates 'Picosecond' from given 'Natural'.
--
-- >>> ps 42
-- 42ps
ps :: RatioNat -> Time Picosecond
ps :: RatioNat -> Time Picosecond
ps = RatioNat -> Time Picosecond
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE ps #-}

-- | Creates 'Minute' from given 'Natural'.
--
-- >>> minute 42
-- 42m
minute :: RatioNat -> Time Minute
minute :: RatioNat -> Time Minute
minute = RatioNat -> Time Minute
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE minute #-}

-- | Creates 'Hour' from given 'Natural'.
--
-- >>> hour 42
-- 42h
hour :: RatioNat -> Time Hour
hour :: RatioNat -> Time Hour
hour = RatioNat -> Time Hour
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE hour #-}

-- | Creates 'Day' from given 'Natural'.
--
-- >>> day 42
-- 42d
day :: RatioNat -> Time Day
day :: RatioNat -> Time Day
day = RatioNat -> Time Day
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE day #-}

-- | Creates 'Week' from given 'Natural'.
--
-- >>> week 42
-- 42w
week :: RatioNat -> Time Week
week :: RatioNat -> Time Week
week = RatioNat -> Time Week
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE week #-}

-- | Creates 'Fortnight' from given 'Natural'.
--
-- >>> fortnight 42
-- 42fn
fortnight :: RatioNat -> Time Fortnight
fortnight :: RatioNat -> Time Fortnight
fortnight = RatioNat -> Time Fortnight
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE fortnight #-}

-- | Returns the greatest integer not greater than given 'Time'.
floorRat :: forall (unit :: Rat) b . (Integral b) => Time unit -> b
floorRat :: Time unit -> b
floorRat = RatioNat -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (RatioNat -> b) -> (Time unit -> RatioNat) -> Time unit -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime

{- | Similar to 'floor', but works with 'Time' units.

>>> floorUnit @Day (Time $ 5 % 2)
2d

>>> floorUnit (Time @Second $ 2 % 3)
0s

>>> floorUnit $ ps 42
42ps

-}
floorUnit :: forall (unit :: Rat) . Time unit -> Time unit
floorUnit :: Time unit -> Time unit
floorUnit = RatioNat -> Time unit
forall (rat :: Rat). RatioNat -> Time rat
time (RatioNat -> Time unit)
-> (Time unit -> RatioNat) -> Time unit -> Time unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. (Integral Natural, Num b) => Natural -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural (Natural -> RatioNat)
-> (Time unit -> Natural) -> Time unit -> RatioNat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> Natural
forall (unit :: Rat) b. Integral b => Time unit -> b
floorRat

{- | Convert time to the 'Num' in given units.

For example, instead of writing

@
foo :: POSIXTime
foo = 10800  -- 3 hours
@

one can write more safe implementation:

@
foo = toNum @Second $ hour 3
@

__Examples:__

>>> toNum @Second @Natural $ hour 3
10800

>>> toNum @Minute @Int $ hour 3
180

>>> toNum @Hour @Natural $ hour 3
3

-}
toNum :: forall (unitTo :: Rat) n (unit :: Rat) . (KnownDivRat unit unitTo, Num n)
      => Time unit -> n
toNum :: Time unit -> n
toNum = forall b. (Integral Natural, Num b) => Natural -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural (Natural -> n) -> (Time unit -> Natural) -> Time unit -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unitTo -> Natural
forall (unit :: Rat) b. Integral b => Time unit -> b
floorRat (Time unitTo -> Natural)
-> (Time unit -> Time unitTo) -> Time unit -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @unitTo

----------------------------------------------------------------------------
-- Functional
----------------------------------------------------------------------------

{- | Converts from one time unit to another time unit.

>>> toUnit @Hour (minute 120)
2h

>>> toUnit @Second (ms 7)
7/1000s

>>> toUnit @Week (Time @Day 45)
6+3/7w

>>> toUnit @Second @Minute (Time 3)
180s

>>> toUnit (day 42000000) :: Time Second
3628800000000s

-}
toUnit :: forall (unitTo :: Rat) (unitFrom :: Rat) . KnownDivRat unitFrom unitTo
       => Time unitFrom
       -> Time unitTo
toUnit :: Time unitFrom -> Time unitTo
toUnit Time{RatioNat
unTime :: RatioNat
unTime :: forall (rat :: Rat). Time rat -> RatioNat
..} = RatioNat -> Time unitTo
forall (rat :: Rat). RatioNat -> Time rat
Time (RatioNat -> Time unitTo) -> RatioNat -> Time unitTo
forall a b. (a -> b) -> a -> b
$ RatioNat
unTime RatioNat -> RatioNat -> RatioNat
forall a. Num a => a -> a -> a
* KnownRat (unitFrom / unitTo) => RatioNat
forall (r :: Rat). KnownRat r => RatioNat
ratVal @(unitFrom / unitTo)
{-# INLINE toUnit #-}

{- | Convenient version of 'Control.Concurrent.threadDelay' which takes
 any time-unit and operates in any MonadIO.


@
__>>> threadDelay $ sec 2__
__>>> threadDelay (2 :: Time Second)__
__>>> threadDelay @Second 2__
@

-}
threadDelay :: forall (unit :: Rat) m . (KnownDivRat unit Microsecond, MonadIO m)
            => Time unit
            -> m ()
threadDelay :: Time unit -> m ()
threadDelay = IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Time unit -> IO ()) -> Time unit -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
Concurrent.threadDelay (Int -> IO ()) -> (Time unit -> Int) -> Time unit -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time (1 :% 1000000) -> Int
forall (unit :: Rat) b. Integral b => Time unit -> b
floorRat (Time (1 :% 1000000) -> Int)
-> (Time unit -> Time (1 :% 1000000)) -> Time unit -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (unitFrom :: Rat).
KnownDivRat unitFrom Microsecond =>
Time unitFrom -> Time Microsecond
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Microsecond
{-# INLINE threadDelay #-}

-- | Similar to 'CPUTime.getCPUTime' but returns the CPU time used by the current
-- program in the given time unit.
-- The precision of this result is implementation-dependent.
--
-- @
-- __>>> getCPUTime @Second__
-- 1064046949/1000000000s
-- @
--
getCPUTime :: forall (unit :: Rat) m . (KnownDivRat Picosecond unit, MonadIO m)
           => m (Time unit)
getCPUTime :: m (Time unit)
getCPUTime = Time (1 :% 1000000000000) -> Time unit
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit (Time (1 :% 1000000000000) -> Time unit)
-> (Integer -> Time (1 :% 1000000000000)) -> Integer -> Time unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Time Picosecond
RatioNat -> Time (1 :% 1000000000000)
ps (RatioNat -> Time (1 :% 1000000000000))
-> (Integer -> RatioNat) -> Integer -> Time (1 :% 1000000000000)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> RatioNat
forall a. Num a => Integer -> a
fromInteger (Integer -> Time unit) -> m Integer -> m (Time unit)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer -> m Integer
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Integer
CPUTime.getCPUTime
{-# INLINE getCPUTime #-}

{- | Similar to 'Timeout.timeout' but receiving any time unit
instead of number of microseconds.

@
__>>> timeout (sec 1) (putStrLn "Hello O'Clock")__
Hello O'Clock
Just ()
@

@
__>>> timeout (ps 1) (putStrLn "Hello O'Clock")__
Nothing
@

@
__>>> timeout (mcs 1) (putStrLn "Hello O'Clock")__
HellNothing
@

-}
timeout :: forall (unit :: Rat) m a . (MonadIO m, KnownDivRat unit Microsecond)
        => Time unit   -- ^ time
        -> IO a        -- ^ 'IO' action
        -> m (Maybe a) -- ^ returns 'Nothing' if no result is available within the given time
timeout :: Time unit -> IO a -> m (Maybe a)
timeout Time unit
t = IO (Maybe a) -> m (Maybe a)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a))
-> (IO a -> IO (Maybe a)) -> IO a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
Timeout.timeout (Time (1 :% 1000000) -> Int
forall (unit :: Rat) b. Integral b => Time unit -> b
floorRat (Time (1 :% 1000000) -> Int) -> Time (1 :% 1000000) -> Int
forall a b. (a -> b) -> a -> b
$ Time unit -> Time Microsecond
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Microsecond Time unit
t)
{-# INLINE timeout #-}