Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
A Prelude for Polysemy projects, reexporting names and modules from several basic libraries.
Synopsis
- type EventConsumer token e = Scoped (EventResource token) (Consume e)
- runConc :: Sem ConcStack a -> IO a
- type ScopedSync res a = Scoped (SyncResources res) (Sync a)
- data Sync d (a :: Type -> Type) b
- subscribe :: forall e resource (r :: EffectRow). Member (Scoped (EventResource resource) (Consume e)) r => InterpreterFor (Consume e) r
- consume :: forall e (r :: EffectRow). Member (Consume e) r => Sem r e
- publish :: forall e resource (r :: EffectRow). Member (Events resource e) r => e -> Sem r ()
- data Events resource e (a :: Type -> Type) b
- type Mask resource = Scoped (MaskResource resource) RestoreMask
- type UninterruptipleMask resource = Scoped (UninterruptipleMaskResource resource) RestoreMask
- scoped :: forall resource (effect :: Effect) (r :: EffectRow). Member (Scoped resource effect) r => InterpreterFor effect r
- data Scoped resource (effect :: Effect) (a :: Type -> Type) b
- data Race (a :: Type -> Type) b
- data Queue d (a :: Type -> Type) b
- data Interrupt (a :: Type -> Type) b
- data QueueResult d
- data DataLog a (b :: Type -> Type) c
- data Log (a :: Type -> Type) b
- module Polysemy.Resume
- class TimeUnit u
- data Time time date (a :: Type -> Type) b
Documentation
type EventConsumer token e = Scoped (EventResource token) (Consume e) #
Convenience alias for the consumer effect.
runConc :: Sem ConcStack a -> IO a #
Interprets UninterruptipleMask
, Mask
and Race
in terms of
and runs the entire rest of the
stack.Final
IO
type ScopedSync res a = Scoped (SyncResources res) (Sync a) #
Convenience alias.
data Sync d (a :: Type -> Type) b #
Abstracts an MVar
.
For documentation on the constructors, see the module Polysemy.Conc.Effect.Sync.
import Polysemy.Conc (Sync) import qualified Polysemy.Conc.Effect.Sync as Sync prog :: Member (Sync Int) r => Sem r Int prog = do Sync.putTry 5 Sync.takeBlock
subscribe :: forall e resource (r :: EffectRow). Member (Scoped (EventResource resource) (Consume e)) r => InterpreterFor (Consume e) r #
Create a new scope for Events
, causing the nested program to get its own copy of the event stream.
To be used with interpretEventsChan
.
consume :: forall e (r :: EffectRow). Member (Consume e) r => Sem r e #
Consume one event emitted by Events
.
publish :: forall e resource (r :: EffectRow). Member (Events resource e) r => e -> Sem r () #
Publish one event.
data Events resource e (a :: Type -> Type) b #
An event publisher that can be consumed from multiple threads.
type Mask resource = Scoped (MaskResource resource) RestoreMask #
The scoped masking effect.
type UninterruptipleMask resource = Scoped (UninterruptipleMaskResource resource) RestoreMask #
The scoped uninterruptible masking effect.
scoped :: forall resource (effect :: Effect) (r :: EffectRow). Member (Scoped resource effect) r => InterpreterFor effect r #
Constructor for Scoped
, taking a nested program and transforming all instances of effect
to
Scoped resource effect
.
data Scoped resource (effect :: Effect) (a :: Type -> Type) b #
Scoped
transforms a program so that effect
is associated with a resource
within that program.
This requires the interpreter for effect
to be parameterized by resource
and constructed for every program using
Scoped
separately.
An application for this is Events
, in which each program using the effect Consume
is
interpreted with its own copy of the event channel; or a database transaction, in which a transaction handle is
created for the wrapped program and passed to the interpreter for the database effect.
Resource creation is performed by the function passed to runScoped
.
The constructors are not intended to be used directly; the smart constructor scoped
is used like a local
interpreter for effect
.
data Race (a :: Type -> Type) b #
Abstract the concept of running two programs concurrently, aborting the other when one terminates.
Timeout
is a simpler variant, where one thread just sleeps for a given interval.
data Queue d (a :: Type -> Type) b #
Abstracts queues like TBQueue
.
For documentation on the constructors, see the module Polysemy.Conc.Data.Queue.
import Polysemy.Conc (Queue, QueueResult) import Polysemy.Conc.Effect.Queue as Queue prog :: Member (Queue Int) r => Sem r (QueueResult Int) prog = do Queue.write 5 Queue.write 10 Queue.read >>= \case QueueResult.Success i -> fmap (i +) <$> Queue.read r -> pure r
data Interrupt (a :: Type -> Type) b #
The interrupt handler effect allows three kinds of interaction for interrupt signals:
- Execute a callback when a signal is received
- Block a thread until a signal is received
- Kill a thread when a signal is received
For documentation on the constructors, see the module Polysemy.Conc.Effect.Interrupt.
import qualified Polysemy.Conc.Effect.Interrupt as Interrupt prog = do Interrupt.register "task 1" (putStrLn "interrupted") Interrupt.killOnQuit $ forever do doSomeWork
data QueueResult d #
Encodes failure reasons for queues.
For documentation on the constructors, see the module Polysemy.Conc.Data.QueueResult.
import qualified Polysemy.Conc.Data.QueueResult as QueueResult
Instances
data Log (a :: Type -> Type) b #
The default high-level effect for simple text messages. To be used with the severity constructors:
import qualified Polysemy.Log as Log prog = do Log.debug "debugging…" Log.warn "warning!"
Interpreters should preprocess and relay the message to DataLog
.
module Polysemy.Resume
Types that represent an amount of time that can be converted to each other.
The methods are internal, the API function is convert
.
Instances
TimeUnit Days | |
Defined in Polysemy.Time.Data.TimeUnit | |
TimeUnit Hours | |
Defined in Polysemy.Time.Data.TimeUnit | |
TimeUnit MicroSeconds | |
Defined in Polysemy.Time.Data.TimeUnit nanos :: NanoSeconds # toNanos :: MicroSeconds -> NanoSeconds # fromNanos :: NanoSeconds -> MicroSeconds # | |
TimeUnit MilliSeconds | |
Defined in Polysemy.Time.Data.TimeUnit nanos :: NanoSeconds # toNanos :: MilliSeconds -> NanoSeconds # fromNanos :: NanoSeconds -> MilliSeconds # | |
TimeUnit Minutes | |
Defined in Polysemy.Time.Data.TimeUnit | |
TimeUnit NanoSeconds | |
Defined in Polysemy.Time.Data.TimeUnit nanos :: NanoSeconds # toNanos :: NanoSeconds -> NanoSeconds # fromNanos :: NanoSeconds -> NanoSeconds # | |
TimeUnit Seconds | |
Defined in Polysemy.Time.Data.TimeUnit | |
TimeUnit Weeks | |
Defined in Polysemy.Time.Data.TimeUnit | |
TimeUnit DiffTime | |
Defined in Polysemy.Time.Data.TimeUnit | |
TimeUnit NominalDiffTime | |
Defined in Polysemy.Time.Data.TimeUnit nanos :: NanoSeconds # toNanos :: NominalDiffTime -> NanoSeconds # fromNanos :: NanoSeconds -> NominalDiffTime # |