Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Statically dispatched effects.
Synopsis
- data family StaticRep (e :: Effect) :: Type
- data SideEffects
- type family MaybeIOE (sideEffects :: SideEffects) (es :: [Effect]) :: Constraint where ...
- runStaticRep :: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) => StaticRep e -> Eff (e : es) a -> Eff es (a, StaticRep e)
- evalStaticRep :: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) => StaticRep e -> Eff (e : es) a -> Eff es a
- execStaticRep :: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) => StaticRep e -> Eff (e : es) a -> Eff es (StaticRep e)
- getStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => Eff es (StaticRep e)
- putStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => StaticRep e -> Eff es ()
- stateStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => (StaticRep e -> (a, StaticRep e)) -> Eff es a
- stateStaticRepM :: (DispatchOf e ~ Static sideEffects, e :> es) => (StaticRep e -> Eff es (a, StaticRep e)) -> Eff es a
- localStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => (StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
- seqUnliftIO :: HasCallStack => Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
- concUnliftIO :: HasCallStack => Env es -> Persistence -> Limit -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
- unsafeSeqUnliftIO :: HasCallStack => ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
- unsafeConcUnliftIO :: HasCallStack => Persistence -> Limit -> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
- unEff :: Eff es a -> Env es -> IO a
- unsafeEff :: (Env es -> IO a) -> Eff es a
- unsafeEff_ :: IO a -> Eff es a
- unsafeLiftMapIO :: HasCallStack => (IO a -> IO b) -> Eff es a -> Eff es b
- type HasCallStack = ?callStack :: CallStack
Introduction
Unlike dynamically dispatched effects, statically dispatched effects have a single, set interpretation that cannot be changed at runtime, which makes them useful in specific scenarios. For example:
- If you'd like to ensure that a specific effect will behave in a certain way at all times, using a statically dispatched version is the only way to ensure that.
- If the effect you're about to define has only one reasonable implementation, it makes a lot of sense to make it statically dispatched.
When in doubt, use dynamic dispatch as it's more flexible.
An example
Let's say that there exists a logging library whose functionality we'd like
to turn into an effect. Its Logger
data type (after simplification) is
represented in the following way:
>>>
data Logger = Logger { logMessage :: String -> IO () }
Because the Logger
type itself allows customization of how messages are
logged, it is an excellent candidate to be turned into a statically
dispatched effect.
Such effect is represented by an empty data type of kind Effect
:
>>>
data Log :: Effect
When it comes to the dispatch, we also need to signify whether core operations of the effect will perform side effects. Since GHC is not a polygraph, you can lie, though being truthful is recommended 🙂
>>>
type instance DispatchOf Log = Static WithSideEffects
The environment of Eff
will hold the data type that represents the
effect. It is defined by the appropriate instance of the StaticRep
data
family:
>>>
newtype instance StaticRep Log = Log Logger
Note: all operations of a statically dispatched effect will have a read/write access to this data type as long as they can see its constructors, hence it's best not to export them from the module that defines the effect.
The logging operation can be defined as follows:
>>>
:{
log :: (IOE :> es, Log :> es) => String -> Eff es () log msg = do Log logger <- getStaticRep liftIO $ logMessage logger msg :}
That works, but has an unfortunate consequence: in order to use the log
operation the IOE
effect needs to be in scope! This is bad, because we're
trying to limit (ideally, fully eliminate) the need to have the full power of
IO
available in the application code. The solution is to use one of the
escape hatches that allow unrestricted access to the internal representation
of Eff
:
>>>
:{
log :: Log :> es => String -> Eff es () log msg = do Log logger <- getStaticRep unsafeEff_ $ logMessage logger msg :}
However, since logging is most often an operation with side effects, in order
for this approach to be sound, the function that introduces the Log
effect
needs to require the IOE
effect.
If you forget to do that, don't worry. As long as the DispatchOf
instance
was correctly defined to be
, you will get a
reminder:Static
WithSideEffects
>>>
:{
runLog :: Logger -> Eff (Log : es) a -> Eff es a runLog logger = evalStaticRep (Log logger) :} ... ...No instance for ...IOE :> es... arising from a use of ‘evalStaticRep’ ...
Including
in the context fixes the problem:IOE
:> es
>>>
:{
runLog :: IOE :> es => Logger -> Eff (Log : es) a -> Eff es a runLog logger = evalStaticRep (Log logger) :}
In general, whenever any operation of a statically dispatched effect performs
side effects using one of the unsafe functions, all functions that introduce
this effect need to require the IOE
effect (otherwise it would be possible
to run it via runPureEff
).
Now we can use the newly defined effect to log messages:
>>>
dummyLogger = Logger { logMessage = \_ -> pure () }
>>>
stdoutLogger = Logger { logMessage = putStrLn }
>>>
:{
action = do log "Computing things..." log "Sleeping..." log "Computing more things..." pure True :}
>>>
:t action
action :: (Log :> es) => Eff es Bool
>>>
runEff . runLog stdoutLogger $ action
Computing things... Sleeping... Computing more things... True
>>>
runEff . runLog dummyLogger $ action
True
Low level API
data family StaticRep (e :: Effect) :: Type Source #
Internal representations of statically dispatched effects.
Instances
data SideEffects Source #
Signifies whether core operations of a statically dispatched effect perform
side effects. If an effect is marked as such, the
runStaticRep
family of functions will require the
IOE
effect to be in context via the
MaybeIOE
type family.
type family MaybeIOE (sideEffects :: SideEffects) (es :: [Effect]) :: Constraint where ... Source #
Require the IOE
effect for running statically dispatched effects whose
operations perform side effects.
MaybeIOE NoSideEffects _ = () | |
MaybeIOE WithSideEffects es = IOE :> es |
Extending the environment
:: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) | |
=> StaticRep e | The initial representation. |
-> Eff (e : es) a | |
-> Eff es (a, StaticRep e) |
Run a statically dispatched effect with the given initial representation and return the final value along with the final representation.
:: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) | |
=> StaticRep e | The initial representation. |
-> Eff (e : es) a | |
-> Eff es a |
Run a statically dispatched effect with the given initial representation and return the final value, discarding the final representation.
:: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) | |
=> StaticRep e | The initial representation. |
-> Eff (e : es) a | |
-> Eff es (StaticRep e) |
Run a statically dispatched effect with the given initial representation and return the final representation, discarding the final value.
Data retrieval and update
getStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => Eff es (StaticRep e) Source #
Fetch the current representation of the effect.
putStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => StaticRep e -> Eff es () Source #
Set the current representation of the effect to the given value.
:: (DispatchOf e ~ Static sideEffects, e :> es) | |
=> (StaticRep e -> (a, StaticRep e)) | The function to modify the representation. |
-> Eff es a |
Apply the function to the current representation of the effect and return a value.
:: (DispatchOf e ~ Static sideEffects, e :> es) | |
=> (StaticRep e -> Eff es (a, StaticRep e)) | The function to modify the representation. |
-> Eff es a |
Apply the monadic function to the current representation of the effect and return a value.
:: (DispatchOf e ~ Static sideEffects, e :> es) | |
=> (StaticRep e -> StaticRep e) | The function to temporarily modify the representation. |
-> Eff es a | |
-> Eff es a |
Execute a computation with a temporarily modified representation of the effect.
Unlifts
:: HasCallStack | |
=> Env es | The environment. |
-> ((forall r. Eff es r -> IO r) -> IO a) | Continuation with the unlifting function in scope. |
-> IO a |
Create an unlifting function with the SeqUnlift
strategy.
:: HasCallStack | |
=> Env es | The environment. |
-> Persistence | |
-> Limit | |
-> ((forall r. Eff es r -> IO r) -> IO a) | Continuation with the unlifting function in scope. |
-> IO a |
Create an unlifting function with the ConcUnlift
strategy.
:: HasCallStack | |
=> ((forall r. Eff es r -> IO r) -> IO a) | Continuation with the unlifting function in scope. |
-> Eff es a |
:: HasCallStack | |
=> Persistence | |
-> Limit | |
-> ((forall r. Eff es r -> IO r) -> IO a) | Continuation with the unlifting function in scope. |
-> Eff es a |
Create an unlifting function with the ConcUnlift
strategy.
This function is unsafe because it can be used to introduce arbitrary
IO
actions into pure Eff
computations.
Utils
unsafeEff_ :: IO a -> Eff es a Source #
unsafeLiftMapIO :: HasCallStack => (IO a -> IO b) -> Eff es a -> Eff es b Source #
Utility for lifting IO
computations of type
IO
a ->IO
b
to
Eff
es a ->Eff
es b
Note: the computation must not run its argument in a separate thread, attempting to do so will result in a runtime error.
This function is unsafe because it can be used to introduce arbitrary
IO
actions into pure Eff
computations.
Re-exports
type HasCallStack = ?callStack :: CallStack #
Request a CallStack.
NOTE: The implicit parameter ?callStack :: CallStack
is an
implementation detail and should not be considered part of the
CallStack
API, we may decide to change the implementation in the
future.
Since: base-4.9.0.0