Edit documentation
This commit is contained in:
parent
aad4fe2651
commit
2130ff6165
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,5 +1,6 @@
|
||||
output/
|
||||
bower_components/
|
||||
generated-docs/
|
||||
.psci*
|
||||
.spago
|
||||
.spago2nix
|
||||
|
@ -95,6 +95,11 @@ instance MonadBase b m => MonadBase b (ContT r m) where
|
||||
instance (Monoid w, MonadBase b m) => MonadBase b (RWST r w s m) where
|
||||
liftBase = liftBaseDefault
|
||||
|
||||
-- | A default implementation of `liftBase` which is defined as
|
||||
-- |
|
||||
-- | ```purescript
|
||||
-- | lift <<< liftBase
|
||||
-- | ```
|
||||
liftBaseDefault
|
||||
:: forall t m b. MonadTrans t => Monad m => MonadBase b m => b ~> t m
|
||||
liftBaseDefault = lift <<< liftBase
|
||||
|
@ -14,16 +14,16 @@ import Data.Maybe (Maybe)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
|
||||
-- | Monads which allow their actions to be run in their base monad.
|
||||
-- | Monads which allow their actions to be run in a base monad.
|
||||
-- |
|
||||
-- | `MonadUnlift` captures the opposite notion of `MonadBase` - while
|
||||
-- | `MonadBase` allows an base monad `b` to be lifted into another monad `m`,
|
||||
-- | `MonadUnlift` allows a `m` to be run in `b`, as long as contained in an
|
||||
-- | outer `m` context.
|
||||
-- | `MonadBase` allows any base monad `b` to be lifted into a transformed monad
|
||||
-- | `m`, `MonadUnlift` allows `m` to be run in `b`, as long as the outer
|
||||
-- | context is in `m`.
|
||||
-- |
|
||||
-- | Note that the laws given below require that a monad have no "monadic
|
||||
-- | state", which essentially limits instances to `ReaderT` and `IdentityT`
|
||||
-- | stacks with a base of `b`.
|
||||
-- | stacks.
|
||||
-- |
|
||||
-- | Instances should satisfy the following laws, which state that
|
||||
-- | `unlift` is a transformer of monads for any given `u` returned by
|
||||
@ -78,17 +78,32 @@ instance MonadUnlift b m => MonadUnlift b (IdentityT m) where
|
||||
runAction \(IdentityT a) ->
|
||||
runMInBase a
|
||||
|
||||
-- | A newtype wrapper around a natural transformation from `m` to `b`.
|
||||
newtype Unlift :: forall k. (k -> Type) -> (k -> Type) -> Type
|
||||
newtype Unlift b m = Unlift (m ~> b)
|
||||
|
||||
-- | Run an action directly in a base monad `b`. Use `askUnlift` or `withUnlift`
|
||||
-- | to obtain an `Unlift b m` value.
|
||||
unlift :: forall b m. Unlift b m -> m ~> b
|
||||
unlift (Unlift run) = run
|
||||
|
||||
-- | Returns a natural transformation from `m` to `b` within an `m` context.
|
||||
-- | This can subsequently be used to run `m` actions in the base monad `b`.
|
||||
askUnlift :: forall b m. MonadUnlift b m => m (Unlift b m)
|
||||
askUnlift = withRunInBase \run -> pure $ Unlift run
|
||||
|
||||
-- | A monomorphic version of askUnlift which can be more convenient when you
|
||||
-- | only want to use the resulting runner function once with a concrete type.
|
||||
-- |
|
||||
-- | If you run into type issues using this, try using `askUnlit` instead.
|
||||
askRunInBase :: forall b m a. MonadUnlift b m => m (m a -> b a)
|
||||
askRunInBase = withRunInBase pure
|
||||
|
||||
-- | A version of `withRunInBase` that provides an `Unlift` wrapper instead of
|
||||
-- | a rank-2 polymorphic function.
|
||||
withUnlift :: forall b m a. MonadUnlift b m => (Unlift b m -> b a) -> m a
|
||||
withUnlift runAction = withRunInBase \run -> runAction $ Unlift run
|
||||
|
||||
-- | Run the given action inside the base monad `b`.
|
||||
toBase :: forall b m a. MonadUnlift b m => m a -> m (b a)
|
||||
toBase m = withRunInBase \run -> pure $ run m
|
||||
|
@ -39,18 +39,34 @@ instance MonadUnliftAff m => MonadUnliftAff (ReaderT r m) where
|
||||
runAction \(ReaderT reader) ->
|
||||
runMInAff $ reader context
|
||||
|
||||
-- | A newtype wrapper around a natural transformation from `m` to `Aff`.
|
||||
newtype UnliftAff m = UnliftAff (m ~> Aff)
|
||||
|
||||
-- | Run an action directly in `Aff`. Use `askUnliftAff` or
|
||||
-- | `withUnliftAff` to obtain an `UnliftAff m` value.
|
||||
unliftAff :: forall m. UnliftAff m -> m ~> Aff
|
||||
unliftAff (UnliftAff run) = run
|
||||
|
||||
-- | Returns a natural transformation from `m` to `Aff` within an `m` context.
|
||||
-- | This can subsequently be used to run `m` actions directly in `Aff`.
|
||||
askUnliftAff :: forall m. MonadUnliftAff m => m (UnliftAff m)
|
||||
askUnliftAff = withRunInAff \run -> pure $ UnliftAff run
|
||||
|
||||
-- | A monomorphic version of askUnliftAff which can be more convenient when
|
||||
-- | you only want to use the resulting runner function once with a concrete
|
||||
-- | type.
|
||||
-- |
|
||||
-- | If you run into type issues using this, try using `askUnlitAff` instead.
|
||||
askRunInAff :: forall m a. MonadUnliftAff m => m (m a -> Aff a)
|
||||
askRunInAff = withRunInAff pure
|
||||
|
||||
-- | A version of `withRunInAff` that provides an `UnliftAff` wrapper
|
||||
-- | instead of a rank-2 polymorphic function.
|
||||
withUnliftAff
|
||||
:: forall m a. MonadUnliftAff m => (UnliftAff m -> Aff a) -> m a
|
||||
withUnliftAff runAction =
|
||||
withRunInAff \run -> runAction $ UnliftAff run
|
||||
|
||||
-- | Run the given action inside the `Aff` monad.
|
||||
toAff :: forall m a. MonadUnliftAff m => m a -> m (Aff a)
|
||||
toAff m = withRunInAff \run -> pure $ run m
|
||||
|
@ -46,18 +46,34 @@ instance MonadUnliftEffect m => MonadUnliftEffect (IdentityT m) where
|
||||
runAction \(IdentityT a) ->
|
||||
runMInEffect a
|
||||
|
||||
-- | A newtype wrapper around a natural transformation from `m` to `Effect`.
|
||||
newtype UnliftEffect m = UnliftEffect (m ~> Effect)
|
||||
|
||||
-- | Run an action directly in `Effect`. Use `askUnliftEffect` or
|
||||
-- | `withUnliftEffect` to obtain an `UnliftEffect m` value.
|
||||
unliftEffect :: forall m. UnliftEffect m -> m ~> Effect
|
||||
unliftEffect (UnliftEffect run) = run
|
||||
|
||||
-- | Returns a natural transformation from `m` to `Effect` within an `m` context.
|
||||
-- | This can subsequently be used to run `m` actions directly in `Effect`.
|
||||
askUnliftEffect :: forall m. MonadUnliftEffect m => m (UnliftEffect m)
|
||||
askUnliftEffect = withRunInEffect \run -> pure $ UnliftEffect run
|
||||
|
||||
-- | A monomorphic version of askUnliftEffect which can be more convenient when
|
||||
-- | you only want to use the resulting runner function once with a concrete
|
||||
-- | type.
|
||||
-- |
|
||||
-- | If you run into type issues using this, try using `askUnlitEffect` instead.
|
||||
askRunInEffect :: forall m a. MonadUnliftEffect m => m (m a -> Effect a)
|
||||
askRunInEffect = withRunInEffect pure
|
||||
|
||||
-- | A version of `withRunInEffect` that provides an `UnliftEffect` wrapper
|
||||
-- | instead of a rank-2 polymorphic function.
|
||||
withUnliftEffect
|
||||
:: forall m a. MonadUnliftEffect m => (UnliftEffect m -> Effect a) -> m a
|
||||
withUnliftEffect runAction =
|
||||
withRunInEffect \run -> runAction $ UnliftEffect run
|
||||
|
||||
-- | Run the given action inside the `Effect` monad.
|
||||
toEffect :: forall m a. MonadUnliftEffect m => m a -> m (Effect a)
|
||||
toEffect m = withRunInEffect \run -> pure $ run m
|
||||
|
Loading…
Reference in New Issue
Block a user