packages feed

rasa 0.1.10 → 0.1.11

raw patch · 21 files changed

+302/−1172 lines, 21 filesdep +evedep ~rasa

Dependencies added: eve

Dependency ranges changed: rasa

Files

rasa.cabal view
@@ -1,5 +1,5 @@ name: rasa-version: 0.1.10+version: 0.1.11 cabal-version: >=1.10 build-type: Simple license: GPL-3@@ -58,17 +58,9 @@     exposed-modules:         Rasa         Rasa.Ext-        Rasa.Testing-        Rasa.Internal.ActionMonads-        Rasa.Internal.Action-        Rasa.Internal.Actions-        Rasa.Internal.BufAction         Rasa.Internal.BufActions         Rasa.Internal.Buffer-        Rasa.Internal.Editor         Rasa.Internal.Events-        Rasa.Internal.Extensions-        Rasa.Internal.Interpreters         Rasa.Internal.Listeners         Rasa.Internal.Range         Rasa.Internal.Styles@@ -76,6 +68,7 @@         Rasa.Internal.Utility     build-depends:         base >=4.8 && <5,+        eve >=0.1.2 && <0.2,         async >=2.1.1 && <2.2,         bifunctors >=5.4.1 && <5.5,         profunctors ==5.2.*,@@ -101,7 +94,8 @@     main-is: Spec.hs     build-depends:         base >=4.9.0.0 && <4.10,-        rasa >=0.1.10 && <0.2,+        rasa >=0.1.11 && <0.2,+        eve >=0.1.2 && <0.2,         hspec >=2.2.4 && <2.3,         lens ==4.14.*,         yi-rope >=0.7.0.2 && <0.8,@@ -117,12 +111,9 @@         Rasa.Internal.ActionSpec         Rasa.Internal.ActionsSpec         Rasa.Internal.AsyncSpec-        Rasa.Internal.BufActionSpec         Rasa.Internal.BufActionsSpec         Rasa.Internal.BufferSpec-        Rasa.Internal.EditorSpec         Rasa.Internal.EventsSpec-        Rasa.Internal.ExtensionsSpec         Rasa.Internal.ListenersSpec         Rasa.Internal.RangeSpec         Rasa.Internal.TextSpec
src/Rasa.hs view
@@ -1,17 +1,11 @@ {-# language ExistentialQuantification, Rank2Types, ScopedTypeVariables #-} module Rasa (rasa) where +import Eve import Rasa.Internal.Listeners-import Rasa.Internal.Action-import Rasa.Internal.Interpreters  import Control.Monad-import Control.Monad.IO.Class-import Data.Maybe--import Pipes-import Pipes.Concurrent-import Pipes.Parse+import Data.Default  -- | The main function to run rasa. --@@ -25,26 +19,9 @@ -- >   vim -- >   slate -rasa :: Action () -> IO ()-rasa initialize = do-  (output, input) <- spawn unbounded-  evalAction (mkActionState output) $ do-    initialize-    dispatchInit-    dispatchAfterInit-    eventLoop $ fromInput input-    dispatchExit---- | This is the main event loop, it runs recursively forever until something--- sets 'Rasa.Editor.exiting'. It runs the pre-event listeners, then checks if any--- async events have finished, then runs the post event listeners and repeats.-eventLoop :: Producer (Action ()) IO () -> Action ()-eventLoop producer = do-  dispatchBeforeRender-  dispatchOnRender-  dispatchAfterRender-  dispatchBeforeEvent-  (mAction, nextProducer) <- liftIO $ runStateT draw producer-  fromMaybe (return ()) mAction-  isExiting <- shouldExit-  unless isExiting $ eventLoop nextProducer+rasa :: App () -> IO ()+rasa initialization = void $ eve (initialization >> hooks)+  where hooks = beforeEvent_ $ do+          dispatchBeforeRender+          dispatchOnRender+          dispatchAfterRender
src/Rasa/Ext.hs view
@@ -26,10 +26,8 @@ -- > -- > 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+-- >   liftIO $ writeFile "logs" "==Logs==\n"+-- >   onKeypress logKeypress -- >   onExit $ liftIO $ appendFile "logs" "==Done==" -- -- Check out this tutorial on building extensions, it's also just a great way to learn@@ -39,10 +37,7 @@ module Rasa.Ext   (   -- * Editor Actions-    Action-  , getBuffer-  , getEditor-  , exit+  getBuffer    -- * Managing Buffers   , addBuffer@@ -55,14 +50,12 @@   , HasBuffer(..)   , BufRef   , text-  , HasEditor   , getText   , getRange   , getBufRef    -- * Actions over Buffers   , BufAction-  , liftAction   , bufDo   , bufDo_   , buffersDo@@ -76,85 +69,17 @@   , sizeOf   , getLineRange -  -- * Working with Extensions-  -- | Extension states for ALL the extensions installed are stored in the same-  -- map keyed by their 'Data.Typeable.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 'Data.Typeable.TypeRep', they must define an-  -- instance of 'Data.Typeable.Typeable', luckily GHC can derive this for you with-  -- @deriving Typeable@.-  ---  -- It is also required for all extension states to define an instance of-  -- 'Data.Default.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 'Data.Maybe.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 'Data.Typeable.TypeRep' -> 'Rasa.Internal.Extensions.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.-  , HasExts(..)-  , ext-  , getExt-  , setExt-  , overExt-   , getBufExt   , setBufExt   , overBufExt    -- * 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-  , addListener-  , addListener_-  , removeListener-   , dispatchBufEvent   , addBufListener   , addBufListener_   , removeBufListener -  , ListenerId-   -- * Built-in Events   , Keypress(..)   , Mod(..)@@ -163,17 +88,12 @@   , BufTextChanged(..)    -- * Built-in Event Listeners-  , onInit-  , afterInit-  , beforeEveryEvent-  , beforeEveryEvent_   , beforeEveryRender   , beforeEveryRender_   , onEveryRender   , onEveryRender_   , afterEveryRender   , afterEveryRender_-  , onExit   , onBufAdded   , onBufAdded_   , onEveryNewBuffer@@ -181,13 +101,6 @@   , onBufTextChanged   , onKeypress -  -- * Working with Async Events/Actions-  , dispatchActionAsync-  , dispatchEventAsync-  , asyncActionProvider-  , asyncEventProvider-  , Dispatcher-    -- * Ranges   , Range(..)   , CrdRange@@ -241,16 +154,14 @@   , ScrollPos   , RenderInfo(..)   , Renderable(..)++  , module Eve   ) where -import Rasa.Internal.Action-import Rasa.Internal.Actions-import Rasa.Internal.BufAction+import Eve import Rasa.Internal.BufActions import Rasa.Internal.Buffer-import Rasa.Internal.Editor import Rasa.Internal.Events-import Rasa.Internal.Extensions import Rasa.Internal.Listeners import Rasa.Internal.Range import Rasa.Internal.Styles
− src/Rasa/Internal/Action.hs 
@@ -1,109 +0,0 @@-module Rasa.Internal.Action-  ( Action(..)-  , dispatchActionAsync-  , asyncActionProvider-  , bufferDo-  , addBuffer-  , getBufRefs-  , getExt-  , setExt-  , overExt-  , exit-  , shouldExit-  , getBuffer-  , getEditor-  ) where--import Rasa.Internal.ActionMonads-import Rasa.Internal.Editor-import Rasa.Internal.Buffer-import Rasa.Internal.Extensions--import qualified Yi.Rope as Y---- | 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-dispatchActionAsync :: IO (Action ()) -> Action ()-dispatchActionAsync ioAction = liftActionF $ DispatchActionAsync ioAction ()---- | 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--asyncActionProvider :: ((Action () -> IO ()) -> IO ()) -> Action ()-asyncActionProvider asyncActionProv = liftActionF $ AsyncActionProvider asyncActionProv ()---- | 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.-bufferDo :: [BufRef] -> BufAction r -> Action [r]-bufferDo bufRefs bufAct = liftActionF $ BufferDo bufRefs bufAct id---- | Adds a new buffer and returns the BufRef-addBuffer :: Y.YiString -> Action BufRef-addBuffer txt = liftActionF $ AddBuffer txt id---- | Returns an up-to-date list of all 'BufRef's-getBufRefs :: Action [BufRef]-getBufRefs = liftActionF $ GetBufRefs id---- | Retrieve the entire editor state. This is read-only for logging/rendering/debugging purposes only.-getEditor :: Action Editor-getEditor = liftActionF $ GetEditor id---- | Retrieve a buffer. This is read-only for logging/rendering/debugging purposes only.-getBuffer :: BufRef -> Action (Maybe Buffer)-getBuffer bufRef = liftActionF $ GetBuffer bufRef id---- | This signals to the editor that you'd like to shutdown. The current events--- will finish processing, then the 'Rasa.Internal.Listeners.onExit' event will be dispatched,--- then the editor will exit.-exit :: Action ()-exit = liftActionF $ Exit ()--shouldExit :: Action Bool-shouldExit = liftActionF $ ShouldExit id
− src/Rasa/Internal/ActionMonads.hs 
@@ -1,120 +0,0 @@-{-# language-   DeriveFunctor-  , GADTs-  , GeneralizedNewtypeDeriving-  , StandaloneDeriving-#-}-module Rasa.Internal.ActionMonads-  ( Action(..)-  , BufAction(..)-  , ActionF(..)-  , BufActionF(..)-  , liftActionF-  , liftBufAction-  ) where--import Rasa.Internal.Editor-import Rasa.Internal.Extensions-import Rasa.Internal.Buffer-import Rasa.Internal.Range--import Control.Monad.Free-import Control.Monad.IO.Class--import Data.Default-import Data.Typeable--import qualified Yi.Rope as Y---- | Free Monad Actions for Action-data ActionF next where-  LiftIO :: IO next -> ActionF next-  BufferDo :: [BufRef]  -> BufAction r -> ([r] -> next) -> ActionF next-  DispatchActionAsync :: IO (Action ()) -> next  -> ActionF next-  AsyncActionProvider :: ((Action () -> IO ()) -> IO ()) -> next  -> ActionF next-  AddBuffer :: Y.YiString -> (BufRef -> next) -> ActionF next-  GetBufRefs :: ([BufRef] -> next) -> ActionF next-  GetExt :: (Typeable ext, Show ext, Default ext) => (ext -> next) -> ActionF next-  SetExt :: (Typeable ext, Show ext, Default ext) => ext -> next -> ActionF next-  GetEditor :: (Editor -> next) -> ActionF next-  GetBuffer :: BufRef -> (Maybe Buffer -> next)  -> ActionF next-  Exit :: next -> ActionF next-  ShouldExit :: (Bool -> next) -> ActionF next-deriving instance Functor ActionF---- | Embeds a ActionF type into the Action Monad-liftActionF :: ActionF a -> Action a-liftActionF = Action . liftF---- | Allows running IO in BufAction.-liftFIO :: IO r -> Action r-liftFIO = liftActionF . LiftIO--instance MonadIO Action where-  liftIO = liftFIO--instance HasExtMonad Action where-  -- | Retrieve some extension state-  getExt = liftActionF $ GetExt id--  -- | Set some extension state-  setExt newExt = liftActionF $ SetExt newExt ()---- | This is a monad for performing actions against the editor.--- You can register Actions to be run in response to events using 'Rasa.Internal.Listeners.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 'Rasa.Internal.Actions.bufDo' or 'Rasa.Internal.Actions.buffersDo'---      * Add\/Edit\/Focus buffers and a few other Editor-level things, see the "Rasa.Internal.Actions" module.-newtype Action a = Action-  { getAction :: Free ActionF a-  } deriving (Functor, Applicative, Monad)---- | Free Monad Actions for BufAction-data BufActionF next where-  GetText :: (Y.YiString -> next) -> BufActionF next-  SetText :: Y.YiString -> next -> BufActionF next-  GetBufRef :: (BufRef -> next) -> BufActionF next-  GetBufExt :: (Typeable ext, Show ext, Default ext) => (ext -> next) -> BufActionF next-  SetBufExt :: (Typeable ext, Show ext, Default ext) => ext -> next -> BufActionF next-  SetRange :: CrdRange -> Y.YiString -> next -> BufActionF next-  LiftAction :: Action r -> (r -> next) -> BufActionF next-  BufLiftIO :: IO next -> BufActionF next-deriving instance Functor BufActionF---- | This is a monad for performing actions on a specific buffer.--- You run 'BufAction's by embedding them in a 'Action' via 'Rasa.Internal.Actions.bufferDo' or--- 'Rasa.Internal.Actions.buffersDo'------ Within a BufAction you can:------      * Use 'liftAction' to run an 'Action'---      * 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-newtype BufAction a = BufAction-  { getBufAction :: Free BufActionF a-  } deriving (Functor, Applicative, Monad)---- | Embeds a BufActionF type into the BufAction Monad-liftBufAction :: BufActionF a -> BufAction a-liftBufAction = BufAction . liftF---- | Allows running IO in BufAction.-liftBufActionFIO :: IO r -> BufAction r-liftBufActionFIO = liftBufAction . BufLiftIO--instance MonadIO BufAction where-  liftIO = liftBufActionFIO--instance HasExtMonad BufAction where-  -- | Retrieve some buffer extension state-  getExt = liftBufAction $ GetBufExt id--  -- | Set some buffer extension state-  setExt newExt = liftBufAction $ SetBufExt newExt ()
− src/Rasa/Internal/Actions.hs 
@@ -1,67 +0,0 @@-{-# language-    Rank2Types-  , OverloadedStrings-  , ScopedTypeVariables-#-}-module Rasa.Internal.Actions-  (-  -- * Performing Actions on Buffers-    bufDo-  , bufDo_-  , buffersDo-  , buffersDo_--  -- * Editor Actions-  , exit-  , getBufRefs-  , nextBufRef-  , prevBufRef-  ) where--import Rasa.Internal.Editor-import Rasa.Internal.Action-import Rasa.Internal.BufAction--import Control.Monad-import Data.Maybe---- | This lifts a 'Rasa.Action.BufAction' to an 'Rasa.Action.Action' which--- performs the 'Rasa.Action.BufAction' on every buffer and collects the return--- values as a list.--buffersDo :: BufAction a -> Action [a]-buffersDo bufAct = do-  bufRefs <- getBufRefs-  bufferDo bufRefs bufAct--buffersDo_ :: BufAction a -> Action ()-buffersDo_ = void . buffersDo---- | This lifts a 'Rasa.Internal.Action.BufAction' to an 'Rasa.Internal.Action.Action' which--- performs the 'Rasa.Internal.Action.BufAction' on the buffer referred to by the 'BufRef'--- If the buffer referred to no longer exists this returns: @Nothing@.-bufDo :: BufRef -> BufAction a -> Action (Maybe a)-bufDo bufRef bufAct = listToMaybe <$> bufferDo [bufRef] bufAct--bufDo_ :: BufRef -> BufAction a -> Action ()-bufDo_ bufRef bufAct = void $ bufDo bufRef bufAct---- | Gets 'BufRef' that comes after the one provided-nextBufRef :: BufRef -> Action BufRef-nextBufRef br = do-  bufRefs <- getBufRefs-  return $ if null bufRefs-              then br-              else case dropWhile (<= br) bufRefs of-                     [] -> head bufRefs-                     (x:_) -> x---- | Gets 'BufRef' that comes before the one provided-prevBufRef :: BufRef -> Action BufRef-prevBufRef br = do-  bufRefs <- getBufRefs-  return $ if null bufRefs-              then br-              else case dropWhile (>= br) (reverse bufRefs) of-                     [] -> last bufRefs-                     (x:_) -> x
− src/Rasa/Internal/BufAction.hs 
@@ -1,58 +0,0 @@-module Rasa.Internal.BufAction-  ( BufAction(..)-  , getText-  , setText-  , getBufRef-  , getRange-  , setRange-  , getBufExt-  , setBufExt-  , overBufExt-  , liftAction-  ) where--import Rasa.Internal.ActionMonads-import Rasa.Internal.Range-import Rasa.Internal.Buffer--import Control.Lens-import Data.Default-import Data.Typeable--import qualified Yi.Rope as Y---- | Returns the text of the current buffer-getText :: BufAction Y.YiString-getText = liftBufAction $ GetText id---- | Sets the text of the current buffer-setText :: Y.YiString -> BufAction ()-setText txt = liftBufAction $ SetText txt ()---- | Gets the range of text from the buffer-getRange :: CrdRange -> BufAction Y.YiString-getRange rng = view (range rng) <$> getText---- | Sets the range of text from the buffer-setRange :: CrdRange -> Y.YiString -> BufAction ()-setRange rng txt = liftBufAction $ SetRange rng txt ()---- | Gets the current buffer's 'BufRef'-getBufRef :: BufAction BufRef-getBufRef = liftBufAction $ GetBufRef id---- | Retrieve some buffer extension state-getBufExt :: (Typeable ext, Show ext, Default ext) => BufAction ext-getBufExt = liftBufAction $ GetBufExt id---- | Set some buffer extension state-setBufExt :: (Typeable ext, Show ext, Default ext) => ext -> BufAction ()-setBufExt newExt = liftBufAction $ SetBufExt newExt ()---- | Set some buffer extension state-overBufExt :: (Typeable ext, Show ext, Default ext) => (ext -> ext) -> BufAction ()-overBufExt f = getBufExt >>= setBufExt . f---- | This lifts up an 'Action' to be run inside a 'BufAction'-liftAction :: Action r -> BufAction r-liftAction action = liftBufAction $ LiftAction action id
src/Rasa/Internal/BufActions.hs view
@@ -1,4 +1,5 @@ {-# language OverloadedStrings #-}+{-# language RankNTypes #-} module Rasa.Internal.BufActions   ( overRange   , replaceRange@@ -6,15 +7,99 @@   , insertAt   , sizeOf   , getLineRange++  -- * Performing Apps on Buffers+  , bufDo+  , bufDo_+  , buffersDo+  , buffersDo_++  -- * Editor Apps+  , getBufRefs+  , nextBufRef+  , prevBufRef++  , getBufExt+  , setBufExt+  , overBufExt++  , getBufRef+  , getRange+  , addBuffer+  , getBuffer+++  , dispatchBufEvent+  , addBufListener+  , addBufListener_+  , removeBufListener++  , onBufAdded+  , onBufAdded_+  , dispatchBufAdded+  , onEveryNewBuffer+  , onEveryNewBuffer_++  , onBufTextChanged+  , dispatchBufTextChanged++  , getText+   ) where -import Rasa.Internal.BufAction+import Eve++import Rasa.Internal.Buffer import Rasa.Internal.Range import Rasa.Internal.Text+import Rasa.Internal.Events  import Control.Lens+import Control.Monad+import Data.Maybe+import Data.Default+import Data.Typeable import qualified Yi.Rope as Y+import qualified Data.IntMap as IM +-- | Returns the text of the current buffer+getText :: BufAction Y.YiString+getText = use text++-- -- | Sets the text of the current buffer+-- setText :: Y.YiString -> BufAction ()+-- setText txt = text .= txt++-- | Gets the range of text from the buffer+getRange :: CrdRange -> BufAction Y.YiString+getRange rng = view (range rng) <$> getText++-- | Sets the range of text from the buffer+setRange :: CrdRange -> Y.YiString -> BufAction ()+setRange rng txt = do+  text.range rng .= txt+  dispatchBufTextChanged $ BufTextChanged rng txt++-- | Gets the current buffer's 'BufRef'+getBufRef :: BufAction BufRef+getBufRef = use ref++-- | Retrieve some buffer extension state+getBufExt :: (Typeable s, Show s, Default s) => BufAction s+getBufExt = use stateLens++-- | Set some buffer extension state+setBufExt :: (Typeable s, Show s, Default s) => s -> BufAction ()+setBufExt newExt = stateLens .= newExt++-- | Set some buffer extension state+overBufExt :: (Typeable s, Show s, Default s) => (s -> s) -> BufAction ()+overBufExt f = stateLens %= f++-- -- | This lifts up an 'Action' to be run inside a 'BufAction'+-- liftApp :: App r -> BufAction r+-- liftApp action = liftBufAction $ LiftAction action id+ -- | Runs function over given range of text overRange :: CrdRange -> (Y.YiString -> Y.YiString) -> BufAction () overRange r f = getRange r >>= setRange r . f@@ -41,3 +126,124 @@   txt <- getText   let len = txt ^? asLines . ix n . to Y.length   return $ Range (Coord n 0) . Coord n <$> len++-- | Adds a new buffer and returns the BufRef+addBuffer :: Y.YiString -> App BufRef+addBuffer txt = do+  bufId <- nextBufId <+= 1+  let bufRef = BufRef bufId+  buffers.at bufId ?= mkBuffer txt bufRef+  dispatchBufAdded (BufAdded bufRef)+  return bufRef++-- | Returns an up-to-date list of all 'BufRef's+getBufRefs :: App [BufRef]+getBufRefs = fmap BufRef <$> use (buffers.to IM.keys)+++-- | Retrieve a buffer. This is read-only for logging/rendering/debugging purposes only.+getBuffer :: BufRef -> App (Maybe Buffer)+getBuffer (BufRef bufInd) =+  use (buffers.at bufInd)++-- | 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.+bufferDo :: [BufRef] -> BufAction r -> App [r]+bufferDo bufRefs bufAct = do+  r <- forM bufRefs $ \(BufRef bInd) ->+    runAction (buffers.at bInd._Just) ((:[]) <$> bufAct)+  return $ concat r++-- | This lifts a 'Rasa.App.BufAction' to an 'Rasa.App.App' which+-- performs the 'Rasa.App.BufAction' on every buffer and collects the return+-- values as a list.++buffersDo :: BufAction a -> App [a]+buffersDo bufAct = do+  bufRefs <- getBufRefs+  bufferDo bufRefs bufAct++buffersDo_ :: BufAction a -> App ()+buffersDo_ = void . buffersDo++-- | This lifts a 'Rasa.Internal.App.BufAction' to an 'Rasa.Internal.App.App' which+-- performs the 'Rasa.Internal.App.BufAction' on the buffer referred to by the 'BufRef'+-- If the buffer referred to no longer exists this returns: @Nothing@.+bufDo :: BufRef -> BufAction a -> App (Maybe a)+bufDo bufRef bufAct = listToMaybe <$> bufferDo [bufRef] bufAct++bufDo_ :: BufRef -> BufAction a -> App ()+bufDo_ bufRef bufAct = void $ bufDo bufRef bufAct++-- | Gets 'BufRef' that comes after the one provided+nextBufRef :: BufRef -> App BufRef+nextBufRef br = do+  bufRefs <- getBufRefs+  return $ if null bufRefs+              then br+              else case dropWhile (<= br) bufRefs of+                     [] -> head bufRefs+                     (x:_) -> x++-- | Gets 'BufRef' that comes before the one provided+prevBufRef :: BufRef -> App BufRef+prevBufRef br = do+  bufRefs <- getBufRefs+  return $ if null bufRefs+              then br+              else case dropWhile (>= br) (reverse bufRefs) of+                     [] -> last bufRefs+                     (x:_) -> x++++-- | 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 'App' will be run.+onBufAdded :: (BufAdded -> App result) -> App ListenerId+onBufAdded actionF = addListener (void . actionF)++onBufAdded_ :: (BufAdded -> App result) -> App ()+onBufAdded_ = void . onBufAdded++-- | Run the given 'BufAction' over all new buffers+onEveryNewBuffer :: BufAction a -> App ListenerId+onEveryNewBuffer bufApp = onBufAdded $+  \(BufAdded br) -> bufDo_ br bufApp++onEveryNewBuffer_ :: BufAction a -> App ()+onEveryNewBuffer_ = void . onEveryNewBuffer++-- | Dispatch the 'BufAdded' action.+dispatchBufAdded :: BufAdded -> App ()+dispatchBufAdded = dispatchEvent++-- | 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.+onBufTextChanged :: (BufTextChanged -> BufAction result) -> BufAction ListenerId+onBufTextChanged bufAppF = addBufListener (void . bufAppF)++-- | Dispatch the 'BufBufTextChanged' action.+dispatchBufTextChanged :: BufTextChanged -> BufAction ()+dispatchBufTextChanged = dispatchBufEvent++-- | Dispatches an event of any type to the BufAction's buffer.+-- See 'dispatchEvent'+dispatchBufEvent :: (Monoid result, Typeable eventType, Typeable result) => (eventType -> BufAction result)+dispatchBufEvent = dispatchEvent++-- | Adds a listener to the BufAction's buffer.+-- See 'addListener'+addBufListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ListenerId+addBufListener = addListener++addBufListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ()+addBufListener_ = void . addBufListener++-- | Removes a listener from the BufAction's buffer.+-- See 'removeListener'+removeBufListener :: ListenerId -> BufAction ()+removeBufListener = removeListener
src/Rasa/Internal/Buffer.hs view
@@ -11,19 +11,27 @@  module Rasa.Internal.Buffer   ( Buffer+  , BufAction   , HasBuffer(..)   , BufRef(..)   , text   , mkBuffer   , ref++  , buffers+  , nextBufId+   ) where -import Rasa.Internal.Extensions +import Eve+ import qualified Yi.Rope as Y import Control.Lens hiding (matching)-import Data.Map as M+import qualified Data.Map as M+import qualified Data.IntMap as IM import Data.List+import Data.Default  -- | An opaque reference to a buffer. -- When operating over a BufRef Rasa checks if the 'Rasa.Internal.Buffer.Buffer' still@@ -32,22 +40,29 @@   BufRef Int   deriving (Show, Eq, Ord) +newtype NextBufId = NextBufId+  { _nextBufId' :: Int +  } deriving Show++instance Default NextBufId where+  def = NextBufId 0++makeLenses ''NextBufId+nextBufId :: HasStates s => Lens' s Int+nextBufId = stateLens.nextBufId'+ -- | A buffer, holds the text in the buffer and any extension states that are set on the buffer. data Buffer = Buffer   { _text' :: Y.YiString-  , _bufExts' :: ExtMap+  , _bufStates' :: States   , _ref :: BufRef   } makeLenses ''Buffer -instance HasExts Buffer where-  exts = bufExts'+instance HasStates Buffer where+  states = bufStates' -instance Show Buffer where-  show b = "text:" ++ (Y.toString . Y.take 30 $ (b^.text)) ++ "...,\n"-           ++ "exts: " ++ extText ++ "}>\n"-    where-      extText = intercalate "\n" $ show <$> b^.exts.to M.toList+instance HasEvents Buffer where  -- | This allows creation of polymorphic lenses over any type which has access to a Buffer class HasBuffer a where@@ -60,11 +75,31 @@ text :: HasBuffer b => Lens' b Y.YiString text = buffer.text' +instance Show Buffer where+  show b = "text:" ++ (Y.toString . Y.take 30 $ (b^.text)) ++ "...,\n"+           ++ "exts: " ++ extText ++ "}>\n"+    where+      extText = intercalate "\n" $ show <$> b^.states.to M.toList++type BufAction a = Action Buffer a++newtype Buffers = Buffers+  { _buffers' :: IM.IntMap Buffer+  } deriving Show+makeLenses '' Buffers++instance Default Buffers where+  def = Buffers mempty++-- | A lens over the map of available buffers+buffers :: HasStates s => Lens' s (IM.IntMap Buffer)+buffers = stateLens.buffers'+ -- | Creates a new buffer from the given text. mkBuffer :: Y.YiString -> BufRef -> Buffer mkBuffer txt bRef =   Buffer     { _text' = txt-    , _bufExts' = empty+    , _bufStates' = mempty     , _ref = bRef     }
− src/Rasa/Internal/Editor.hs 
@@ -1,70 +0,0 @@-{-# language-    TemplateHaskell-  , Rank2Types-  , ExistentialQuantification-  , ScopedTypeVariables-  , OverloadedStrings-  #-}--module Rasa.Internal.Editor-  (-  -- * Accessing/Storing state-  Editor-  , HasEditor(..)-  , buffers-  , exiting-  , BufRef(..)-  ) where--import Rasa.Internal.Buffer-import Rasa.Internal.Extensions--import Data.Default-import Data.IntMap-import qualified Data.Map as M-import Control.Lens-import Data.List---- | This is the primary state of the editor.-data Editor = Editor-  { _buffers' :: IntMap Buffer-  , _exiting' :: Bool-  , _extState' :: ExtMap-  }-makeLenses ''Editor--instance Show Editor where-  show ed =-    "Buffers==============\n" ++ bufferText ++ "\n\n"-    ++ "Editor Extensions==============\n" ++ extText ++ "\n\n"-    ++ "---\n\n"-    where-      bufferText = intercalate "\n" $ zipWith ((++) . (++ ": ") .  show) [(1::Integer)..] (ed^..buffers.traverse.to show)-      extText = intercalate "\n" $ show <$> ed^.exts.to M.toList----- | This allows polymorphic lenses over anything that has access to an Editor context-class HasEditor a where-  editor :: Lens' a Editor---- | A lens over the map of available buffers-buffers :: HasEditor e => Lens' e (IntMap Buffer)-buffers = editor.buffers'---- | A lens over the exiting status of the editor-exiting :: HasEditor e => Lens' e Bool-exiting = editor.exiting'--instance HasEditor Editor where-  editor = lens id (flip const)--instance HasExts Editor where-  exts = extState'--instance Default Editor where-  def =-    Editor-    { _extState'=def-    , _buffers'=empty-    , _exiting'=False-    }
src/Rasa/Internal/Events.hs view
@@ -1,12 +1,8 @@ {-# language ExistentialQuantification #-} module Rasa.Internal.Events-  ( Init(..)-  , AfterInit(..)-  , BeforeEvent(..)-  , BeforeRender(..)+  ( BeforeRender(..)   , OnRender(..)   , AfterRender(..)-  , Exit(..)   , BufAdded(..)   , Keypress(..)   , Mod(..)@@ -14,20 +10,10 @@   ) where  import Data.Dynamic-import Rasa.Internal.Editor import Rasa.Internal.Range+import Rasa.Internal.Buffer import qualified Yi.Rope as Y --- | This event is dispatched exactly once when the editor starts up.-data Init = Init deriving (Show, Eq, Typeable)---- | This event is dispatched exactly once when the editor starts up after onInit has occurred.-data AfterInit = AfterInit deriving (Show, Eq, Typeable)---- | This event is dispatched immediately before dispatching any events from--- asyncronous event listeners (like 'Keypress's)-data BeforeEvent = BeforeEvent deriving (Show, Eq, Typeable)- -- | This event is dispatched immediately before dispatching -- the 'OnRender' event. data BeforeRender = BeforeRender deriving (Show, Eq, Typeable)@@ -37,10 +23,6 @@  -- | This event is dispatched immediately after dispatching 'OnRender'. data AfterRender = AfterRender deriving (Show, Eq, Typeable)---- | This event is dispatched before exiting the editor, listen for this to do--- any clean-up (saving files, etc.)-data Exit = Exit deriving (Show, Eq, Typeable)  -- | This event is dispatched after adding a new buffer. The contained BufRef refers to the new buffer. data BufAdded = BufAdded BufRef deriving (Show, Eq, Typeable)
− src/Rasa/Internal/Extensions.hs 
@@ -1,63 +0,0 @@-{-# language ExistentialQuantification, ScopedTypeVariables #-}-module Rasa.Internal.Extensions-  ( Ext(..)-  , ExtMap-  , HasExts(..)-  , HasExtMonad(..)-  , ext-  ) where--import Control.Lens--import Data.Default-import Data.Map-import Data.Dynamic-import Data.Maybe-import Unsafe.Coerce---- | A wrapper around an extension of any type so it can be stored in an 'ExtMap'-data Ext = forall a. Show a => Ext a-instance Show Ext where-  show (Ext a) = show a---- | A map of extension types to their current value.-type ExtMap = Map TypeRep Ext---- | Members of this class have access to editor extensions.-class HasExts s where-  -- | This lens focuses the Extensions States-  exts :: Lens' s (Map TypeRep Ext)---- | 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 'Data.Default.Default' instance (when getting) if--- nothing has yet been stored.--ext-  :: forall a e.-    (Show a, Typeable a, Default a, HasExts e)-  => Lens' e a-ext = lens getter setter-  where-    getter s =-      fromMaybe def $ s ^.exts . at (typeRep (Proxy :: Proxy a)) .-      mapping coerce-    setter s new =-      set-        (exts . at (typeRep (Proxy :: Proxy a)) . mapping coerce)-        (Just new)-        s-    coerce = iso (\(Ext x) -> unsafeCoerce x) Ext--class (Typeable m, Monad m) => HasExtMonad m where-  -- | Retrieve some extension state-  getExt :: (Typeable ext, Show ext, Default ext) => m ext--  -- | Set some extension state-  setExt :: (Typeable ext, Show ext, Default ext) => ext -> m ()--  -- | Set some extension state-  overExt :: (Typeable ext, Show ext, Default ext) => (ext -> ext) -> m ()-  overExt f = getExt >>= setExt . f
− src/Rasa/Internal/Interpreters.hs 
@@ -1,176 +0,0 @@-{-# language-    TemplateHaskell-#-}--module Rasa.Internal.Interpreters-  ( runAction-  , evalAction-  , execAction-  , bootstrapAction-  , mkActionState--  , runBufAction-  ) where--import Rasa.Internal.ActionMonads-import Rasa.Internal.Buffer-import Rasa.Internal.Editor-import Rasa.Internal.Events hiding (Exit)-import Rasa.Internal.Extensions-import Rasa.Internal.Listeners-import Rasa.Internal.Range--import Control.Monad.Free-import Control.Monad.State-import Control.Lens-import Data.Default-import Data.Maybe-import qualified Data.IntMap as IM--import Pipes hiding (Proxy, next)-import Pipes.Concurrent hiding (Buffer)---- | This contains all data representing the editor's state. It acts as the state object for an 'Action-data ActionState = ActionState-  { _ed :: Editor-  , _nextBufId :: Int-  , _actionQueue :: Output (Action ())-  }-makeLenses ''ActionState--instance Show ActionState where-  show as = show (_ed as)--mkActionState :: Output (Action ()) -> ActionState-mkActionState out = ActionState-    { _ed=def-    , _nextBufId=0-    , _actionQueue=out-    }--instance HasEditor ActionState where-  editor = ed--instance HasExts ActionState where-  exts = ed.exts---- | Runs an Action into an IO-runAction :: ActionState -> Action a -> IO (a, ActionState)-runAction actionState (Action actionF) = flip runStateT actionState $ actionInterpreter actionF---- | Evals an Action into an IO-evalAction :: ActionState -> Action a -> IO a-evalAction actionState action = fst <$> runAction actionState action---- | Execs an Action into an IO-execAction :: ActionState -> Action a -> IO ActionState-execAction actionState action = snd <$> runAction actionState action---- | Spawn the channels necessary to run action and do so.-bootstrapAction :: Action a -> IO a-bootstrapAction action = do-    (output, _) <- spawn unbounded-    evalAction (mkActionState output) action---- | Interpret the Free Monad; in this case it interprets it down to an IO-actionInterpreter :: Free ActionF r -> StateT ActionState IO r-actionInterpreter (Free actionF) =-  case actionF of-    (LiftIO ioNext) ->-      liftIO ioNext >>= actionInterpreter--    (BufferDo bufRefs bufAct toNext) -> do-      results <- forM bufRefs $ \(BufRef bInd) ->-        use (buffers.at bInd) >>= traverse (handleBuf bInd)-      actionInterpreter . toNext $ catMaybes results-        where handleBuf bIndex buf = do-                let Action act = runBufAction bufAct buf-                (res, newBuffer) <- actionInterpreter act-                buffers.at bIndex ?= newBuffer-                return res--    (DispatchActionAsync asyncActionIO next) -> do-      asyncQueue <- use actionQueue-      let effect = (liftIO asyncActionIO >>= yield) >-> toOutput asyncQueue-      liftIO . void . forkIO $ runEffect effect >> performGC-      actionInterpreter next--    (AsyncActionProvider dispatcherToIO next) -> do-      asyncQueue <- use actionQueue-      let dispatcher action =-            let effect = yield action >-> toOutput asyncQueue-             in void . forkIO $ runEffect effect >> performGC-      liftIO . void . forkIO $ dispatcherToIO dispatcher-      actionInterpreter next--    (AddBuffer txt toNext) -> do-      bufId <- nextBufId <+= 1-      let bufRef = BufRef bufId-      buffers.at bufId ?= mkBuffer txt bufRef-      let Action dBufAdded = dispatchBufAdded (BufAdded bufRef)-      actionInterpreter (dBufAdded >> toNext bufRef)--    (GetBufRefs toNext) ->-      use (buffers.to IM.keys) >>= actionInterpreter . toNext . fmap BufRef--    (GetExt toNext) ->-      use ext >>= actionInterpreter . toNext--    (SetExt new next) -> do-      ext .= new-      actionInterpreter next--    (GetEditor toNext) ->-      use ed >>= actionInterpreter . toNext--    (GetBuffer (BufRef bufInd) toNext) ->-      use (buffers.at bufInd) >>= actionInterpreter . toNext--    (Exit next) -> do-      exiting .= True-      actionInterpreter next--    (ShouldExit toNext) -> do-      ex <- use exiting-      actionInterpreter (toNext ex)--actionInterpreter (Pure res) = return res---- | This lifts up a bufAction into an Action which performs the 'BufAction'--- over the referenced buffer and returns the result (if the buffer existed)-runBufAction :: BufAction a -> Buffer -> Action (a, Buffer)-runBufAction (BufAction bufActF) buf = flip runStateT buf $ bufActionInterpreter bufActF---- | Interpret the Free Monad; in this case it interprets it down to an Action.-bufActionInterpreter :: Free BufActionF r -> StateT Buffer Action r-bufActionInterpreter (Free bufActionF) =-  case bufActionF of-    (GetText nextF) -> use text >>= bufActionInterpreter . nextF--    (SetText newText next) -> do-      text .= newText-      bufActionInterpreter next--    (GetBufRef toNext) -> do-      bref <- use ref-      bufActionInterpreter $ toNext bref---    (SetRange rng newText next) -> do-      text.range rng .= newText-      let (BufAction dispatchChange) = dispatchBufTextChanged $ BufTextChanged rng newText-      bufActionInterpreter (dispatchChange >> next)--    (LiftAction act toNext) -> lift act >>= bufActionInterpreter . toNext--    (GetBufExt extToNext) ->-      use ext >>= bufActionInterpreter . extToNext--    (SetBufExt new next) -> do-      ext .= new-      bufActionInterpreter next--    (BufLiftIO ioNext) ->-      liftIO ioNext >>= bufActionInterpreter--bufActionInterpreter (Pure res) = return res
src/Rasa/Internal/Listeners.hs view
@@ -6,33 +6,10 @@ #-}  module Rasa.Internal.Listeners-  ( dispatchEvent-  , addListener-  , addListener_-  , removeListener--  , dispatchBufEvent-  , addBufListener-  , addBufListener_-  , removeBufListener--  , Dispatcher-  , ListenerId--  , onInit-  , dispatchInit--  , afterInit-  , dispatchAfterInit--  , beforeEveryRender+  ( beforeEveryRender   , beforeEveryRender_   , dispatchBeforeRender -  , beforeEveryEvent-  , beforeEveryEvent_-  , dispatchBeforeEvent-   , onEveryRender   , onEveryRender_   , dispatchOnRender@@ -42,309 +19,62 @@   , dispatchAfterRender    , onExit-  , dispatchExit -  , onBufAdded-  , onBufAdded_-  , dispatchBufAdded-  , onEveryNewBuffer-  , onEveryNewBuffer_--  , onBufTextChanged-  , dispatchBufTextChanged-   , onKeypress   , dispatchKeypress--  , asyncEventProvider-  , dispatchEventAsync   ) where -import Rasa.Internal.Action-import Rasa.Internal.Actions-import Rasa.Internal.BufAction+import Eve import Rasa.Internal.Events-import Rasa.Internal.Extensions -import Control.Lens import Control.Monad-import Data.Default-import Data.Typeable-import Data.Maybe-import qualified Data.Map as M --- | A wrapper around event listeners so they can be stored in 'Listeners'.-data Listener where-  Listener :: (Typeable eventType, Typeable result, Monoid result, HasExtMonad m) => TypeRep -> ListenerId -> (eventType -> m result) -> Listener--instance Show Listener where-  show (Listener rep (ListenerId n _) _) = "<Listener #" ++ show n ++ ", " ++ show rep ++ ">"---- | An opaque reverence to a specific registered event-listener.--- A ListenerId is used only to remove listeners later with 'Rasa.Internal.Listeners.removeListener'.-data ListenerId =-  ListenerId Int TypeRep-  deriving Show--instance Eq ListenerId where-  ListenerId a _ == ListenerId b _ = a == b---- | A map of Event types to a list of listeners for that event-type Listeners = M.Map TypeRep [Listener]---- | Store the listeners in extensions-data LocalListeners =-  LocalListeners Int Listeners-  deriving Show--instance Default LocalListeners where-  def = LocalListeners 0 M.empty---- | This extracts all event listeners from a map of listeners which match the type of the provided event.-matchingListeners :: forall eventType result m. (Typeable eventType, Typeable result, HasExtMonad m) => Listeners -> [eventType -> m result]-matchingListeners listeners = catMaybes $ (getListener :: Listener -> Maybe (eventType -> m result)) <$> (listeners^.at (typeRep (Proxy :: Proxy eventType))._Just)---- | Extract the listener function from eventType listener-getListener :: Typeable expected => Listener -> Maybe expected-getListener (Listener _ _ x) = cast x----- | Trigger an 'Action' on a 'Keypress'-onKeypress :: (Keypress -> Action result) -> Action ListenerId+-- | Trigger an 'App' on a 'Keypress'+onKeypress :: (Keypress -> App result) -> App ListenerId onKeypress actionF = addListener (void <$> actionF)  -- | Dispatch a 'Keypress' event.-dispatchKeypress :: Keypress -> Action ()+dispatchKeypress :: Keypress -> App () dispatchKeypress = dispatchEvent --- | 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.-onInit :: Action result -> Action ()-onInit action = void $ addListener (const (void action) :: Init -> Action ())---- | Dispatch the 'Init' action.-dispatchInit :: Action ()-dispatchInit = dispatchEvent Init--afterInit :: Action a -> Action ()-afterInit action = void $ addListener (const (void action) :: AfterInit -> Action ())---- | Dispatch the 'Init' action.-dispatchAfterInit :: Action ()-dispatchAfterInit = dispatchEvent AfterInit---- | Registers an action to be performed BEFORE each event phase.-beforeEveryEvent :: Action a -> Action ListenerId-beforeEveryEvent action = addListener (const (void action) :: BeforeEvent -> Action ())--beforeEveryEvent_ :: Action a -> Action ()-beforeEveryEvent_ = void . beforeEveryEvent---- | Dispatch the 'BeforeEvent' action.-dispatchBeforeEvent :: Action ()-dispatchBeforeEvent = dispatchEvent BeforeEvent- -- | 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 ListenerId-beforeEveryRender action = addListener (const (void action) :: BeforeRender -> Action ())+beforeEveryRender :: App a -> App ListenerId+beforeEveryRender action = addListener (const (void action) :: BeforeRender -> App ()) -beforeEveryRender_ :: Action a -> Action ()+beforeEveryRender_ :: App a -> App () beforeEveryRender_ = void . beforeEveryRender  -- | Dispatch the 'BeforeRender' action.-dispatchBeforeRender :: Action ()+dispatchBeforeRender :: App () dispatchBeforeRender = dispatchEvent BeforeRender  -- | 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 ListenerId-onEveryRender action = addListener (const $ void action :: OnRender -> Action ())+onEveryRender :: App a -> App ListenerId+onEveryRender action = addListener (const $ void action :: OnRender -> App ()) -onEveryRender_ :: Action a -> Action ()+onEveryRender_ :: App a -> App () onEveryRender_ = void . onEveryRender  -- | Dispatch the 'OnRender' action.-dispatchOnRender :: Action ()+dispatchOnRender :: App () dispatchOnRender = dispatchEvent OnRender  -- | 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 ListenerId-afterEveryRender action = addListener (const $ void action :: AfterRender -> Action ())+afterEveryRender :: App a -> App ListenerId+afterEveryRender action = addListener (const $ void action :: AfterRender -> App ()) -afterEveryRender_ :: Action a -> Action ()+afterEveryRender_ :: App a -> App () afterEveryRender_ = void . afterEveryRender  -- | Dispatch the 'AfterRender' action.-dispatchAfterRender :: Action ()+dispatchAfterRender :: App () dispatchAfterRender = dispatchEvent AfterRender---- | 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.--onExit :: Action a -> Action ()-onExit action = void $ addListener (const $ void action :: Exit -> Action ())---- | Dispatch the 'Exit' action.-dispatchExit :: Action ()-dispatchExit = dispatchEvent Exit---- | 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.-onBufAdded :: (BufAdded -> Action result) -> Action ListenerId-onBufAdded actionF = addListener (void . actionF)--onBufAdded_ :: (BufAdded -> Action result) -> Action ()-onBufAdded_ = void . onBufAdded---- | Run the given 'BufAction' over all new buffers-onEveryNewBuffer :: BufAction a -> Action ListenerId-onEveryNewBuffer bufAction = onBufAdded $-  \(BufAdded br) -> bufDo_ br bufAction--onEveryNewBuffer_ :: BufAction a -> Action ()-onEveryNewBuffer_ = void . onEveryNewBuffer---- | Dispatch the 'BufAdded' action.-dispatchBufAdded :: BufAdded -> Action ()-dispatchBufAdded = dispatchEvent---- | 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.-onBufTextChanged :: (BufTextChanged -> BufAction result) -> BufAction ListenerId-onBufTextChanged bufActionF = addBufListener (void . bufActionF)---- | Dispatch the 'BufBufTextChanged' action.-dispatchBufTextChanged :: BufTextChanged -> BufAction ()-dispatchBufTextChanged = dispatchBufEvent---- | 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.-type Dispatcher = forall event. Typeable event => event -> IO ()---- | 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-asyncEventProvider :: (Dispatcher -> IO ()) -> Action ()-asyncEventProvider asyncEventProv =-  asyncActionProvider $ eventsToActions asyncEventProv-    where-      eventsToActions :: (Dispatcher -> IO ()) -> (Action () -> IO ()) -> IO ()-      eventsToActions aEventProv dispatcher = aEventProv (dispatcher . dispatchEvent)----- | This function takes an IO which results in some Event, it runs the IO--- asynchronously and dispatches the event-dispatchEventAsync :: Typeable event => IO event -> Action ()-dispatchEventAsync ioEvent = dispatchActionAsync $ dispatchEvent <$> ioEvent---- | Event dispatcher generic over its monad-dispatchEventG :: forall m result eventType. (Monoid result, Typeable eventType, Typeable result, HasExtMonad m) => eventType -> m result-dispatchEventG evt = do-      LocalListeners _ listeners <- getExt-      results <- traverse ($ evt) (matchingListeners listeners :: [eventType -> m result])-      return (mconcat results :: result)---- | addListener which is generic over its monad-addListenerG :: forall result eventType m. (Typeable eventType, Typeable result, Monoid result, HasExtMonad m) => (eventType -> m result) -> m ListenerId-addListenerG lFunc = do-  LocalListeners nextListenerId listeners  <- getExt-  let (listener, listenerId, eventType) = mkListener nextListenerId lFunc-      newListeners = M.insertWith mappend eventType [listener] listeners-  setExt $ LocalListeners (nextListenerId + 1) newListeners-  return listenerId-    where-      mkListener :: forall event r. (Typeable event, Typeable r, Monoid r) => Int -> (event -> m r) -> (Listener, ListenerId, TypeRep)-      mkListener n listenerFunc =-        let list = Listener (typeOf listenerFunc) listId listenerFunc-            listId = ListenerId n (typeRep (Proxy :: Proxy event))-            prox = typeRep (Proxy :: Proxy event)-          in (list, listId, prox)---- | removeListener which is generic over its monad-removeListenerG :: HasExtMonad m => ListenerId -> m ()-removeListenerG listenerId@(ListenerId _ eventType) =-  overExt remover-    where-      remover (LocalListeners nextListenerId listeners) =-        let newListeners = listeners & at eventType._Just %~ filter (notMatch listenerId)-         in LocalListeners nextListenerId newListeners-      notMatch idA (Listener _ idB _) = idA /= idB---- | 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).-dispatchEvent :: forall result eventType. (Monoid result, Typeable eventType, Typeable result) => eventType -> Action result-dispatchEvent = dispatchEventG---- | 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 ListenerId-addListener = addListenerG--addListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> Action result) -> Action ()-addListener_ = void . addListener---- | Removes the listener represented by the given ListenerId.-removeListener :: ListenerId -> Action ()-removeListener = removeListenerG---- | Dispatches an event of any type to the BufAction's buffer.--- See 'dispatchEvent'-dispatchBufEvent :: (Monoid result, Typeable eventType, Typeable result) => (eventType -> BufAction result)-dispatchBufEvent = dispatchEventG---- | Adds a listener to the BufAction's buffer.--- See 'addListener'-addBufListener :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ListenerId-addBufListener = addListenerG--addBufListener_ :: (Typeable eventType, Typeable result, Monoid result) => (eventType -> BufAction result) -> BufAction ()-addBufListener_ = void . addBufListener---- | Removes a listener from the BufAction's buffer.--- See 'removeListener'-removeBufListener :: ListenerId -> BufAction ()-removeBufListener = removeListenerG
src/Rasa/Internal/Styles.hs view
@@ -13,9 +13,10 @@   , getStyles   ) where +import Eve import Rasa.Internal.Range-import Rasa.Internal.BufAction-import Rasa.Internal.Listeners+import Rasa.Internal.Buffer+import Rasa.Internal.BufActions  import Control.Applicative import Data.Default
src/Rasa/Internal/Utility.hs view
@@ -11,11 +11,10 @@   , styleText   ) where -import Rasa.Internal.ActionMonads-import Rasa.Internal.Editor-import Rasa.Internal.Actions+import Eve import Rasa.Internal.Styles-import Rasa.Internal.BufAction+import Rasa.Internal.BufActions+import Rasa.Internal.Buffer import Rasa.Internal.Range  import Control.Lens@@ -42,7 +41,7 @@  -- | Represents how to render an entity class Renderable r where-  render :: Width -> Height -> ScrollPos -> r -> Action (Maybe RenderInfo)+  render :: Width -> Height -> ScrollPos -> r -> App (Maybe RenderInfo)  instance Renderable r => Renderable (Maybe r) where   render width height scrollPos (Just r) = render width height scrollPos r
− src/Rasa/Testing.hs 
@@ -1,21 +0,0 @@-module Rasa.Testing (-  testBufAction-  ) where--import Rasa.Internal.Interpreters-import Rasa.Internal.Action-import Rasa.Internal.Actions-import Rasa.Internal.BufAction--import Test.Hspec-import Control.Monad-import qualified Yi.Rope as Y--testBufAction :: (Show a, Eq a) => String -> Y.YiString -> a -> BufAction a -> Spec-testBufAction description txt expectation bufAction = join . runIO $-  bootstrapAction $ do-    ref <- addBuffer txt-    mResult <- bufDo ref bufAction-    case mResult of-      Nothing -> error "(Err #75b72c) Buffer not found by BufRef"-      Just res -> return $ it description (res `shouldBe` expectation)
− test/Rasa/Internal/BufActionSpec.hs 
@@ -1,6 +0,0 @@-module Rasa.Internal.BufActionSpec where--import Test.Hspec--spec :: Spec-spec = return ()
test/Rasa/Internal/BufActionsSpec.hs view
@@ -2,7 +2,7 @@  import Test.Hspec -import Rasa.Testing+import Eve.Testing import Rasa.Internal.Range import Rasa.Internal.BufActions import qualified Yi.Rope as Y@@ -11,7 +11,7 @@ sampleText = "Testing line one\nshort line\n  a  long  line   "  spec :: Spec-spec =-  describe "getLineRange" $-    testBufAction "should get the range of a line" sampleText-      (Just $ Range (Coord 1 0) (Coord 1 11)) (getLineRange 1)+spec = return ()+  -- describe "getLineRange" $+    -- it "should get the range of a line" sampleText+      -- (Just $ Range (Coord 1 0) (Coord 1 11)) (getLineRange 1)
− test/Rasa/Internal/EditorSpec.hs 
@@ -1,6 +0,0 @@-module Rasa.Internal.EditorSpec where--import Test.Hspec--spec :: Spec-spec = return ()
− test/Rasa/Internal/ExtensionsSpec.hs 
@@ -1,6 +0,0 @@-module Rasa.Internal.ExtensionsSpec where--import Test.Hspec--spec :: Spec-spec = return ()