rasa-0.1.10: A modular text editor

Safe HaskellNone
LanguageHaskell2010

Rasa.Internal.Action

Synopsis

Documentation

newtype Action a Source #

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 Actions exported other extensions
  • Embed buffer actions using bufDo or buffersDo
  • Add/Edit/Focus buffers and a few other Editor-level things, see the Rasa.Internal.Actions module.

Constructors

Action 

Fields

Instances

Monad Action Source # 

Methods

(>>=) :: Action a -> (a -> Action b) -> Action b #

(>>) :: Action a -> Action b -> Action b #

return :: a -> Action a #

fail :: String -> Action a #

Functor Action Source # 

Methods

fmap :: (a -> b) -> Action a -> Action b #

(<$) :: a -> Action b -> Action a #

Applicative Action Source # 

Methods

pure :: a -> Action a #

(<*>) :: Action (a -> b) -> Action a -> Action b #

(*>) :: Action a -> Action b -> Action b #

(<*) :: Action a -> Action b -> Action a #

MonadIO Action Source # 

Methods

liftIO :: IO a -> Action a #

HasExtMonad Action Source # 

Methods

getExt :: (Typeable * ext, Show ext, Default ext) => Action ext Source #

setExt :: (Typeable * ext, Show ext, Default ext) => ext -> Action () Source #

overExt :: (Typeable * ext, Show ext, Default ext) => (ext -> ext) -> Action () Source #

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

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 Actions.

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

bufferDo :: [BufRef] -> BufAction r -> Action [r] Source #

Runs a BufAction over the given BufRefs, returning any results.

Result list is not guaranteed to be the same length or positioning as input BufRef list; some buffers may no longer exist.

addBuffer :: YiString -> Action BufRef Source #

Adds a new buffer and returns the BufRef

getBufRefs :: Action [BufRef] Source #

Returns an up-to-date list of all BufRefs

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

exit :: Action () Source #

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.

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.