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

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE ExplicitForAll             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE NoStarIsType               #-}
{-# 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
       , ceilingUnit
       , ceilingRat
       , toFractional

       , 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.Coerce (coerce)
import Data.Data (Data)
#if !(MIN_VERSION_base(4,20,0))
import Data.Foldable (foldl')
#endif
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import GHC.Generics (Generic)
import GHC.Natural (Natural)
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 (FromJSON (..), ToJSON (..), withText)
import qualified Data.Text as Text
import Text.Read (readMaybe)
#endif

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

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 { forall (rat :: Rat). 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
$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
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
$ccompare :: forall (rat :: Rat). Time rat -> Time rat -> Ordering
compare :: Time rat -> Time rat -> Ordering
$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
>= :: Time rat -> Time rat -> Bool
$cmax :: forall (rat :: Rat). Time rat -> Time rat -> Time rat
max :: Time rat -> Time rat -> Time rat
$cmin :: forall (rat :: Rat). Time rat -> Time rat -> Time rat
min :: Time rat -> Time rat -> 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]
$csucc :: forall (rat :: Rat). Time rat -> Time rat
succ :: Time rat -> Time rat
$cpred :: forall (rat :: Rat). Time rat -> Time rat
pred :: Time rat -> Time rat
$ctoEnum :: forall (rat :: Rat). Int -> Time rat
toEnum :: Int -> Time rat
$cfromEnum :: forall (rat :: Rat). Time rat -> Int
fromEnum :: Time rat -> Int
$cenumFrom :: forall (rat :: Rat). Time rat -> [Time rat]
enumFrom :: Time rat -> [Time rat]
$cenumFromThen :: forall (rat :: Rat). Time rat -> Time rat -> [Time rat]
enumFromThen :: Time rat -> Time rat -> [Time rat]
$cenumFromTo :: forall (rat :: Rat). Time rat -> Time rat -> [Time rat]
enumFromTo :: Time rat -> Time rat -> [Time rat]
$cenumFromThenTo :: forall (rat :: Rat). Time rat -> Time rat -> Time rat -> [Time rat]
enumFromThenTo :: Time rat -> Time 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
$cfrom :: forall (rat :: Rat) x. Time rat -> Rep (Time rat) x
from :: forall x. Time rat -> Rep (Time rat) x
$cto :: forall (rat :: Rat) x. Rep (Time rat) x -> Time rat
to :: forall x. Rep (Time rat) x -> Time rat
Generic, Typeable (Time rat)
Typeable (Time rat) =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Time rat -> c (Time rat))
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Time rat))
-> (Time rat -> Constr)
-> (Time rat -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Time rat)))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Time rat)))
-> ((forall b. Data b => b -> b) -> Time rat -> Time rat)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Time rat -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Time rat -> r)
-> (forall u. (forall d. Data d => d -> u) -> Time rat -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Time rat -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Time rat -> m (Time rat))
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Time rat -> m (Time rat))
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Time rat -> m (Time rat))
-> Data (Time rat)
Time rat -> Constr
Time rat -> DataType
(forall b. Data b => b -> b) -> Time rat -> Time rat
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Time rat -> u
forall u. (forall d. Data d => d -> u) -> Time rat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
forall (rat :: Rat). Typeable rat => Typeable (Time rat)
forall (rat :: Rat). Typeable rat => Time rat -> Constr
forall (rat :: Rat). Typeable rat => Time rat -> DataType
forall (rat :: Rat).
Typeable rat =>
(forall b. Data b => b -> b) -> Time rat -> Time rat
forall (rat :: Rat) u.
Typeable rat =>
Int -> (forall d. Data d => d -> u) -> Time rat -> u
forall (rat :: Rat) u.
Typeable rat =>
(forall d. Data d => d -> u) -> Time rat -> [u]
forall (rat :: Rat) r r'.
Typeable rat =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
forall (rat :: Rat) r r'.
Typeable rat =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
forall (rat :: Rat) (m :: Type -> Type).
(Typeable rat, Monad m) =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
forall (rat :: Rat) (m :: Type -> Type).
(Typeable rat, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
forall (rat :: Rat) (c :: Type -> Type).
Typeable rat =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Time rat)
forall (rat :: Rat) (c :: Type -> Type).
Typeable rat =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time rat -> c (Time rat)
forall (rat :: Rat) (t :: Type -> Type) (c :: Type -> Type).
(Typeable rat, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Time rat))
forall (rat :: Rat) (t :: Type -> Type -> Type)
       (c :: Type -> Type).
(Typeable rat, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Time rat))
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Time rat)
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time rat -> c (Time rat)
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Time rat))
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Time rat))
$cgfoldl :: forall (rat :: Rat) (c :: Type -> Type).
Typeable rat =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time rat -> c (Time rat)
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Time rat -> c (Time rat)
$cgunfold :: forall (rat :: Rat) (c :: Type -> Type).
Typeable rat =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Time rat)
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Time rat)
$ctoConstr :: forall (rat :: Rat). Typeable rat => Time rat -> Constr
toConstr :: Time rat -> Constr
$cdataTypeOf :: forall (rat :: Rat). Typeable rat => Time rat -> DataType
dataTypeOf :: Time rat -> DataType
$cdataCast1 :: forall (rat :: Rat) (t :: Type -> Type) (c :: Type -> Type).
(Typeable rat, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Time rat))
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Time rat))
$cdataCast2 :: forall (rat :: Rat) (t :: Type -> Type -> Type)
       (c :: Type -> Type).
