o-clock-0.1.0: Type-safe time library.

Safe HaskellNone
LanguageHaskell2010

Time.Units

Contents

Description

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

Synopsis

Time

newtype Time (rat :: Rat) Source #

Time unit is represented as type level rational multiplier with kind Rat.

Constructors

Time 

Fields

Instances

Enum (Time rat) Source # 

Methods

succ :: Time rat -> Time rat #

pred :: Time rat -> Time rat #

toEnum :: Int -> Time rat #

fromEnum :: Time rat -> Int #

enumFrom :: Time rat -> [Time rat] #

enumFromThen :: Time rat -> Time rat -> [Time rat] #

enumFromTo :: Time rat -> Time rat -> [Time rat] #

enumFromThenTo :: Time rat -> Time rat -> Time rat -> [Time rat] #

Eq (Time rat) Source # 

Methods

(==) :: Time rat -> Time rat -> Bool #

(/=) :: Time rat -> Time rat -> Bool #

Fractional (Time unit) Source #

Has the same behavior as derived instance, but / operator throws the runtime error with error.

Methods

(/) :: Time unit -> Time unit -> Time unit #

recip :: Time unit -> Time unit #

fromRational :: Rational -> Time unit #

Num (Time unit) Source #

Has the same behavior as derived instance, but * operator throws the runtime error with error.

Methods

(+) :: Time unit -> Time unit -> Time unit #

(-) :: Time unit -> Time unit -> Time unit #

(*) :: Time unit -> Time unit -> Time unit #

negate :: Time unit -> Time unit #

abs :: Time unit -> Time unit #

signum :: Time unit -> Time unit #

fromInteger :: Integer -> Time unit #

Ord (Time rat) Source # 

Methods

compare :: 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 #

max :: Time rat -> Time rat -> Time rat #

min :: Time rat -> Time rat -> Time rat #

KnownUnitName unit => Read (Time unit) Source # 

Methods

readsPrec :: Int -> ReadS (Time unit) #

readList :: ReadS [Time unit] #

readPrec :: ReadPrec (Time unit) #

readListPrec :: ReadPrec [Time unit] #

Real (Time rat) Source # 

Methods

toRational :: Time rat -> Rational #

RealFrac (Time rat) Source # 

Methods

properFraction :: Integral b => Time rat -> (b, Time rat) #

truncate :: Integral b => Time rat -> b #

round :: Integral b => Time rat -> b #

ceiling :: Integral b => Time rat -> b #

floor :: Integral b => Time rat -> b #

KnownUnitName unit => Show (Time unit) Source # 

Methods

showsPrec :: Int -> Time unit -> ShowS #

show :: Time unit -> String #

showList :: [Time unit] -> ShowS #

Generic (Time rat) Source # 

Associated Types

type Rep (Time rat) :: * -> * #

Methods

from :: Time rat -> Rep (Time rat) x #

to :: Rep (Time rat) x -> Time rat #

type Rep (Time rat) Source # 
type Rep (Time rat) = D1 * (MetaData "Time" "Time.Units" "o-clock-0.1.0-7lwW4MNCemo8IYOhw9yjfA" True) (C1 * (MetaCons "Time" PrefixI True) (S1 * (MetaSel (Just Symbol "unTime") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * RatioNat)))

Time data types

type Second = 1 :% 1 Source #

type Millisecond = 1 :% 1000 Source #

type Microsecond = 1 :% 1000000 Source #

type Nanosecond = 1 :% 1000000000 Source #

type Picosecond = 1 :% 1000000000000 Source #

type Minute = 60 :% 1 Source #

type Hour = 3600 :% 1 Source #

type Day = 86400 :% 1 Source #

type Week = 604800 :% 1 Source #

type Fortnight = 1209600 :% 1 Source #

type family UnitName (unit :: Rat) :: Symbol Source #

Type family for prettier show of time units.

Instances

