Copyright | (c) Sergey Vinokurov 2018 |
---|---|
License | Apache-2.0 (see LICENSE) |
Maintainer | serg.foo@gmail.com |
Safe Haskell | Safe-Inferred |
Language | GHC2021 |
Wrappers around some Emacs functions, independent of concrete monad.
Synopsis
- funcallPrimitiveSym :: (WithCallStack, MonadEmacs m v, Foldable f) => SymbolName -> f (v s) -> m s (v s)
- funcallPrimitiveUncheckedSym :: (WithCallStack, MonadEmacs m v, Foldable f) => SymbolName -> f (v s) -> m s (v s)
- funcallPrimitiveSym_ :: (WithCallStack, MonadEmacs m v, Foldable f) => SymbolName -> f (v s) -> m s ()
- bindFunction :: (WithCallStack, MonadEmacs m v) => SymbolName -> v s -> m s ()
- provide :: (WithCallStack, MonadEmacs m v) => SymbolName -> m s ()
- makeUserPtrFromStablePtr :: (WithCallStack, MonadEmacs m v) => StablePtr a -> m s (v s)
- extractStablePtrFromUserPtr :: (WithCallStack, MonadEmacs m v) => v s -> m s (StablePtr a)
- extractInt :: (WithCallStack, MonadEmacs m v) => v s -> m s Int
- extractOsPath :: (WithCallStack, MonadEmacs m v) => v s -> m s OsPath
- makeInt :: (WithCallStack, MonadEmacs m v) => Int -> m s (v s)
- makeText :: (WithCallStack, MonadEmacs m v) => Text -> m s (v s)
- makeShortByteString :: (WithCallStack, MonadEmacs m v) => ShortByteString -> m s (v s)
- extractBool :: (WithCallStack, MonadEmacs m v) => v s -> m s Bool
- makeBool :: (WithCallStack, MonadEmacs m v) => Bool -> m s (v s)
- extractVectorWith :: (WithCallStack, MonadEmacs m v, Vector w a) => (v s -> m s a) -> v s -> m s (w a)
- extractVectorMutableWith :: (WithCallStack, MonadEmacs m v, MVector w a) => (v s -> m s a) -> v s -> m s (w (PrimState (m s)) a)
- extractVectorAsPrimArrayWith :: (WithCallStack, MonadEmacs m v, Prim a) => (v s -> m s a) -> v s -> m s (PrimArray a)
- makeVector :: (WithCallStack, MonadEmacs m v, Foldable f) => f (v s) -> m s (v s)
- vconcat2 :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s (v s)
- cons :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s (v s)
- car :: (WithCallStack, MonadEmacs m v) => v s -> m s (v s)
- cdr :: (WithCallStack, MonadEmacs m v) => v s -> m s (v s)
- nil :: (WithCallStack, MonadEmacs m v) => m s (v s)
- setcar :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s ()
- setcdr :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s ()
- makeList :: (WithCallStack, MonadEmacs m v, Foldable f) => f (v s) -> m s (v s)
- extractList :: (WithCallStack, MonadEmacs m v) => v s -> m s [v s]
- extractListWith :: (WithCallStack, MonadEmacs m v) => (v s -> m s a) -> v s -> m s [a]
- foldlEmacsListWith :: (WithCallStack, MonadEmacs m v) => (a -> v s -> m s a) -> a -> v s -> m s a
- unfoldEmacsListWith :: (WithCallStack, MonadEmacs m v) => (a -> m s (Maybe (v s, a))) -> a -> m s (v s)
- addFaceProp :: (WithCallStack, MonadEmacs m v) => v s -> SymbolName -> m s (v s)
- propertize :: (WithCallStack, MonadEmacs m v) => v s -> [(SymbolName, v s)] -> m s (v s)
- concat2 :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s (v s)
- valueToText :: (WithCallStack, MonadEmacs m v) => v s -> m s Text
- symbolName :: (WithCallStack, MonadEmacs m v) => v s -> m s (v s)
- class MonadCatch m => MonadMask (m :: Type -> Type)
Documentation
funcallPrimitiveSym :: (WithCallStack, MonadEmacs m v, Foldable f) => SymbolName -> f (v s) -> m s (v s) Source #
Call a function by its name, similar to funcallPrimitive
.
funcallPrimitiveUncheckedSym :: (WithCallStack, MonadEmacs m v, Foldable f) => SymbolName -> f (v s) -> m s (v s) Source #
Call a function by its name, similar to funcallPrimitiveUnchecked
.
funcallPrimitiveSym_ :: (WithCallStack, MonadEmacs m v, Foldable f) => SymbolName -> f (v s) -> m s () Source #
Call a function by its name and ignore its result, similar to funcallPrimitiveSym
.
:: (WithCallStack, MonadEmacs m v) | |
=> SymbolName | Name |
-> v s | Function value |
-> m s () |
Assign a name to function value.
:: (WithCallStack, MonadEmacs m v) | |
=> SymbolName | Feature to provide |
-> m s () |
Signal to Emacs that certain feature is being provided. Returns provided symbol.
makeUserPtrFromStablePtr :: (WithCallStack, MonadEmacs m v) => StablePtr a -> m s (v s) Source #
Pack a stable pointer as Emacs user_ptr
.
extractStablePtrFromUserPtr :: (WithCallStack, MonadEmacs m v) => v s -> m s (StablePtr a) Source #
Haskell-Emacs datatype conversions
extractInt :: (WithCallStack, MonadEmacs m v) => v s -> m s Int Source #
extractOsPath :: (WithCallStack, MonadEmacs m v) => v s -> m s OsPath Source #
makeInt :: (WithCallStack, MonadEmacs m v) => Int -> m s (v s) Source #
Pack an Int
integer for Emacs.
makeText :: (WithCallStack, MonadEmacs m v) => Text -> m s (v s) Source #
Convert a Text into an Emacs string value.
makeShortByteString :: (WithCallStack, MonadEmacs m v) => ShortByteString -> m s (v s) Source #
Convert a ShortByteString into an Emacs string value.
extractBool :: (WithCallStack, MonadEmacs m v) => v s -> m s Bool Source #
Extract a boolean from an Emacs value.
makeBool :: (WithCallStack, MonadEmacs m v) => Bool -> m s (v s) Source #
Convert a Bool into an Emacs string value.
Vectors
extractVectorWith :: (WithCallStack, MonadEmacs m v, Vector w a) => (v s -> m s a) -> v s -> m s (w a) Source #
Get all elements form an Emacs vector.
extractVectorMutableWith :: (WithCallStack, MonadEmacs m v, MVector w a) => (v s -> m s a) -> v s -> m s (w (PrimState (m s)) a) Source #
Get all elements form an Emacs vector.
extractVectorAsPrimArrayWith :: (WithCallStack, MonadEmacs m v, Prim a) => (v s -> m s a) -> v s -> m s (PrimArray a) Source #
Get all elements form an Emacs vector.
makeVector :: (WithCallStack, MonadEmacs m v, Foldable f) => f (v s) -> m s (v s) Source #
Create an Emacs vector.
vconcat2 :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s (v s) Source #
Concatenate two vectors.
Lists
:: (WithCallStack, MonadEmacs m v) | |
=> v s | car |
-> v s | cdr |
-> m s (v s) |
Make a cons pair out of two values.
car :: (WithCallStack, MonadEmacs m v) => v s -> m s (v s) Source #
Take first element of a pair.
cdr :: (WithCallStack, MonadEmacs m v) => v s -> m s (v s) Source #
Take second element of a pair.
nil :: (WithCallStack, MonadEmacs m v) => m s (v s) Source #
A nil
symbol aka empty list.
:: (WithCallStack, MonadEmacs m v) | |
=> v s | Cons pair |
-> v s | New value |
-> m s () |
Mutate first element of a cons pair.
:: (WithCallStack, MonadEmacs m v) | |
=> v s | Cons pair |
-> v s | New value |
-> m s () |
Mutate second element of a cons pair.
makeList :: (WithCallStack, MonadEmacs m v, Foldable f) => f (v s) -> m s (v s) Source #
Construct vanilla Emacs list from a Haskell list.
extractList :: (WithCallStack, MonadEmacs m v) => v s -> m s [v s] Source #
Extract vanilla Emacs list as Haskell list.
extractListWith :: (WithCallStack, MonadEmacs m v) => (v s -> m s a) -> v s -> m s [a] Source #
Extract vanilla Emacs list as a Haskell list.
foldlEmacsListWith :: (WithCallStack, MonadEmacs m v) => (a -> v s -> m s a) -> a -> v s -> m s a Source #
Fold Emacs list starting from the left.
unfoldEmacsListWith :: (WithCallStack, MonadEmacs m v) => (a -> m s (Maybe (v s, a))) -> a -> m s (v s) Source #
Fold Emacs list starting from the left.
Strings
:: (WithCallStack, MonadEmacs m v) | |
=> v s | String to add face to |
-> SymbolName | Face name |
-> m s (v s) | Propertised string |
Add new 'face property to a string.
:: (WithCallStack, MonadEmacs m v) | |
=> v s | String to add properties to |
-> [(SymbolName, v s)] | Properties |
-> m s (v s) | Propertised string |
Add new 'face property to a string.
concat2 :: (WithCallStack, MonadEmacs m v) => v s -> v s -> m s (v s) Source #
Concatenate two strings.
valueToText :: (WithCallStack, MonadEmacs m v) => v s -> m s Text Source #
Convert an Emacs value into a string using prin1-to-string
.
symbolName :: (WithCallStack, MonadEmacs m v) => v s -> m s (v s) Source #
Wrapper around Emacs symbol-name
function - take a symbol
and produce an Emacs string with its textual name.
Reexports
class MonadCatch m => MonadMask (m :: Type -> Type) #
A class for monads which provide for the ability to account for all possible exit points from a computation, and to mask asynchronous exceptions. Continuation-based monads are invalid instances of this class.
Instances should ensure that, in the following code:
fg = f `finally` g
The action g
is called regardless of what occurs within f
, including
async exceptions. Some monads allow f
to abort the computation via other
effects than throwing an exception. For simplicity, we will consider aborting
and throwing an exception to be two forms of "throwing an error".
If f
and g
both throw an error, the error thrown by fg
depends on which
errors we're talking about. In a monad transformer stack, the deeper layers
override the effects of the inner layers; for example, ExceptT e1 (Except
e2) a
represents a value of type Either e2 (Either e1 a)
, so throwing both
an e1
and an e2
will result in Left e2
. If f
and g
both throw an
error from the same layer, instances should ensure that the error from g
wins.
Effects other than throwing an error are also overridden by the deeper layers.
For example, StateT s Maybe a
represents a value of type s -> Maybe (a,
s)
, so if an error thrown from f
causes this function to return Nothing
,
any changes to the state which f
also performed will be erased. As a
result, g
will see the state as it was before f
. Once g
completes,
f
's error will be rethrown, so g
' state changes will be erased as well.
This is the normal interaction between effects in a monad transformer stack.
By contrast, lifted-base's
version of finally
always discards all of g
's non-IO effects, and g
never sees any of f
's non-IO effects, regardless of the layer ordering and
regardless of whether f
throws an error. This is not the result of
interacting effects, but a consequence of MonadBaseControl
's approach.
Instances
MonadMask IO | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. IO a -> IO a) -> IO b) -> IO b # uninterruptibleMask :: HasCallStack => ((forall a. IO a -> IO a) -> IO b) -> IO b # generalBracket :: HasCallStack => IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c) # | |
e ~ SomeException => MonadMask (Either e) | Since: exceptions-0.8.3 |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. Either e a -> Either e a) -> Either e b) -> Either e b # uninterruptibleMask :: HasCallStack => ((forall a. Either e a -> Either e a) -> Either e b) -> Either e b # generalBracket :: HasCallStack => Either e a -> (a -> ExitCase b -> Either e c) -> (a -> Either e b) -> Either e (b, c) # | |
MonadMask m => MonadMask (MaybeT m) | Since: exceptions-0.10.0 |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b # uninterruptibleMask :: HasCallStack => ((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b # generalBracket :: HasCallStack => MaybeT m a -> (a -> ExitCase b -> MaybeT m c) -> (a -> MaybeT m b) -> MaybeT m (b, c) # | |
MonadMask (EmacsM s) Source # | |
Defined in Emacs.Module.Monad mask :: HasCallStack => ((forall a. EmacsM s a -> EmacsM s a) -> EmacsM s b) -> EmacsM s b # uninterruptibleMask :: HasCallStack => ((forall a. EmacsM s a -> EmacsM s a) -> EmacsM s b) -> EmacsM s b # generalBracket :: HasCallStack => EmacsM s a -> (a -> ExitCase b -> EmacsM s c) -> (a -> EmacsM s b) -> EmacsM s (b, c) # | |
MonadMask m => MonadMask (ExceptT e m) | Since: exceptions-0.9.0 |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b # uninterruptibleMask :: HasCallStack => ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b # generalBracket :: HasCallStack => ExceptT e m a -> (a -> ExitCase b -> ExceptT e m c) -> (a -> ExceptT e m b) -> ExceptT e m (b, c) # | |
MonadMask m => MonadMask (IdentityT m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b) -> IdentityT m b # uninterruptibleMask :: HasCallStack => ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b) -> IdentityT m b # generalBracket :: HasCallStack => IdentityT m a -> (a -> ExitCase b -> IdentityT m c) -> (a -> IdentityT m b) -> IdentityT m (b, c) # | |
MonadMask m => MonadMask (ReaderT r m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b) -> ReaderT r m b # uninterruptibleMask :: HasCallStack => ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b) -> ReaderT r m b # generalBracket :: HasCallStack => ReaderT r m a -> (a -> ExitCase b -> ReaderT r m c) -> (a -> ReaderT r m b) -> ReaderT r m (b, c) # | |
MonadMask m => MonadMask (StateT s m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # uninterruptibleMask :: HasCallStack => ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # generalBracket :: HasCallStack => StateT s m a -> (a -> ExitCase b -> StateT s m c) -> (a -> StateT s m b) -> StateT s m (b, c) # | |
MonadMask m => MonadMask (StateT s m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # uninterruptibleMask :: HasCallStack => ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # generalBracket :: HasCallStack => StateT s m a -> (a -> ExitCase b -> StateT s m c) -> (a -> StateT s m b) -> StateT s m (b, c) # | |
(MonadMask m, Monoid w) => MonadMask (WriterT w m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # uninterruptibleMask :: HasCallStack => ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # generalBracket :: HasCallStack => WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) # | |
(MonadMask m, Monoid w) => MonadMask (WriterT w m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # uninterruptibleMask :: HasCallStack => ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # generalBracket :: HasCallStack => WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) # | |
(MonadMask m, Monoid w) => MonadMask (RWST r w s m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # uninterruptibleMask :: HasCallStack => ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # generalBracket :: HasCallStack => RWST r w s m a -> (a -> ExitCase b -> RWST r w s m c) -> (a -> RWST r w s m b) -> RWST r w s m (b, c) # | |
(MonadMask m, Monoid w) => MonadMask (RWST r w s m) | |
Defined in Control.Monad.Catch mask :: HasCallStack => ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # uninterruptibleMask :: HasCallStack => ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # generalBracket :: HasCallStack => RWST r w s m a -> (a -> ExitCase b -> RWST r w s m c) -> (a -> RWST r w s m b) -> RWST r w s m (b, c) # |