Copyright | (c) Sergey Vinokurov 2018 |
---|---|
License | BSD3-style (see LICENSE) |
Maintainer | serg.foo@gmail.com |
Safe Haskell | None |
Language | Haskell2010 |
Wrappers around some Emacs functions, independent of concrete monad.
Synopsis
- bindFunction :: (WithCallStack, MonadEmacs m, Monad (m s)) => SymbolName -> EmacsRef m s -> m s ()
- makeFunction :: (WithCallStack, EmacsInvocation req opt rest, GetArities req opt rest, MonadEmacs m, Monad (m s)) => (forall s'. EmacsFunction req opt rest s' m) -> ByteString -> m s (EmacsRef m s)
- withCleanup :: (WithCallStack, MonadMask (m s), MonadEmacs m, Monad (m s)) => EmacsRef m s -> (EmacsRef m s -> m s a) -> m s a
- provide :: (WithCallStack, MonadEmacs m, Monad (m s)) => SymbolName -> m s ()
- makeUserPtrFromStablePtr :: (WithCallStack, MonadEmacs m, Monad (m s)) => StablePtr a -> m s (EmacsRef m s)
- extractStablePtrFromUserPtr :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (StablePtr a)
- extractInt :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Int
- makeInt :: (WithCallStack, MonadEmacs m, Monad (m s)) => Int -> m s (EmacsRef m s)
- extractText :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Text
- makeText :: (WithCallStack, MonadEmacs m, Monad (m s)) => Text -> m s (EmacsRef m s)
- extractShortByteString :: (WithCallStack, MonadEmacs m, Functor (m s)) => EmacsRef m s -> m s ShortByteString
- makeShortByteString :: (WithCallStack, MonadEmacs m) => ShortByteString -> m s (EmacsRef m s)
- extractBool :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Bool
- makeBool :: (WithCallStack, MonadEmacs m, Monad (m s)) => Bool -> m s (EmacsRef m s)
- extractVector :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (Vector (EmacsRef m s))
- extractVectorWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s (Vector a)
- extractUnboxedVectorWith :: (WithCallStack, MonadEmacs m, Monad (m s), Unbox a) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s (Vector a)
- makeVector :: (WithCallStack, MonadEmacs m, Monad (m s)) => [EmacsRef m s] -> m s (EmacsRef m s)
- vconcat2 :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s (EmacsRef m s)
- cons :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s (EmacsRef m s)
- car :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (EmacsRef m s)
- cdr :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (EmacsRef m s)
- nil :: (WithCallStack, MonadEmacs m, Monad (m s)) => m s (EmacsRef m s)
- setcar :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s ()
- setcdr :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s ()
- makeList :: (WithCallStack, MonadEmacs m, Monad (m s), Foldable f) => f (EmacsRef m s) -> m s (EmacsRef m s)
- extractList :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s [EmacsRef m s]
- extractListWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s [a]
- extractListRevWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s [a]
- foldlEmacsListWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (a -> EmacsRef m s -> m s a) -> a -> EmacsRef m s -> m s a
- unfoldEmacsListWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (a -> m s (Maybe (EmacsRef m s, a))) -> a -> m s (EmacsRef m s)
- addFaceProp :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> SymbolName -> m s (EmacsRef m s)
- concat2 :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s (EmacsRef m s)
- valueToText :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Text
- symbolName :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (EmacsRef m s)
- class MonadCatch m => MonadMask (m :: * -> *)
Documentation
:: (WithCallStack, MonadEmacs m, Monad (m s)) | |
=> SymbolName | Name |
-> EmacsRef m s | Function value |
-> m s () |
Assign a name to function value.
makeFunction :: (WithCallStack, EmacsInvocation req opt rest, GetArities req opt rest, MonadEmacs m, Monad (m s)) => (forall s'. EmacsFunction req opt rest s' m) -> ByteString -> m s (EmacsRef m s) Source #
Make Haskell function available as an anonymoucs Emacs
function. In order to be able to use it later from Emacs it should
be fed into bindFunction
.
This is a simplified version of makeFunctionExtra
.
withCleanup :: (WithCallStack, MonadMask (m s), MonadEmacs m, Monad (m s)) => EmacsRef m s -> (EmacsRef m s -> m s a) -> m s a Source #
Feed a value into a function and clean it up afterwards.
:: (WithCallStack, MonadEmacs m, Monad (m s)) | |
=> SymbolName | Feature to provide |
-> m s () |
Signal to Emacs that certain feature is being provided. Returns provided symbol.
makeUserPtrFromStablePtr :: (WithCallStack, MonadEmacs m, Monad (m s)) => StablePtr a -> m s (EmacsRef m s) Source #
Pack a stable pointer as Emacs user_ptr
.
extractStablePtrFromUserPtr :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (StablePtr a) Source #
Haskell-Emacs datatype conversions
extractInt :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Int Source #
makeInt :: (WithCallStack, MonadEmacs m, Monad (m s)) => Int -> m s (EmacsRef m s) Source #
Pack an Int
integer for Emacs.
extractText :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Text Source #
Extract string contents as Text
from an Emacs value.
makeText :: (WithCallStack, MonadEmacs m, Monad (m s)) => Text -> m s (EmacsRef m s) Source #
Convert a Text into an Emacs string value.
extractShortByteString :: (WithCallStack, MonadEmacs m, Functor (m s)) => EmacsRef m s -> m s ShortByteString Source #
Extract string contents as ShortByteString
from an Emacs value.
makeShortByteString :: (WithCallStack, MonadEmacs m) => ShortByteString -> m s (EmacsRef m s) Source #
Convert a ShortByteString into an Emacs string value.
extractBool :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Bool Source #
Extract a boolean from an Emacs value.
makeBool :: (WithCallStack, MonadEmacs m, Monad (m s)) => Bool -> m s (EmacsRef m s) Source #
Convert a Bool into an Emacs string value.
Vectors
extractVector :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (Vector (EmacsRef m s)) Source #
Get all elements form an Emacs vector.
extractVectorWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s (Vector a) Source #
Get all elements form an Emacs vector using specific function to convert elements.
extractUnboxedVectorWith :: (WithCallStack, MonadEmacs m, Monad (m s), Unbox a) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s (Vector a) Source #
Get all elements form an Emacs vector using specific function to convert elements.
makeVector :: (WithCallStack, MonadEmacs m, Monad (m s)) => [EmacsRef m s] -> m s (EmacsRef m s) Source #
Create an Emacs vector.
vconcat2 :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s (EmacsRef m s) Source #
Concatenate two vectors.
Lists
:: (WithCallStack, MonadEmacs m, Monad (m s)) | |
=> EmacsRef m s | car |
-> EmacsRef m s | cdr |
-> m s (EmacsRef m s) |
Make a cons pair out of two values.
car :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (EmacsRef m s) Source #
Take first element of a pair.
cdr :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (EmacsRef m s) Source #
Take second element of a pair.
nil :: (WithCallStack, MonadEmacs m, Monad (m s)) => m s (EmacsRef m s) Source #
A nil
symbol aka empty list.
:: (WithCallStack, MonadEmacs m, Monad (m s)) | |
=> EmacsRef m s | Cons pair |
-> EmacsRef m s | New value |
-> m s () |
Mutate first element of a cons pair.
:: (WithCallStack, MonadEmacs m, Monad (m s)) | |
=> EmacsRef m s | Cons pair |
-> EmacsRef m s | New value |
-> m s () |
Mutate second element of a cons pair.
makeList :: (WithCallStack, MonadEmacs m, Monad (m s), Foldable f) => f (EmacsRef m s) -> m s (EmacsRef m s) Source #
Construct vanilla Emacs list from a Haskell list.
extractList :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s [EmacsRef m s] Source #
Extract vanilla Emacs list as Haskell list.
extractListWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s [a] Source #
Extract vanilla Emacs list as a Haskell list.
extractListRevWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (EmacsRef m s -> m s a) -> EmacsRef m s -> m s [a] Source #
Extract vanilla Emacs list as a reversed Haskell list. It's more
efficient than extractList
but doesn't preserve order of elements
that was specified from Emacs side.
foldlEmacsListWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (a -> EmacsRef m s -> m s a) -> a -> EmacsRef m s -> m s a Source #
Fold Emacs list starting from the left.
unfoldEmacsListWith :: (WithCallStack, MonadEmacs m, Monad (m s)) => (a -> m s (Maybe (EmacsRef m s, a))) -> a -> m s (EmacsRef m s) Source #
Fold Emacs list starting from the left.
Strings
:: (WithCallStack, MonadEmacs m, Monad (m s)) | |
=> EmacsRef m s | String to add face to |
-> SymbolName | Face name |
-> m s (EmacsRef m s) | Propertised string |
Add new 'face property to a string.
concat2 :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> EmacsRef m s -> m s (EmacsRef m s) Source #
Concatenate two strings.
valueToText :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s Text Source #
Convert an Emacs value into a string using prin1-to-string
.
symbolName :: (WithCallStack, MonadEmacs m, Monad (m s)) => EmacsRef m s -> m s (EmacsRef m 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 :: * -> *) #
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 overriden 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 | |
e ~ SomeException => MonadMask (Either e) | Since: exceptions-0.8.3 |
Defined in Control.Monad.Catch | |
MonadMask m => MonadMask (MaybeT m) | Since: exceptions-0.10.0 |
Defined in Control.Monad.Catch | |
MonadMask m => MonadMask (ResourceT m) | |
Defined in Control.Monad.Trans.Resource.Internal mask :: ((forall a. ResourceT m a -> ResourceT m a) -> ResourceT m b) -> ResourceT m b # uninterruptibleMask :: ((forall a. ResourceT m a -> ResourceT m a) -> ResourceT m b) -> ResourceT m b # generalBracket :: ResourceT m a -> (a -> ExitCase b -> ResourceT m c) -> (a -> ResourceT m b) -> ResourceT m (b, c) # | |
MonadMask (EmacsM s) # | |
Defined in Emacs.Module.Monad | |
MonadMask m => MonadMask (ExceptT e m) | Since: exceptions-0.9.0 |
Defined in Control.Monad.Catch mask :: ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b # uninterruptibleMask :: ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b # generalBracket :: ExceptT e m a -> (a -> ExitCase b -> ExceptT e m c) -> (a -> ExceptT e m b) -> ExceptT e m (b, c) # | |
(MonadMask m, Monoid w) => MonadMask (WriterT w m) | |
Defined in Control.Monad.Catch mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # uninterruptibleMask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # generalBracket :: WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) # | |
MonadMask m => MonadMask (StateT s m) | |
Defined in Control.Monad.Catch | |
(Error e, MonadMask m) => MonadMask (ErrorT e m) | |
Defined in Control.Monad.Catch | |
MonadMask m => MonadMask (IdentityT m) | |
Defined in Control.Monad.Catch mask :: ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b) -> IdentityT m b # uninterruptibleMask :: ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b) -> IdentityT m b # generalBracket :: IdentityT m a -> (a -> ExitCase b -> IdentityT m c) -> (a -> IdentityT m b) -> IdentityT m (b, c) # | |
MonadMask m => MonadMask (StateT s m) | |
Defined in Control.Monad.Catch | |
(MonadMask m, Monoid w) => MonadMask (WriterT w m) | |
Defined in Control.Monad.Catch mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # uninterruptibleMask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # generalBracket :: WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) # | |
MonadMask m => MonadMask (ReaderT r m) | |
Defined in Control.Monad.Catch mask :: ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b) -> ReaderT r m b # uninterruptibleMask :: ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b) -> ReaderT r m b # generalBracket :: ReaderT r m a -> (a -> ExitCase b -> ReaderT r m c) -> (a -> ReaderT r m b) -> ReaderT r m (b, c) # | |
(MonadMask m, Monoid w) => MonadMask (RWST r w s m) | |
Defined in Control.Monad.Catch mask :: ((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 :: ((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 :: 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 :: ((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 :: ((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 :: 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) # |