Copyright | (C) 2016 Chris Penner |
---|---|
License | MIT |
Maintainer | Chris Penner <christopher.penner@gmail.com> |
Safe Haskell | None |
Language | Haskell2010 |
This module contains the public API for building an extension for Rasa. It re-exports the parts of rasa that are public API for creating extensions.
There are two main things that an extension can do, either react to editor events, or expose useful actions and/or state for other extensions to use.
Whether performing its own actions or being used by a different extension
an extension will want to define some Action
s to perform. Actions
can operate over buffers or even perform IO and comprise the main way in which
extensons do what they need to do. Read more here: Action
, BufAction
.
To sum it all up, Here's an example of a simple logging extension that simply writes each keypress to a file.
logKeypress :: Keypress -> Action () logKeypress (Keypress char _) = liftIO $ appendFile "logs" ("You pressed " ++ [char] ++ "\n") logKeypress _ = return () logger :: Action () logger = do onInit $ liftIO $ writeFile "logs" "==Logs==\n" -- Listeners should also be registered using 'onInit'. -- It ensures all listeners are ready before any actions occur. onInit $ onKeypress logKeypress onExit $ liftIO $ appendFile "logs" "==Done=="
Check out this tutorial on building extensions, it's also just a great way to learn how the editor works: Extension-Guide.
- data Action a
- getBuffer :: BufRef -> Action (Maybe Buffer)
- getEditor :: Action Editor
- exit :: Action ()
- addBuffer :: YiString -> Action BufRef
- nextBufRef :: BufRef -> Action BufRef
- prevBufRef :: BufRef -> Action BufRef
- getBufRefs :: Action [BufRef]
- data Buffer
- class HasBuffer a where
- data BufRef
- text :: HasBuffer b => Lens' b YiString
- class HasEditor a
- getText :: BufAction YiString
- getRange :: CrdRange -> BufAction YiString
- getBufRef :: BufAction BufRef
- data BufAction a
- liftAction :: Action r -> BufAction r
- bufDo :: BufRef -> BufAction a -> Action (Maybe a)
- bufDo_ :: BufRef -> BufAction a -> Action ()
- buffersDo :: BufAction a -> Action [a]
- buffersDo_ :: BufAction a -> Action ()
- overRange :: CrdRange -> (YiString -> YiString) -> BufAction ()
- replaceRange :: CrdRange -> YiString -> BufAction ()
- deleteRange :: CrdRange -> BufAction ()
- insertAt :: Coord -> YiString -> BufAction ()
- sizeOf :: YiString -> Coord
- getLineRange :: Row -> BufAction (Maybe CrdRange)
- class HasExts s where
- ext :: forall a e. (Show a, Typeable a, Default a, HasExts e) => Lens' e a
- getExt :: (HasExtMonad m, Typeable ext, Show ext, Default ext) => m ext
- setExt :: (HasExtMonad m, Typeable ext, Show ext, Default ext) => ext -> m ()
- overExt :: (HasExtMonad m, Typeable ext, Show ext, Default ext) => (ext -> ext) -> m ()
- getBufExt :: (Typeable ext, Show ext, Default ext) => BufAction ext
- setBufExt :: (Typeable ext, Show ext, Default ext) => ext -> BufAction ()
- overBufExt :: (Typeable ext, Show ext, Default ext) => (ext -> ext) -> BufAction ()
- dispatchEvent :: forall result eventType. (Monoid result, Typeable eventType, Typeable result) => eventType -> Action result
- addListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> Action result) -> Action ListenerId
- addListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> Action result) -> Action ()
- removeListener :: ListenerId -> Action ()
- dispatchBufEvent :: (Monoid result, Typeable eventType, Typeable result) => eventType -> BufAction result
- addBufListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ListenerId
- addBufListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ()
- removeBufListener :: ListenerId -> BufAction ()
- data ListenerId
- data Keypress
- data Mod
- dispatchKeypress :: Keypress -> Action ()
- data BufAdded = BufAdded BufRef
- data BufTextChanged = BufTextChanged CrdRange YiString
- onInit :: Action result -> Action ()
- afterInit :: Action a -> Action ()
- beforeEveryEvent :: Action a -> Action ListenerId
- beforeEveryEvent_ :: Action a -> Action ()
- beforeEveryRender :: Action a -> Action ListenerId
- beforeEveryRender_ :: Action a -> Action ()
- onEveryRender :: Action a -> Action ListenerId
- onEveryRender_ :: Action a -> Action ()
- afterEveryRender :: Action a -> Action ListenerId
- afterEveryRender_ :: Action a -> Action ()
- onExit :: Action a -> Action ()
- onBufAdded :: (BufAdded -> Action result) -> Action ListenerId
- onBufAdded_ :: (BufAdded -> Action result) -> Action ()
- onEveryNewBuffer :: BufAction a -> Action ListenerId
- onEveryNewBuffer_ :: BufAction a -> Action ()
- onBufTextChanged :: (BufTextChanged -> BufAction result) -> BufAction ListenerId
- onKeypress :: (Keypress -> Action result) -> Action ListenerId
- dispatchActionAsync :: IO (Action ()) -> Action ()
- dispatchEventAsync :: Typeable event => IO event -> Action ()
- asyncActionProvider :: ((Action () -> IO ()) -> IO ()) -> Action ()
- asyncEventProvider :: (Dispatcher -> IO ()) -> Action ()
- type Dispatcher = forall event. Typeable event => event -> IO ()
- data Range a b = Range {}
- type CrdRange = Range Coord Coord
- type Coord = Coord' Int Int
- data Coord' a b = Coord {}
- newtype Offset = Offset Int
- data Span a b = Span a b
- overRow :: (Int -> Int) -> Coord -> Coord
- overCol :: (Int -> Int) -> Coord -> Coord
- coordRow :: forall a b a. Lens (Coord' a b) (Coord' a b) a a
- coordCol :: forall a b b. Lens (Coord' a b) (Coord' a b) b b
- overBoth :: Bifunctor f => (a -> b) -> f a a -> f b b
- combineSpans :: forall a. Monoid a => [Span CrdRange a] -> [(Coord, a)]
- asCoord :: YiString -> Iso' Offset Coord
- clampCoord :: YiString -> Coord -> Coord
- clampRange :: YiString -> CrdRange -> CrdRange
- rStart :: forall a b a. Lens (Range a b) (Range a b) a a
- rEnd :: forall a b b. Lens (Range a b) (Range a b) b b
- sizeOfR :: CrdRange -> Coord
- afterC :: Coord -> Lens' YiString YiString
- beforeC :: Coord -> Lens' YiString YiString
- moveRange :: Coord -> CrdRange -> CrdRange
- moveRangeByN :: Int -> CrdRange -> CrdRange
- moveCursorByN :: Int -> Coord -> Coord
- fg :: Color -> Style
- bg :: Color -> Style
- flair :: Flair -> Style
- data Color
- data Flair
- newtype Style = Style (Maybe Color, Maybe Color, Maybe Flair)
- type Styles = [Span CrdRange Style]
- addStyleProvider :: BufAction Styles -> BufAction ListenerId
- getStyles :: BufAction Styles
- styleText :: YiString -> Style -> RenderInfo
- asText :: Iso' YiString Text
- asString :: Iso' YiString String
- asLines :: Iso' YiString [YiString]
- clamp :: Int -> Int -> Int -> Int
- cropToViewport :: Height -> ScrollPos -> RenderInfo -> RenderInfo
- type Width = Int
- type Height = Int
- type ScrollPos = Int
- data RenderInfo = RenderInfo YiString Styles
- class Renderable r where
Editor Actions
This is a monad for performing actions against the editor.
You can register Actions to be run in response to events using onEveryTrigger
Within an Action you can:
- Use liftIO for IO
- Access/edit extensions that are stored globally, see
ext
- Embed any
Action
s exported other extensions - Embed buffer actions using
bufDo
orbuffersDo
- Add/Edit/Focus buffers and a few other Editor-level things, see the Rasa.Internal.Actions module.
getBuffer :: BufRef -> Action (Maybe Buffer) Source #
Retrieve a buffer. This is read-only for loggingrenderingdebugging purposes only.
getEditor :: Action Editor Source #
Retrieve the entire editor state. This is read-only for loggingrenderingdebugging purposes only.
This signals to the editor that you'd like to shutdown. The current events
will finish processing, then the onExit
event will be dispatched,
then the editor will exit.
Managing Buffers
Working with Buffers
A buffer, holds the text in the buffer and any extension states that are set on the buffer.
class HasBuffer a where Source #
This allows creation of polymorphic lenses over any type which has access to a Buffer
This allows polymorphic lenses over anything that has access to an Editor context
Actions over Buffers
This is a monad for performing actions on a specific buffer.
You run BufAction
s by embedding them in a Action
via bufferDo
or
buffersDo
Within a BufAction you can:
- Use
liftAction
to run anAction
- Use liftIO for IO
- Access/Edit the buffer's text; some commands are available in Rasa.Internal.Actions.
- Access/edit buffer extensions; see
bufExt
- Embed and sequence
BufAction
s from other extensions
buffersDo_ :: BufAction a -> Action () Source #
Working with Text
overRange :: CrdRange -> (YiString -> YiString) -> BufAction () Source #
Runs function over given range of text
replaceRange :: CrdRange -> YiString -> BufAction () Source #
Replaces the text in the given range with the given text.
deleteRange :: CrdRange -> BufAction () Source #
Deletes the text in the given range from the buffer.
insertAt :: Coord -> YiString -> BufAction () Source #
Inserts text into the buffer at the given Coord
.
sizeOf :: YiString -> Coord Source #
Returns the number of rows and columns that a chunk of text spans as a Coord
getLineRange :: Row -> BufAction (Maybe CrdRange) Source #
Gets the range representing a given row (if that row exists)
Working with Extensions
Extension states for ALL the extensions installed are stored in the same
map keyed by their TypeRep
so if more than one extension
uses the same type then they'll conflict. This is easily solved by simply
using a newtype around any types which other extensions may use (your own
custom types don't need to be wrapped). For example if your extension stores
a counter as an Int, wrap it in your own custom Counter newtype when storing
it.
Because Extension states are stored by their TypeRep
, they must define an
instance of Typeable
, luckily GHC can derive this for you with
deriving Typeable
.
It is also required for all extension states to define an instance of
Default
, this is because accessing an extension which has not
yet been stored will result in the default value.
If there's no default value that makes sense for your type, you can define
a default of Nothing
and pattern match on its value when you
access it.
Extensions may store state persistently for later access or for other
extensions to access. Because Rasa can't possibly know the types of the
state that extensions will store it uses a clever workaround wherein
extension states are stored in a map of TypeRep
-> Ext
which is coerced into the proper type when it's extracted. The interface to
extract or alter a given extension is to use the ext
and bufExt
lenses.
Simply use them as though they were lenses to an object of your type and
it'll all work out.
Since it's polymorphic, if ghc can't figure out the type the result is supposed to be then you'll need to help it out with a type annotation. In practice you won't typically need to do this unless you're doing something complicated.
ext :: forall a e. (Show a, Typeable a, Default a, HasExts e) => Lens' e a Source #
This is a lens which will focus the extension state that matches the type inferred as the focal point. It's a little bit of magic, if you treat the focus as a member of your extension state it should just work out.
This lens falls back on the extension's Default
instance (when getting) if
nothing has yet been stored.
getExt :: (HasExtMonad m, Typeable ext, Show ext, Default ext) => m ext Source #
Retrieve some extension state
setExt :: (HasExtMonad m, Typeable ext, Show ext, Default ext) => ext -> m () Source #
Set some extension state
overExt :: (HasExtMonad m, Typeable ext, Show ext, Default ext) => (ext -> ext) -> m () Source #
Set some extension state
getBufExt :: (Typeable ext, Show ext, Default ext) => BufAction ext Source #
Retrieve some buffer extension state
setBufExt :: (Typeable ext, Show ext, Default ext) => ext -> BufAction () Source #
Set some buffer extension state
overBufExt :: (Typeable ext, Show ext, Default ext) => (ext -> ext) -> BufAction () Source #
Set some buffer extension state
Events
dispatchEvent
and addListener
are key parts of working with extensions.
Here's an example of how you might use them in some sort of clipboard extensions:
-- The event type which is triggered whenever something is copied to clipboard data Copied = Copied Y.YiString -- This registers functions to be run when something is copied. -- you can see this is just addListener but with a more concrete type. onCopy :: (Copied -> Action ()) -> Action ListenerId onCopy = addListener -- This takes a Copied event and runs all the listeners associated. -- You can see it's just 'dispatchEvent' with a more concrete type. doCopy :: Copied -> Action () doCopy = dispatchEvent copier :: Action () copier = do -- ... do some stuff doCopy $ Copied copiedTxt
dispatchEvent :: forall result eventType. (Monoid result, Typeable eventType, Typeable result) => eventType -> Action result Source #
Dispatches an event of any type. This should be used to define
your own custom event dispatchers (with more concrete types) which you can re-export.
You can collect results from all listeners if they were registered to return an Action result
where result
is a Monoid (for example a list).
addListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> Action result) -> Action ListenerId Source #
This adds an event listener which listens for events of eventType
and will run the resulting
Action result
when triggered by some dispatchEvent
.
This should primarily be used to create your own more specific addListener functions which you re-export.
addListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> Action result) -> Action () Source #
removeListener :: ListenerId -> Action () Source #
Removes the listener represented by the given ListenerId.
dispatchBufEvent :: (Monoid result, Typeable eventType, Typeable result) => eventType -> BufAction result Source #
Dispatches an event of any type to the BufAction's buffer.
See dispatchEvent
addBufListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ListenerId Source #
Adds a listener to the BufAction's buffer.
See addListener
addBufListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction () Source #
removeBufListener :: ListenerId -> BufAction () Source #
Removes a listener from the BufAction's buffer.
See removeListener
data ListenerId Source #
An opaque reverence to a specific registered event-listener.
A ListenerId is used only to remove listeners later with removeListener
.
Built-in Events
This event is dispatched in response to keyboard key presses. It contains both
the char that was pressed and any modifiers (Mod
) that where held when the key was pressed.
This represents each modifier key that could be pressed along with a key.
This event is dispatched after adding a new buffer. The contained BufRef refers to the new buffer.
data BufTextChanged Source #
This is triggered when text in a buffer is changed. The Event data includes the CrdRange
that changed and
the new text which is now contined in that range.
Built-in Event Listeners
onInit :: Action result -> Action () Source #
Registers an action to be performed during the Initialization phase.
This phase occurs exactly ONCE when the editor starts up. Though arbitrary actions may be performed in the configuration block; it's recommended to embed such actions in the onInit event listener so that all event listeners are registered before anything Actions occur.
beforeEveryEvent :: Action a -> Action ListenerId Source #
Registers an action to be performed BEFORE each event phase.
beforeEveryEvent_ :: Action a -> Action () Source #
beforeEveryRender :: Action a -> Action ListenerId Source #
Registers an action to be performed BEFORE each render phase.
This is a good spot to add information useful to the renderer since all actions have been performed. Only cosmetic changes should occur during this phase.
beforeEveryRender_ :: Action a -> Action () Source #
onEveryRender :: Action a -> Action ListenerId Source #
Registers an action to be performed during each render phase.
This phase should only be used by extensions which actually render something.
onEveryRender_ :: Action a -> Action () Source #
afterEveryRender :: Action a -> Action ListenerId Source #
Registers an action to be performed AFTER each render phase.
This is useful for cleaning up extension state that was registered for the renderer, but needs to be cleared before the next iteration.
afterEveryRender_ :: Action a -> Action () Source #
onExit :: Action a -> Action () Source #
Registers an action to be performed during the exit phase.
This is only triggered exactly once when the editor is shutting down. It allows an opportunity to do clean-up, kill any processes you've started, or save any data before the editor terminates.
onBufAdded :: (BufAdded -> Action result) -> Action ListenerId Source #
Registers an action to be performed after a new buffer is added.
The supplied function will be called with a BufRef
to the new buffer, and the resulting Action
will be run.
onEveryNewBuffer :: BufAction a -> Action ListenerId Source #
Run the given BufAction
over all new buffers
onEveryNewBuffer_ :: BufAction a -> Action () Source #
onBufTextChanged :: (BufTextChanged -> BufAction result) -> BufAction ListenerId Source #
This is fired every time text in a buffer changes.
The range of text which was altered and the new value of that text are provided inside a BufTextChanged
event.
onKeypress :: (Keypress -> Action result) -> Action ListenerId Source #
Working with Async Events/Actions
dispatchActionAsync :: IO (Action ()) -> Action () Source #
dispatchActionAsync allows you to perform a task asynchronously and then apply the
result. In dispatchActionAsync asyncAction
, asyncAction
is an IO which resolves to
an Action, note that the context in which the second action is executed is
NOT the same context in which dispatchActionAsync is called; it is likely that text and
other state have changed while the IO executed, so it's a good idea to check
(inside the applying Action) that things are in a good state before making
changes. Here's an example:
asyncCapitalize :: Action () asyncCapitalize = do txt <- focusDo getText -- We give dispatchActionAsync an IO which resolves in an action dispatchActionAsync $ ioPart txt ioPart :: Text -> IO (Action ()) ioPart txt = do result <- longAsyncronousCapitalizationProgram txt -- Note that this returns an Action, but it's still wrapped in IO return $ maybeApplyResult txt result maybeApplyResult :: Text -> Text -> Action () maybeApplyResult oldTxt capitalized = do -- We get the current buffer's text, which may have changed since we started newTxt <- focusDo getText if newTxt == oldTxt -- If the text is the same as it was, we can apply the transformation then focusDo (setText capitalized) -- Otherwise we can choose to re-queue the whole action and try again -- Or we could just give up. else asyncCapitalize
dispatchEventAsync :: Typeable event => IO event -> Action () Source #
This function takes an IO which results in some Event, it runs the IO asynchronously and dispatches the event
asyncActionProvider :: ((Action () -> IO ()) -> IO ()) -> Action () Source #
Don't let the type signature confuse you; it's much simpler than it seems.
The first argument is a function which takes an action provider; the action provider
will be passed a dispatch function which can be called as often as you like with Action ()
s.
When it is passed an Action
it forks off an IO to dispatch that Action
to the main event loop.
Note that the dispatch function calls forkIO on its own; so there's no need for you to do so.
Use this function when you have some long-running process which dispatches multiple Action
s.
Here's an example which fires a Timer
event every second.
data Timer = TimerFired dispatchTimer :: Action () dispatchTimer = mkDispatcher Timer myTimer :: (Action () -> IO ()) -> IO () myTimer dispatch = forever $ dispatch dispatchTimer >> threadDelay 1000000 myAction :: Action () myAction = onInit $ asyncActionProvider myTimer
asyncEventProvider :: (Dispatcher -> IO ()) -> Action () Source #
This allows long-running IO processes to provide Events to Rasa asyncronously.
Don't let the type signature confuse you; it's much simpler than it seems.
Let's break it down:
Using the Dispatcher
type with asyncEventProvider requires the RankNTypes
language pragma.
This type as a whole represents a function which accepts a Dispatcher
and returns an IO
;
the dispatcher itself accepts data of ANY Typeable
type and emits it as an event (see Rasa.Internal.Events).
When you call asyncEventProvider
you pass it a function which accepts a dispatch
function as an argument
and then calls it with various events within the resulting IO
.
Note that asyncEventProvider calls forkIO internally, so there's no need to do that yourself.
Here's an example which fires a Timer
event every second.
{-# language RankNTypes #-} data Timer = Timer myTimer :: Dispatcher -> IO () myTimer dispatch = forever $ dispatch Timer >> threadDelay 1000000 myAction :: Action () myAction = onInit $ asyncEventProvider myTimer
type Dispatcher = forall event. Typeable event => event -> IO () Source #
This is a type alias to make defining your functions for use with asyncEventProvider
easier;
It represents the function your event provider function will be passed to allow dispatching
events. Using this type requires the RankNTypes
language pragma.
Ranges
This represents a range between two coordinates (Coord
)
type CrdRange = Range Coord Coord Source #
A type alias to Range'
which specializes the types to Coord
s.
(Coord Row Column) represents a char in a block of text. (zero indexed) e.g. Coord 0 0 is the first character in the text, Coord 2 1 is the second character of the third row
An Offset
represents an exact position in a file as a number of characters from the start.
A span which maps a piece of Monoidal data over a range.
Span a b |
overBoth :: Bifunctor f => (a -> b) -> f a a -> f b b Source #
Applies a function over both functors in any Bifunctor
.
combineSpans :: forall a. Monoid a => [Span CrdRange a] -> [(Coord, a)] Source #
Combines a list of spans containing some monoidal data into a list of offsets with with the data that applies from each Offset forwards.
clampCoord :: YiString -> Coord -> Coord Source #
This will restrict a given Coord
to a valid one which lies within the given text.
clampRange :: YiString -> CrdRange -> CrdRange Source #
This will restrict a given Range
to a valid one which lies within the given text.
Styles
A common representation for text styling
These represent the possible extra attributes which may be applied.
DefFlair
represents the renderer's default text attributes.
A container which holds a foreground color, background color, and a flair.
a Nothing
represents that we should not change that attribute.
addStyleProvider :: BufAction Styles -> BufAction ListenerId Source #
Pass this a BufAction
which computes styles based on the current buffer
and they'll be collected for the renderer.
styleText :: YiString -> Style -> RenderInfo Source #
Add a style to some text resulting in a RenderInfo
Useful Utilities
clamp :: Int -> Int -> Int -> Int Source #
clamp min max val
restricts val to be within min and max (inclusive)
cropToViewport :: Height -> ScrollPos -> RenderInfo -> RenderInfo Source #
Crop text verticaly to only the visible portion according to viewport height and scroll position.
Common Types/Interfaces
These exist to help unify the interfaces of many different extensions without requiring them to depend upon each other. Use them liberally in your own extensions.
data RenderInfo Source #
RenderInfo is the data necessary to render something; it consists of a block of
text with its associated styles. It is a Monoid and can be appended with other RenderInfo
s.
Monoid RenderInfo Source # | Appends to RenderInfo by appending the text and styles while preserving proper text/style alignment |
Renderable RenderInfo Source # | |
class Renderable r where Source #
Represents how to render an entity