(Typeable rat, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Time rat))
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Time rat))
$cgmapT :: forall (rat :: Rat).
Typeable rat =>
(forall b. Data b => b -> b) -> Time rat -> Time rat
gmapT :: (forall b. Data b => b -> b) -> Time rat -> Time rat
$cgmapQl :: forall (rat :: Rat) r r'.
Typeable rat =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
$cgmapQr :: forall (rat :: Rat) r r'.
Typeable rat =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Time rat -> r
$cgmapQ :: forall (rat :: Rat) u.
Typeable rat =>
(forall d. Data d => d -> u) -> Time rat -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Time rat -> [u]
$cgmapQi :: forall (rat :: Rat) u.
Typeable rat =>
Int -> (forall d. Data d => d -> u) -> Time rat -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Time rat -> u
$cgmapM :: forall (rat :: Rat) (m :: Type -> Type).
(Typeable rat, Monad m) =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
$cgmapMp :: forall (rat :: Rat) (m :: Type -> Type).
(Typeable rat, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
$cgmapMo :: forall (rat :: Rat) (m :: Type -> Type).
(Typeable rat, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Time rat -> m (Time rat)
Data)

-- | 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
forall a b. Coercible a b => a -> b
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 b a. (b -> a -> b) -> b -> NonEmpty a -> b
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 :: forall b. Integral b => 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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall (unit :: Rat). KnownUnitName unit => String
unitNameVal = Proxy (UnitName unit) -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). 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 (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 a b. ReadP a -> ReadP b -> ReadP a
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 a b. ReadP (a -> b) -> ReadP a -> ReadP b
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 a b. ReadP a -> ReadP b -> ReadP a
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 a b. ReadP (a -> b) -> ReadP a -> ReadP b
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 a b. ReadP (a -> b) -> ReadP a -> ReadP b
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 a b. ReadP a -> ReadP b -> ReadP b
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
== forall (unit :: Rat). KnownUnitName unit => String
unitNameVal @unit) ReadP ()
forall a. ReadP a
pfail
            Time unit -> ReadP (Time unit)
forall a. a -> ReadP a
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 :: forall (rat :: Rat). RatioNat -> Time rat
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
RatioNat -> Time (1 :% 1)
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
RatioNat -> Time (1 :% 1000)
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
RatioNat -> Time (1 :% 1000000)
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
RatioNat -> Time (1 :% 1000000000)
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
RatioNat -> Time (1 :% 1000000000000)
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
RatioNat -> Time (60 :% 1)
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
RatioNat -> Time (3600 :% 1)
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
RatioNat -> Time (86400 :% 1)
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
RatioNat -> Time (604800 :% 1)
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
RatioNat -> Time (1209600 :% 1)
forall (rat :: Rat). RatioNat -> Time rat
time
{-# INLINE fortnight #-}

-- | Returns the greatest integer not greater than given 'Time'.
floorRat :: forall b (unit :: Rat) . Integral b => Time unit -> b
floorRat :: forall b (unit :: Rat). Integral b => Time unit -> b
floorRat = RatioNat -> b
forall b. Integral b => 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 :: forall (rat :: Rat). Time rat -> Time rat
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 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 b (unit :: Rat). Integral b => Time unit -> b
floorRat

-- | Returns the smallest integer greater than or equal to the given 'Time'.
--
-- @since 1.3.0
ceilingRat :: forall b (unit :: Rat) . (Integral b) => Time unit -> b
ceilingRat :: forall b (unit :: Rat). Integral b => Time unit -> b
ceilingRat = RatioNat -> b
forall b. Integral b => RatioNat -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (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 'ceiling', but works with 'Time' units.

>>> ceilingUnit @Day (Time $ 5 % 2)
3d

>>> ceilingUnit (Time @Second $ 2 % 3)
1s

>>> ceilingUnit $ ps 42
42ps

@since 1.3.0
-}
ceilingUnit :: forall (unit :: Rat) . Time unit -> Time unit
ceilingUnit :: forall (rat :: Rat). Time rat -> Time rat
ceilingUnit = 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 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 b (unit :: Rat). Integral b => Time unit -> b
ceilingRat

{- | Convert the 'Time' object to the 'Fractional' value.

__Examples:__

>>> toFractional @Rational $ hour (1 % 8)
1 % 8

>>> toFractional @Double $ hour (1 % 8)
0.125

@since 1.3.0
-}
toFractional :: forall r (unit :: Rat) . Fractional r => Time unit -> r
toFractional :: forall r (unit :: Rat). Fractional r => Time unit -> r
toFractional = Rational -> r
forall a. Fractional a => Rational -> a
fromRational (Rational -> r) -> (Time unit -> Rational) -> Time unit -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Rational
forall a. Real a => a -> Rational
toRational (RatioNat -> Rational)
-> (Time unit -> RatioNat) -> Time unit -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time unit -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime

----------------------------------------------------------------------------
-- 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 :: forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit Time{RatioNat
unTime :: forall (rat :: Rat). Time rat -> RatioNat
unTime :: 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
* 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 :: forall (unit :: Rat) (m :: Type -> Type).
(KnownDivRat unit Microsecond, MonadIO m) =>
Time unit -> m ()
threadDelay = IO () -> m ()
forall a. IO a -> m a
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 b (unit :: Rat). 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 (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 :: forall (unit :: Rat) (m :: Type -> Type).
(KnownDivRat Picosecond unit, MonadIO m) =>
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 a. IO a -> m a
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 :: forall (unit :: Rat) (m :: Type -> Type) a.
(MonadIO m, KnownDivRat unit Microsecond) =>
Time unit -> IO a -> m (Maybe a)
timeout Time unit
t = IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m 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 Microsecond -> Int
forall b (unit :: Rat). Integral b => Time unit -> b
floorRat (Time Microsecond -> Int) -> Time Microsecond -> Int
forall a b. (a -> b) -> a -> b
$ forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Microsecond Time unit
t)
{-# INLINE timeout #-}