type UnitName ((:%) 1 1) Source # 
type UnitName ((:%) 1 1) = "s"
type UnitName ((:%) 1 1000) Source # 
type UnitName ((:%) 1 1000) = "ms"
type UnitName ((:%) 1 1000000) Source # 
type UnitName ((:%) 1 1000000) = "mcs"
type UnitName ((:%) 1 1000000000) Source # 
type UnitName ((:%) 1 1000000000) = "ns"
type UnitName ((:%) 1 1000000000000) Source # 
type UnitName ((:%) 1 1000000000000) = "ps"
type UnitName ((:%) 60 1) Source # 
type UnitName ((:%) 60 1) = "m"
type UnitName ((:%) 3600 1) Source # 
type UnitName ((:%) 3600 1) = "h"
type UnitName ((:%) 86400 1) Source # 
type UnitName ((:%) 86400 1) = "d"
type UnitName ((:%) 604800 1) Source # 
type UnitName ((:%) 604800 1) = "w"
type UnitName ((:%) 1209600 1) Source # 
type UnitName ((:%) 1209600 1) = "fn"

type KnownUnitName unit = KnownSymbol (UnitName unit) Source #

Constraint alias for KnownSymbol UnitName.

type KnownRatName unit = (KnownUnitName unit, KnownRat unit) Source #

Constraint alias for KnownUnitName and KnownRat for time unit.

unitNameVal :: forall (unit :: Rat). KnownUnitName unit => String Source #

Returns type-level Symbol of the time unit converted to String.

Creation helpers

time :: RatioNat -> Time unit Source #

Creates Time of some type from given Natural.

floorUnit :: forall (unit :: Rat). Time unit -> Time unit Source #

Similar to floor, but works with Time units.

>>> floorUnit @Day (Time $ 5 % 2)
2d
>>> floorUnit (Time @Second $ 2 % 3)
0s
>>> floorUnit $ ps 42
42ps

toNum :: forall (unitTo :: Rat) n (unit :: Rat). (KnownDivRat unit unitTo, Num n) => Time unit -> n Source #

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

sec :: RatioNat -> Time Second Source #

Creates Second from given Natural.

>>> sec 42
42s

ms :: RatioNat -> Time Millisecond Source #

Creates Millisecond from given Natural.

>>> ms 42
42ms

mcs :: RatioNat -> Time Microsecond Source #

Creates Microsecond from given Natural.

>>> mcs 42
42mcs

ns :: RatioNat -> Time Nanosecond Source #

Creates Nanosecond from given Natural.

>>> ns 42
42ns

ps :: RatioNat -> Time Picosecond Source #

Creates Picosecond from given Natural.

>>> ps 42
42ps

minute :: RatioNat -> Time Minute Source #

Creates Minute from given Natural.

>>> minute 42
42m

hour :: RatioNat -> Time Hour Source #

Creates Hour from given Natural.

>>> hour 42
42h

day :: RatioNat -> Time Day Source #

Creates Day from given Natural.

>>> day 42
42d

week :: RatioNat -> Time Week Source #

Creates Week from given Natural.

>>> week 42
42w

fortnight :: RatioNat -> Time Fortnight Source #

Creates Fortnight from given Natural.

>>> fortnight 42
42fn

Functions

toUnit :: forall (unitTo :: Rat) (unitFrom :: Rat). KnownDivRat unitFrom unitTo => Time unitFrom -> Time unitTo Source #

Converts from one time unit to another time unit.

>>> toUnit @Hour (120 :: Time Minute)
2h
>>> toUnit @Second (ms 7)
7/1000s
>>> toUnit @Week (Time @Day 45)
6+3/7w
>>> toUnit @Second @Minute 3
180s
>>> toUnit (day 42000000) :: Time Second
3628800000000s

threadDelay :: forall (unit :: Rat) m. (KnownDivRat unit Microsecond, MonadIO m) => Time unit -> m () Source #

Convenient version of threadDelay which takes any time-unit and operates in any MonadIO.

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

getCPUTime :: forall (unit :: Rat) m. (KnownDivRat Picosecond unit, MonadIO m) => m (Time unit) Source #

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

timeout Source #

Arguments

:: forall (unit :: Rat). (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

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