| Copyright | (c) Serokell 2016 |
|---|---|
| License | GPL-3 (see the file LICENSE) |
| Maintainer | Serokell <hi@serokell.io> |
| Stability | experimental |
| Portability | POSIX, GHC |
| Safe Haskell | None |
| Language | Haskell2010 |
Control.TimeWarp.Timed.MonadTimed
Contents
Description
This module defines typeclass MonadTimed with basic functions
to manipulate time and threads.
- class MonadThrow m => MonadTimed m where
- type family ThreadId (m :: * -> *) :: *
- type RelativeToNow = Microsecond -> Microsecond
- schedule :: MonadTimed m => RelativeToNow -> m () -> m ()
- invoke :: MonadTimed m => RelativeToNow -> m a -> m a
- timestamp :: (MonadTimed m, MonadIO m) => String -> m ()
- fork_ :: MonadTimed m => m () -> m ()
- work :: MonadTimed m => RelativeToNow -> m () -> m ()
- killThread :: MonadTimed m => ThreadId m -> m ()
- startTimer :: MonadTimed m => m (m Microsecond)
- hour :: Int -> Microsecond
- minute :: Int -> Microsecond
- sec :: Int -> Microsecond
- ms :: Int -> Microsecond
- mcs :: Int -> Microsecond
- hour' :: Double -> Microsecond
- minute' :: Double -> Microsecond
- sec' :: Double -> Microsecond
- ms' :: Double -> Microsecond
- mcs' :: Double -> Microsecond
- for :: TimeAccR t => t
- after :: TimeAccR t => t
- till :: TimeAccR t => t
- at :: TimeAccR t => t
- now :: RelativeToNow
- interval :: TimeAccM t => t
- timepoint :: TimeAccM t => t
- data Microsecond :: *
- data Millisecond :: *
- data Second :: *
- data Minute :: *
- class TimeAccR t
- class TimeAccM t
- data MonadTimedError = MTTimeoutError Text
Typeclass with basic functions
class MonadThrow m => MonadTimed m where Source #
Allows time management. Time is specified in microseconds passed from launch point (origin), this time is further called virtual time.
Instance of MonadTimed should satisfy the following law:
- when defining instance of MonadTrans for a monad,
information stored inside the transformer should be tied to thread, and
get cloned on
forks.
For example,
instance MonadTimed m => MonadTimed (StateT s m)
is declared such that:
example :: (MonadTimed m, MonadIO m) => StateT Int m ()
example = do
put 1
fork $ put 10 -- main thread won't be touched
wait $ for 1 sec -- wait for forked thread to execute
liftIO . print =<< get
>>>runTimedT $ runStateT undefined example1
When implement instance of this typeclass, don't forget to define ThreadId
first.
Minimal complete definition
virtualTime, currentTime, wait, fork, myThreadId, throwTo, timeout, forkSlave
Methods
virtualTime :: m Microsecond Source #
Acquires virtual time.
currentTime :: m Microsecond Source #
Acquires (pseudo-)real time.
wait :: RelativeToNow -> m () Source #
Waits for specified amount of time.
Use for to specify relative virtual time (counting from now),
and till for absolute one.
>>>runTimedT $ wait (for 1 sec) >> wait (for 5 sec) >> timestamp "now"[6000000µs] now>>>runTimedT $ wait (for 1 sec) >> wait (till 5 sec) >> timestamp "now"[5000000µs] now>>>runTimedT $ wait (for 10 minute 34 sec 52 ms) >> timestamp "now"[634052000µs] now
fork :: m () -> m (ThreadId m) Source #
Creates another thread of execution, with same point of origin.
myThreadId :: m (ThreadId m) Source #
Acquires current thread id.
throwTo :: Exception e => ThreadId m -> e -> m () Source #
Arises specified exception in specified thread.
timeout :: TimeUnit t => t -> m a -> m a Source #
Throws a MTTimeoutError exception
if running action exceeds specified time.
forkSlave :: m () -> m (ThreadId m) Source #
From `slave-thread` library.
Instances
| MonadTimed TimedIO Source # | |
| MonadTimed m => MonadTimed (LoggerNameBox m) Source # | |
| (CanLog m, MonadIO m, MonadThrow m, MonadCatch m) => MonadTimed (TimedT m) Source # | |
| MonadTimed (Transfer s) Source # | |
| MonadTimed m => MonadTimed (StateT s m) Source # | |
| MonadTimed m => MonadTimed (ResponseT s m) Source # | |
| MonadTimed m => MonadTimed (Dialog p m) Source # | |
| MonadTimed m => MonadTimed (ReaderT * r m) Source # | |
type RelativeToNow = Microsecond -> Microsecond Source #
Defines some time point basing on current virtual time.
Helper functions
schedule :: MonadTimed m => RelativeToNow -> m () -> m () Source #
Executes an action somewhere in future in another thread.
Use after to specify relative virtual time (counting from now),
and at for absolute one.
schedule time action ≡ fork_ $ wait time >> action
example :: (MonadTimed m, MonadIO m) => m ()
example = do
wait (for 10 sec)
schedule (after 3 sec) $ timestamp "This would happen at 13 sec"
schedule (at 15 sec) $ timestamp "This would happen at 15 sec"
timestamp "And this happens immediately after start"
invoke :: MonadTimed m => RelativeToNow -> m a -> m a Source #
Executes an action at specified time in current thread.
Use after to specify relative virtual time (counting from now),
and at for absolute one.
invoke time action ≡ wait time >> action
example :: (MonadTimed m, MonadIO m) => m ()
example = do
wait (for 10 sec)
invoke (after 3 sec) $ timestamp "This would happen at 13 sec"
invoke (after 3 sec) $ timestamp "This would happen at 16 sec"
invoke (at 20 sec) $ timestamp "This would happen at 20 sec"
timestamp "This also happens at 20 sec"
timestamp :: (MonadTimed m, MonadIO m) => String -> m () Source #
Prints current virtual time. For debug purposes.
>>>runTimedT $ wait (for 1 mcs) >> timestamp "Look current time here"[1µs] Look current time here
fork_ :: MonadTimed m => m () -> m () Source #
Similar to fork, but doesn't return a result.
work :: MonadTimed m => RelativeToNow -> m () -> m () Source #
Creates a thread, which works for specified amount of time, and then gets
killThreaded.
Use for to specify relative virtual time (counting from now),
and till for absolute one.
killThread :: MonadTimed m => ThreadId m -> m () Source #
Arises ThreadKilled exception in specified thread
startTimer :: MonadTimed m => m (m Microsecond) Source #
Counts time since outer monad layer was unwrapped.
example :: (MonadTimed m, MonadIO m) => m ()
example = do
wait (for 10 sec)
timer <- startTimer
wait (for 5 ms)
passedTime <- timer
liftIO . print $ passedTime
>>>runTimedT example5000µs
Time measures
hour :: Int -> Microsecond Source #
Converts a specified time to Microsecond.
minute :: Int -> Microsecond Source #
Converts a specified time to Microsecond.
sec :: Int -> Microsecond Source #
Converts a specified time to Microsecond.
ms :: Int -> Microsecond Source #
Converts a specified time to Microsecond.
mcs :: Int -> Microsecond Source #
Converts a specified time to Microsecond.
hour' :: Double -> Microsecond Source #
Converts a specified fractional time to Microsecond.
minute' :: Double -> Microsecond Source #
Converts a specified fractional time to Microsecond.
sec' :: Double -> Microsecond Source #
Converts a specified fractional time to Microsecond.
ms' :: Double -> Microsecond Source #
Converts a specified fractional time to Microsecond.
mcs' :: Double -> Microsecond Source #
Converts a specified fractional time to Microsecond.
Time specifiers
Following functions are used together with time-controlling functions
(wait, invoke and others) and serve for two reasons:
- Defines, whether time is counted from origin point or current time point.
- Allow different ways to specify time (see Time accumulators)
for :: TimeAccR t => t Source #
Defines RelativeToNow, which refers to time point in specified time after
current time point.
Supposed to be used with wait and work.
till :: TimeAccR t => t Source #
Defines RelativeToNow, which refers to time point determined by specified
virtual time.
Supposed to be used with wait and work.
now :: RelativeToNow Source #
Refers to current time point.
>>>runTimedT $ invoke now $ timestamp ""[0µs]
interval :: TimeAccM t => t Source #
Returns a time in microseconds.
>>>print $ interval 1 sec1000000µs
timepoint :: TimeAccM t => t Source #
Synonym to interval. May be more preferable in some situations.
Time types
Re-export of Data.Time.Units.Microsecond
data Microsecond :: * #
Instances
| Enum Microsecond | |
| Eq Microsecond | |
| Integral Microsecond | |
| Data Microsecond | |
| Num Microsecond | |
| Ord Microsecond | |
| Read Microsecond | |
| Real Microsecond | |
| Show Microsecond | |
| Ix Microsecond | |
| TimeUnit Microsecond | |
| TimeAccM Microsecond Source # | |
| TimeAccR RelativeToNow Source # | |
| ((~) * a b, TimeAccM t) => TimeAccM (a -> (b -> Microsecond) -> t) Source # | |
| TimeUnit t => TimeAccR (t -> RelativeToNow) Source # | |
| ((~) * a b, TimeAccR t) => TimeAccR (a -> (b -> Microsecond) -> t) Source # | |
Re-export of Data.Time.Units.Millisecond
data Millisecond :: * #
Re-export of Data.Time.Units.Second
Re-export of Data.Time.Units.Minute
Time accumulators
Time accumulators allow to specify time in pretty complicated ways.
- Some of them can accept
TimeUnit, which fully defines result.
for (5 :: Minute)
- They can accept several numbers with time measures, which would be sumarized.
for 1 minute 15 sec 10 mcs for 1.2 minute'
Time accumulator, which evaluates to RelativeToNow.
It's implementation is intentionally not visible from this module.
Minimal complete definition
till', for'
Instances
| TimeAccR RelativeToNow Source # | |
| TimeUnit t => TimeAccR (t -> RelativeToNow) Source # | |
| ((~) * a b, TimeAccR t) => TimeAccR (a -> (b -> Microsecond) -> t) Source # | |
Time accumulator, which evaluates to Microsecond.
It's implementation is intentionally not visible from this module.
Minimal complete definition
interval'
Instances
| TimeAccM Microsecond Source # | |
| ((~) * a b, TimeAccM t) => TimeAccM (a -> (b -> Microsecond) -> t) Source # | |
Exceptions
data MonadTimedError Source #
Is arisen on call of timeout if action wasn't executed in time.
Constructors
| MTTimeoutError Text |