diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2016 Chris Penner + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,115 @@ +Rasa (Rah-zah) +============== + +[![Join the chat at https://gitter.im/rasa-editor/Lobby](https://badges.gitter.im/rasa-editor/Lobby.svg)](https://gitter.im/rasa-editor/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) + +Embarrassingly modular customizable text editor built in Haskell. + +What people are saying +---------------------- + +> Excessively Modular! - some bald guy + +> I'm glad I'm unemployed so I have time to configure it! - my mate Steve + +> You should go outside one of these days. - Mother + +Installation +------------ + +At the moment you must build Rasa from source; + +1. Install [stack](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html) +2. Clone this repo and `cd` into the directory +3. Run `stack build && stack exec rasa` (you may want to alias this to `rasa`) + +Getting started +--------------- + +Here's a great guide on building a copy-paste extension from scratch! I definitely +recommend checking it out! + +### [Building Your First Extension](docs/Building-An-Extension.md) + +\^ That guide will walk you through installation and getting running! Once +you're running rasa you can experiment with creating your own adaptations. You +should customize your keymap to add a few mappings you like. It's a short step +from here to developing your own extensions. `Action`s like you'd use in an +extension can be registered to hooks in your `Main.hs`. You can build and +experiment with entire extensions in your config file and extract them as a +package when you're ready, kind of like a vimrc file. Again, just read the +extension guide, it covers what you need to know! + +If you have any issues (and I'm sure there'll be a few; it's a new project!) +please report them [here](https://github.com/ChrisPenner/rasa/issues). + + +Core Principles +--------------- + +Rasa is meant to be about as modular as an editor can be. The goal is for as +much code as possible to be extracted into composable extensions. If the core +editing facilities can't be implemented as extensions, then the extension +interface isn't powerful enough. I've taken this to its extreme, for instance +the following features are implemented as rasa extensions that anyone in the +community could have written. + +- Loading and saving files +- Key bindings +- Multiple cursors +- Rendering the editor to the terminal + +This approach has some unique pros and cons: + +### Pros + +- Implementing most core functionality as extensions ensures a powerful and + elegant extension interface. +- Flexibility; don't like the default cursor implementation? Write your own! +- Adaptability; the core of Rasa is miniscule, you can mix and match + extensions to build any editor you want. + + +### Cons + +- Module cross-dependencies makes the community infrastructure more fragile; + We'll likely have to develop a solution to this as a community as time + goes on. +- Fragmentation; Not having a single implementation for a given feature means + extensions that depend on a feature have to pick a specific implementation + to augment. Over time data-structures and types will be standardized into + Rasa's core to help alleviate this. + + +Core Features +------------- + +As stated above, the editor itself focuses primarily on easy extensibility, so it doesn't have a lot of editing +features built in, instead it focuses on standardizing a good extension API. +We focus on creating a simple system so people can pick it up quickly. + +Here are some features of that API: + +### Event Hook System + +All actions in the editor are triggered via an event/listener system. +Extensions may subscribe to events from the editor, or from another extension +and perform an action in response. The Event which triggered the hook is +available as an argument). Extensions may also dispatch any kind of event at +any time which other extensions may listen for. + +### Actions/BufActions + +Extensions define things that they'd like to do using a powerful set of +functions which they can embed in an `Action`. Within an action an extension +may perform IO, access the available buffers, store and access extension state, +and edit text. + +Contributing +============ + +Things are moving quickly, but I'd love a hand! You can get a rough idea of +where you can help out at the +[Roadmap](https://github.com/ChrisPenner/rasa/issues/2), feel free to leave a +comment there asking any questions, I'm often free to chat, join our [gitter +here](https://gitter.im/rasa-editor/Lobby)! diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/rasa.cabal b/rasa.cabal new file mode 100644 --- /dev/null +++ b/rasa.cabal @@ -0,0 +1,81 @@ +name: rasa +version: 0.1.0.0 +synopsis: A modular text editor +homepage: https://github.com/ChrisPenner/rasa#readme +license: MIT +license-file: LICENSE +author: Chris Penner +maintainer: christopher.penner@gmail.com +copyright: 2016 Chris Penner +category: Text Editor, Executable +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 +description: A modular text editor + This is only a snippet, see the project's . + . + Rasa is a text editor project with a few interesting goals. For better or worse it attempts + to be as modular as possible. This means that most functionality which would typically be considered to be 'core' in other editors + is implemented as extensions in Rasa. + This approach comes with its own share of pros and cons, for instance: + . + /Pros/ + . + * Implementing most core functionality as extensions ensures a powerful and elegant extension interface. + * Flexibility; don't like the default cursor implementation? Write your own! + * Adaptability; the core of Rasa is miniscule, you can mix and match extensions to build any editor you want. + . + /Cons/ + . + * Module cross-dependencies makes the community infrastructure more fragile; We'll likely have to develop a solution to this as a community as time goes on. + * Fragmentation; Not having a single implementation for a given feature means extensions that depend on a feature have to pick a specific implementation to augment. Over time data-structures and types will be standardized into Rasa's core to help alleviate this. + . + While highly experimental, I've found the current API to be quite expressive and adaptable; + for instance I was able to implement the notion of multiple cursors using the extension API in less than a day. I hope to keep the learning curve low as development continues. + . + /Getting Started/ + . + First clone the + and try running the example-config included there. + Once you get it running (see the ) then you + can customize your keymap to add a few mappings you like. + Then I'd check out the + . + It goes in depth into everything you'd want to know! + . + If you have any issues (and I'm sure there'll be a few; it's a new project!) please report them and we'll talk about it! + +library + hs-source-dirs: src + exposed-modules: + Rasa + + Rasa.Ext + + Rasa.Internal.Action + Rasa.Internal.Buffer + Rasa.Internal.Directive + Rasa.Internal.Editor + Rasa.Internal.Events + Rasa.Internal.Extensions + Rasa.Internal.Range + Rasa.Internal.Scheduler + Rasa.Internal.Text + + ghc-options: -Wall + build-depends: base >= 4.7 && < 5 + , async + , containers + , data-default + , lens + , mtl + , text + , text-lens + , transformers + , yi-rope + + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/ChrisPenner/rasa diff --git a/src/Rasa.hs b/src/Rasa.hs new file mode 100644 --- /dev/null +++ b/src/Rasa.hs @@ -0,0 +1,51 @@ +{-# language ExistentialQuantification, Rank2Types, ScopedTypeVariables #-} +module Rasa (rasa) where + +import Rasa.Internal.Editor +import Rasa.Internal.Action +import Rasa.Internal.Events +import Rasa.Internal.Scheduler + +import Control.Lens +import Control.Concurrent.Async +import Control.Monad +import Control.Monad.State +import Control.Monad.Reader +import Data.Default (def) +import Data.Foldable + +-- | The main function to run rasa. +-- +-- @rasa eventProviders extensions@ +-- +-- This should be imported by a user-config and called with extension event providers and extension event hooks as +-- arguments. e.g.: +-- +-- > rasa [slateEvent] $ do +-- > cursor +-- > vim +rasa :: [Action [Keypress]] -> Scheduler () -> IO () +rasa eventProviders scheduler = + evalAction def hooks $ do + dispatchEvent Init + eventLoop eventProviders + dispatchEvent Exit + where hooks = getHooks scheduler + +-- | This is the main event loop, it runs recursively forever until something +-- sets 'Rasa.Editor.exiting'. It runs the pre-event hooks, then listens for an +-- event from the event providers, then runs the post event hooks and repeats. +eventLoop :: [Action [Keypress]] -> Action () +eventLoop eventProviders = do + dispatchEvent BeforeRender + dispatchEvent OnRender + dispatchEvent AfterRender + dispatchEvent BeforeEvent + currentEditor <- get + hooks <- ask + -- This is a little weird, but I think it needs to be this way to execute providers in parallel + asyncEventProviders <- liftIO $ traverse (async.evalAction currentEditor hooks) eventProviders + (_, nextEvents) <- liftIO $ waitAny asyncEventProviders + traverse_ dispatchEvent nextEvents + isExiting <- use exiting + unless isExiting $ eventLoop eventProviders diff --git a/src/Rasa/Ext.hs b/src/Rasa/Ext.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Ext.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE Rank2Types, FlexibleContexts #-} + +---------------------------------------------------------------------------- +-- | +-- Module : Rasa.Ext +-- Copyright : (C) 2016 Chris Penner +-- License : MIT +-- Maintainer : Chris Penner +-- +-- 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. +-- +-- To react to events an extension defines a 'Scheduler' +-- which the user puts in their config file. The 'Scheduler' +-- defines listeners for events which the extension will react to. +-- See 'Scheduler' for more detailed information. +-- +-- 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 event to a file. +-- +-- > logger :: Scheduler () +-- > logger = do +-- > onInit $ liftIO $ writeFile "logs" "==Logs==\n" +-- > onEvent $ do +-- > evts <- use events +-- > mapM_ (liftIO . appendFile "logs" . (++ "\n") . show) evts +-- > onExit $ liftIO $ appendFile "logs" "==Done==" +---------------------------------------------------------------------------- + +module Rasa.Ext + ( + -- * Editor Actions + Action + , exit + , addBuffer + , addBufferThen + , nextBuf + , prevBuf + + -- * Buffer Actions + , BufAction + , bufDo + , focusDo + , overRange + , replaceRange + , deleteRange + , insertAt + , sizeOf + + -- * Persisting Extension State + -- | 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 TypeRep, they must define an + -- instance of Typeable, luckily GHC can derive this for you. + -- + -- 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' -> 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. In practice you won't + -- typically need to do this unless you're doing something complicated. + + , ext + , bufExt + + -- * Accessing/Editing Context + , Buffer + , text + -- | A lens over the buffer's 'Data.Text.Text'. Use within a 'BufAction' as + -- + -- > txt <- use text + + , exiting + -- | A lens over the current 'exit' status of the editor, allows an extension to + -- signal the editor to shutdown. If this is set the current events will finish processing, then the + -- + -- 'Rasa.Ext.Events.Exit' event will be dispatched, then the editor will exit. + -- Use within an 'Action' + -- + -- > exiting .= True + + -- * Events + , Keypress(..) + , Mod(..) + + -- * Dealing with events + , Scheduler + , Hooks + , Hook + , dispatchEvent + , eventListener + + -- * Built-in Event Hooks + , onInit + , beforeEvent + , beforeRender + , onRender + , afterRender + , onExit + + -- * Ranges + , Range(..) + , Coord(..) + , Offset(..) + , Span(..) + , combineSpans + , asCoord + , clampCoord + , clampRange + , range + , sizeOfR + , afterC + , beforeC + , moveRange + , moveRangeByN + , moveCursorByN + + -- * Useful Utilities + , asText + , asString + , asLines + , rope + , clamp + ) where + +import Rasa.Internal.Action +import Rasa.Internal.Directive +import Rasa.Internal.Editor +import Rasa.Internal.Events +import Rasa.Internal.Buffer +import Rasa.Internal.Text +import Rasa.Internal.Range +import Rasa.Internal.Scheduler diff --git a/src/Rasa/Internal/Action.hs b/src/Rasa/Internal/Action.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Action.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, ExistentialQuantification #-} + +module Rasa.Internal.Action where + +import Control.Monad.State +import Control.Monad.Reader +import Data.Dynamic +import Data.Map + +import Rasa.Internal.Buffer +import Rasa.Internal.Editor + +-- | This is a monad-transformer stack for performing actions against the editor. +-- You register Actions to be run in response to events using 'Rasa.Internal.Scheduler.eventListener' +-- +-- 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.Ext.Directive.bufDo' and 'Rasa.Internal.Ext.Directive.focusDo' +-- * Add\/Edit\/Focus buffers and a few other Editor-level things, see the 'Rasa.Internal.Ext.Directive' module. + +newtype Action a = Action + { runAct :: StateT Editor (ReaderT Hooks IO) a + } deriving (Functor, Applicative, Monad, MonadState Editor, MonadReader Hooks, MonadIO) + +-- | Unwrap and execute an Action (returning the editor state) +execAction :: Editor -> Hooks -> Action () -> IO Editor +execAction editor hooks action = flip runReaderT hooks $ execStateT (runAct action) editor + +-- | Unwrap and evaluate an Action (returning the value) +evalAction :: Editor -> Hooks -> Action a ->IO a +evalAction editor hooks action = flip runReaderT hooks $ evalStateT (runAct action) editor + +-- | This is a monad-transformer stack for performing actions on a specific buffer. +-- You register BufActions to be run by embedding them in a scheduled 'Action' via 'bufferDo' or 'focusDo' +-- +-- Within a BufAction you can: +-- +-- * Use liftIO for IO +-- * Access/edit buffer extensions; see 'bufExt' +-- * Embed and sequence any 'BufAction's from other extensions +-- * Access/Edit the buffer's 'text' +-- +newtype BufAction a = BufAction + { getBufAction::StateT Buffer (ReaderT Hooks IO) a + } deriving (Functor, Applicative, Monad, MonadState Buffer, MonadReader Hooks, MonadIO) + + +-- | A wrapper around event listeners so they can be stored in 'Hooks'. +data Hook = forall a. Hook a + +-- | A map of Event types to a list of listeners for that event +type Hooks = Map TypeRep [Hook] diff --git a/src/Rasa/Internal/Buffer.hs b/src/Rasa/Internal/Buffer.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Buffer.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE Rank2Types, TemplateHaskell, OverloadedStrings, ExistentialQuantification, ScopedTypeVariables, + GeneralizedNewtypeDeriving, FlexibleInstances, + StandaloneDeriving #-} + +module Rasa.Internal.Buffer + ( Buffer + , Ext(..) + , bufExts + -- | A lens over the extensions stored for a buffer + , text + , rope + -- | A lens over the text stored in a buffer (as a 'Y.YiString') + , newBuffer + ) where + +import Rasa.Internal.Text +import Rasa.Internal.Extensions + +import qualified Data.Text as T +import qualified Yi.Rope as Y +import Control.Lens hiding (matching) +import Data.Map + +-- | A buffer, holds the text in the buffer and any extension states that are set on the buffer. +-- A buffer is the State of the 'Rasa.Internal.Action.BufAction' monad transformer stack, +-- so the type may be useful in defining lenses over your extension states. +data Buffer = Buffer + { _rope :: Y.YiString + , _bufExts :: ExtMap + } + +makeLenses ''Buffer + +-- | A lens into the text of the given buffer. Use within a BufAction. +text :: Lens' Buffer T.Text +text = rope.asText + +instance Show Buffer where + show b = "\n" + +-- | Creates a new buffer from the givven text. +newBuffer :: T.Text -> Buffer +newBuffer txt = + Buffer + { _rope = Y.fromText txt + , _bufExts = empty + } diff --git a/src/Rasa/Internal/Directive.hs b/src/Rasa/Internal/Directive.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Directive.hs @@ -0,0 +1,91 @@ +{-# language Rank2Types, OverloadedStrings #-} +module Rasa.Internal.Directive + ( + -- * Performing Actions on Buffers + bufDo + , focusDo + + -- * Editor Actions + , exit + , addBuffer + , addBufferThen + , nextBuf + , prevBuf + + -- * Buffer Actions + , overRange + , replaceRange + , deleteRange + , insertAt + , sizeOf + ) where + +import Rasa.Internal.Text +import Rasa.Internal.Editor +import Rasa.Internal.Action +import Rasa.Internal.Range +import Rasa.Internal.Buffer as B + +import Control.Lens +import qualified Data.Text as T + +-- | This lifts a 'Rasa.Action.BufAction' to an 'Rasa.Action.Action' which +-- performs the 'Rasa.Action.BufAction' on the focused buffer. + +focusDo :: BufAction a -> Action a +focusDo = Action . zoom focusedBuf . getBufAction + +-- | 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 via 'mappend' + +bufDo :: Monoid a => BufAction a -> Action a +bufDo = Action . zoom (buffers . traverse) . getBufAction + +-- | This adds a new buffer with the given text. + +addBuffer :: T.Text -> Action () +addBuffer txt = buffers <>= [newBuffer txt] + +-- | This adds a new buffer with the given text then performs the given +-- 'Rasa.Action.BufAction' agains that buffer. +addBufferThen :: T.Text -> BufAction a -> Action a +addBufferThen txt act = do + buffers <>= [newBuffer txt] + fmap (!! 0) . Action . zoom (buffers._last) . fmap (:[]) . getBufAction $ act + +-- | This signals to the editor that you'd like to shutdown. The current events +-- will finish processing, then the 'Rasa.Ext.Scheduler.onExit' hook will run, +-- then the editor will exit. + +exit :: Action () +exit = exiting .= True + +-- | Switches focus to the next buffer +nextBuf :: Action () +nextBuf = do + numBuffers <- use (buffers.to length) + focused %= (`mod` numBuffers) . (+1) + +-- | Switches focus to the previous buffer +prevBuf :: Action () +prevBuf = do + numBuffers <- use (buffers.to length) + focused %= (`mod` numBuffers) . subtract 1 + +-- | Deletes the text in the given range from the buffer. +deleteRange :: Range -> BufAction () +deleteRange r = range r.asText .= "" + +-- | Replaces the text in the given range from the buffer. +replaceRange :: Range -> T.Text -> BufAction () +replaceRange r txt = range r.asText .= txt + +-- | Inserts text into the buffer at the given Coord. +insertAt :: Coord -> T.Text -> BufAction () +insertAt c txt = range (Range c c).asText .= txt + +-- | Runs the given function over the text in the range, replacing it with the results. +overRange :: Range -> (T.Text -> T.Text) -> BufAction () +overRange r f = range r.asText %= f + diff --git a/src/Rasa/Internal/Editor.hs b/src/Rasa/Internal/Editor.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Editor.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE TemplateHaskell, Rank2Types, + ExistentialQuantification, ScopedTypeVariables, + OverloadedStrings + #-} + +module Rasa.Internal.Editor + ( + -- * Accessing/Storing state + Editor + + , focused +-- | 'focused' is the index of the currently selected buffer (this will likely change) + + , buffers + +-- |'buffers' is a lens into all buffers. + + , exiting + +-- | 'exiting' Whether the editor is in the process of exiting. Can be set inside an 'Rasa.Internal.Action.Action': +-- +-- > exiting .= True + + , ext + , allBufExt + , bufExt + , focusedBuf + , range + ) where + +import Rasa.Internal.Buffer +import Rasa.Internal.Extensions +import Rasa.Internal.Range + +import Unsafe.Coerce +import Data.Dynamic +import Data.Default +import Data.Maybe +import Control.Lens +import qualified Yi.Rope as Y + +-- | This is the primary state of the editor. +data Editor = Editor + { _buffers :: [Buffer] + , _focused :: Int + , _exiting :: Bool + , _extState :: ExtMap + } +makeLenses ''Editor + +instance Show Editor where + show editor = + "Buffers==============\n" ++ show (editor^.buffers) ++ "\n\n" + ++ "Editor Extensions==============\n" ++ show (editor^.extState) ++ "\n\n" + ++ "---\n\n" + + +instance Default Editor where + def = + Editor + { _extState = def + , _buffers=fmap newBuffer [ "Buffer 0\nHey! How's it going over there?\nI'm having just a splended time!\nAnother line for you sir?" + , "Buffer 1\nHey! How's it going over there?\nI'm having just a splended time!\nAnother line for you sir?" ] + , _focused=0 + , _exiting=False + } + +-- | A lens over the extensions of all buffers. +-- This is useful for setting defaults or altering extension state across all buffers. +allBufExt + :: forall a. + (Show a, Typeable a) + => Traversal' Editor (Maybe a) +allBufExt = + buffers . traverse . bufExts . at (typeRep (Proxy :: Proxy a)) . mapping coerce + where + coerce = iso (\(Ext x) -> unsafeCoerce x) Ext + +-- | 'bufExt' is a lens which will focus a given extension's state within a +-- buffer (within a 'Data.Action.BufAction'). The lens will automagically focus +-- the required extension by using type inference. 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. + +bufExt + :: forall a. + (Show a, Typeable a, Default a) + => Lens' Buffer a +bufExt = lens getter setter + where + getter buf = + fromMaybe def $ buf ^. bufExts . at (typeRep (Proxy :: Proxy a)) . + mapping coerce + setter buf new = + set + (bufExts . at (typeRep (Proxy :: Proxy a)) . mapping coerce) + (Just new) + buf + coerce = iso (\(Ext x) -> unsafeCoerce x) Ext + +-- | 'ext' 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. + (Show a, Typeable a, Default a) + => Lens' Editor a +ext = lens getter setter + where + getter editor = + fromMaybe def $ editor ^. extState . at (typeRep (Proxy :: Proxy a)) . + mapping coerce + setter editor new = + set + (extState . at (typeRep (Proxy :: Proxy a)) . mapping coerce) + (Just new) + editor + coerce = iso (\(Ext x) -> unsafeCoerce x) Ext + +-- | 'focusedBuf' is a lens which focuses the currently selected buffer. +focusedBuf :: Lens' Editor Buffer +focusedBuf = lens getter setter + where + getter editor = + let foc = editor ^. focused + in editor ^?! buffers . ix foc + setter editor new = + let foc = editor ^. focused + in editor & buffers . ix foc .~ new + +-- | A lens over text which is encompassed by a 'Range' +range :: Range -> Lens' Buffer Y.YiString +range (Range start end) = lens getter setter + where getter = view (rope . beforeC end . afterC start) + setter old new = old & rope . beforeC end . afterC start .~ new + diff --git a/src/Rasa/Internal/Events.hs b/src/Rasa/Internal/Events.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Events.hs @@ -0,0 +1,47 @@ +{-# language ExistentialQuantification #-} +module Rasa.Internal.Events where + +import Data.Dynamic + +-- | The Event type represents a common denominator for all actions that could +-- occur Event transmitters express events that have occured as a member of this +-- type. At the moment it's quite sparse, but it will expand as new types of +-- events are needed. + +-- | This event is dispatched exactly once when the editor starts up. +data Init = Init 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) + +-- | This event is dispatched when it's time for extensions to render to screen. +data OnRender = OnRender deriving (Show, Eq, Typeable) + +-- | 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 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. +data Keypress + = Keypress Char + [Mod] + | Esc + | BS + | Enter + deriving (Show, Eq, Typeable) + +-- | This represents each modifier key that could be pressed along with a key. +data Mod + = Ctrl + | Alt + | Shift + deriving (Show, Eq) diff --git a/src/Rasa/Internal/Extensions.hs b/src/Rasa/Internal/Extensions.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Extensions.hs @@ -0,0 +1,16 @@ +{-# language ExistentialQuantification, ScopedTypeVariables #-} +module Rasa.Internal.Extensions + ( Ext(..) + , ExtMap + ) where + +import Data.Map +import Data.Dynamic + +-- | 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 diff --git a/src/Rasa/Internal/Range.hs b/src/Rasa/Internal/Range.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Range.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE Rank2Types, OverloadedStrings, DeriveFunctor, ScopedTypeVariables #-} +module Rasa.Internal.Range + ( Coord(..) + , Offset(..) + , asCoord + , clampCoord + , clampRange + , Range(..) + , sizeOf + , sizeOfR + , moveRange + , moveRangeByN + , moveCursorByN + , moveCursor + , Span(..) + , combineSpans + , clamp + , beforeC + , afterC + ) where + +import Control.Lens +import Data.Maybe +import Data.Monoid +import Data.List +import Rasa.Internal.Text +import qualified Yi.Rope as Y + + +-- | This represents a range between two coordinates ('Coord') +data Range = + Range Coord Coord + deriving (Show, Eq) + +instance Ord Range where + Range start end <= Range start' end' + | end == end' = start <= start' + | otherwise = end <= end' + +-- | (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 +data Coord = + Coord Int + Int + deriving (Show, Eq) + +instance Ord Coord where + Coord a b <= Coord a' b' + | a < a' = True + | a > a' = False + | otherwise = b <= b' + +-- | An 'Offset' represents an exact position in a file as a number of characters from the start. +newtype Offset = + Offset Int + deriving (Show, Eq) + +-- | Moves a 'Range' by a given 'Coord' +-- It may be unintuitive, but for (Coord row col) a given range will be moved down by row and to the right by col. +moveRange :: Coord -> Range -> Range +moveRange amt (Range start end) = + Range (moveCursor amt start) (moveCursor amt end) + +-- | Moves a range forward by the given amount +moveRangeByN :: Int -> Range -> Range +moveRangeByN amt (Range start end) = + Range (moveCursorByN amt start) (moveCursorByN amt end) + +-- | Moves a 'Coord' forward by the given amount of columns +moveCursorByN :: Int -> Coord -> Coord +moveCursorByN amt (Coord row col) = Coord row (col + amt) + +-- | Adds the rows and columns of the given two 'Coord's. +moveCursor :: Coord -> Coord -> Coord +moveCursor (Coord row col) (Coord row' col') = Coord (row + row') (col + col') + +instance Num Coord where + Coord row col + Coord row' col' = Coord (row + row') (col + col') + Coord row col - Coord row' col' = Coord (row - row') (col - col') + Coord row col * Coord row' col' = Coord (row * row') (col * col') + abs (Coord row col) = Coord (abs row) (abs col) + fromInteger i = Coord 0 (fromInteger i) + signum (Coord row col) = Coord (signum row) (signum col) + +-- | Given the text you're operating over, creates an iso from an 'Offset' to a 'Coord'. +asCoord :: Y.YiString -> Iso' Offset Coord +asCoord txt = iso (toCoord txt) (toOffset txt) + +-- | Given the text you're operating over, converts a 'Coord' to an 'Offset'. +toOffset :: Y.YiString -> Coord -> Offset +toOffset txt (Coord row col) = Offset $ lenRows + col + where + lenRows = Y.length . Y.concat . take row . Y.lines' $ txt + +-- | Given the text you're operating over, converts an 'Offset' to a 'Coord'. +toCoord :: Y.YiString -> Offset -> Coord +toCoord txt (Offset offset) = Coord numRows numColumns + where + numRows = Y.countNewLines . Y.take offset $ txt + numColumns = (offset -) . Y.length . Y.concat . take numRows . Y.lines' $ txt + +-- | This will restrict a given 'Coord' to a valid one which lies within the given text. +clampCoord :: Y.YiString -> Coord -> Coord +clampCoord txt (Coord row col) = + Coord (clamp 0 maxRow row) (clamp 0 maxColumn col) + where + maxRow = Y.countNewLines txt + maxColumn = fromMaybe col (txt ^? to Y.lines' . ix row . to Y.length) + +-- | This will restrict a given 'Range' to a valid one which lies within the given text. +clampRange :: Y.YiString -> Range -> Range +clampRange txt (Range start end) = + Range (clampCoord txt start) (clampCoord txt end) + +-- | A span which maps a piece of Monoidal data over a range. +data Span a = Span + { _getRange :: Range + , _data :: a + } deriving (Show, Eq, Functor) + +-- | A Helper only used when combining many spans. +data Marker + = Start + | End + deriving (Show, Eq) + +type ID = Int +-- | Combines a list of spans containing some monoidal data into a list of offsets with +-- with the data that applies from each Offset forwards. +combineSpans + :: forall a. + Monoid a + => [Span a] -> [(Coord, a)] +combineSpans spans = combiner [] $ sortOn (view _3) (splitStartEnd idSpans) + where + idSpans :: [(ID, Span a)] + idSpans = zip [1 ..] spans + + splitStartEnd :: [(ID, Span a)] -> [(Marker, ID, Coord, a)] + splitStartEnd [] = [] + splitStartEnd ((i, Span (Range s e) d):rest) = + (Start, i, s, d) : (End, i, e, d) : splitStartEnd rest + + withoutId :: ID -> [(ID, a)] -> [(ID, a)] + withoutId i = filter ((/= i) . fst) + + combiner :: [(ID, a)] -> [(Marker, ID, Coord, a)] -> [(Coord, a)] + combiner _ [] = [] + combiner cur ((Start, i, crd, mData):rest) = + let dataSum = foldMap snd cur <> mData + newData = (i, mData) : cur + in (crd, dataSum) : combiner newData rest + combiner cur ((End, i, crd, _):rest) = + let dataSum = foldMap snd newData + newData = withoutId i cur + in (crd, dataSum) : combiner newData rest + +-- | @clamp min max val@ restricts val to be within min and max (inclusive) +clamp :: Int -> Int -> Int -> Int +clamp mn mx n + | n < mn = mn + | n > mx = mx + | otherwise = n + +-- | Returns the number of rows and columns that a 'Range' spans as a 'Coord' +sizeOfR :: Range -> Coord +sizeOfR (Range start end) = end - start + +-- | Returns the number of rows and columns that a chunk of text spans as a 'Coord' +sizeOf :: Y.YiString -> Coord +sizeOf txt = Coord (Y.countNewLines txt) (Y.length (txt ^. asLines . _last)) + +-- | A lens over text before a given 'Coord' +beforeC :: Coord -> Lens' Y.YiString Y.YiString +beforeC c@(Coord row col) = lens getter setter + where getter txt = + txt ^.. asLines . taking (row + 1) traverse + & _last %~ Y.take col + & Y.unlines + + setter old new = let suffix = old ^. afterC c + in new <> suffix + +-- | A lens over text after a given 'Coord' +afterC :: Coord -> Lens' Y.YiString Y.YiString +afterC c@(Coord row col) = lens getter setter + where getter txt = + txt ^.. asLines . dropping row traverse + & _head %~ Y.drop col + & Y.unlines + + setter old new = let prefix = old ^. beforeC c + in prefix <> new diff --git a/src/Rasa/Internal/Scheduler.hs b/src/Rasa/Internal/Scheduler.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Scheduler.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, + ExistentialQuantification, ScopedTypeVariables #-} + +module Rasa.Internal.Scheduler + ( Scheduler(..) + , Hook + , Hooks + , afterRender + , beforeEvent + , beforeRender + , dispatchEvent + , eventListener + , getHooks + , matchingHooks + , onExit + , onInit + , onRender + ) where + + +import Rasa.Internal.Action +import Rasa.Internal.Events + +import Control.Lens +import Control.Monad.Reader +import Control.Monad.State +import Data.Dynamic +import Data.Foldable +import Data.Map +import Unsafe.Coerce + +-- | The Scheduler is how you can register your extension's actions to run +-- at different points in the editor's event cycle. +-- +-- The event cycle proceeds as follows: +-- +-- @ +-- Init (Runs ONCE) +-- +-- -- The following loops until an exit is triggered: +-- BeforeEvent -> (any event) -> BeforeRender -> OnRender -> AfterRender +-- +-- Exit (Runs ONCE) +-- @ +-- +-- Each extension which wishes to perform actions exports a @'Scheduler' ()@ +-- which the user inserts in their config file. +newtype Scheduler a = Scheduler + { runSched :: State Hooks a + } deriving (Functor, Applicative, Monad, MonadState Hooks) + +-- | Use this to dispatch an event of any type, any hooks which are listening for this event will be triggered +-- with the provided event. Use this within an Action. +dispatchEvent :: Typeable a => a -> Action () +dispatchEvent evt = do + hooks <- ask + traverse_ ($ evt) (matchingHooks hooks) + +-- | This is a helper which extracts and coerces a hook from its wrapper back into the proper event handler type. +getHook :: forall a. Hook -> (a -> Action ()) +getHook = coerce + where + coerce :: Hook -> (a -> Action ()) + coerce (Hook x) = unsafeCoerce x + +-- | This extracts all event listener hooks from a map of hooks which match the type of the provided event. +matchingHooks :: forall a. Typeable a => Hooks -> [a -> Action ()] +matchingHooks hooks = getHook <$> (hooks^.at (typeRep (Proxy :: Proxy a))._Just) + +-- | This registers an event listener hook, as long as the listener is well-typed similar to this: +-- +-- @MyEventType -> Action ()@ then it will be registered to listen for dispatched events of that type. +-- Use within the 'Rasa.Internal.Scheduler.Scheduler' and add have the user add it to their config. +eventListener :: forall a. Typeable a => (a -> Action ()) -> Scheduler () +eventListener hook = modify $ insertWith mappend (typeRep (Proxy :: Proxy a)) [Hook hook] + +-- | Transform a 'Rasa.Internal.Scheduler.Scheduler' monad into a 'Hooks' map. +getHooks :: Scheduler () -> Hooks +getHooks = flip execState mempty . runSched + + +-- | Registers an action to be performed during the Initialization phase. +-- +-- This phase occurs exactly ONCE when the editor starts up. +onInit :: Action () -> Scheduler () +onInit action = eventListener (const action :: Init -> Action ()) + +-- | Registers an action to be performed BEFORE each event phase. +beforeEvent :: Action () -> Scheduler () +beforeEvent action = eventListener (const action :: BeforeEvent -> Action ()) + +-- | 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. +beforeRender :: Action () -> Scheduler () +beforeRender action = eventListener (const action :: BeforeRender -> Action ()) + +-- | Registers an action to be performed during each render phase. +-- +-- This phase should only be used by extensions which actually render something. +onRender :: Action () -> Scheduler () +onRender action = eventListener (const action :: OnRender -> Action ()) + +-- | 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. +afterRender :: Action () -> Scheduler () +afterRender action = eventListener (const action :: AfterRender -> Action ()) + +-- | 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 () -> Scheduler () +onExit action = eventListener (const action :: Exit -> Action ()) + diff --git a/src/Rasa/Internal/Text.hs b/src/Rasa/Internal/Text.hs new file mode 100644 --- /dev/null +++ b/src/Rasa/Internal/Text.hs @@ -0,0 +1,23 @@ +{-# language Rank2Types #-} +module Rasa.Internal.Text + ( asText + , asString + , asLines + ) where + +import Control.Lens +import qualified Yi.Rope as Y +import qualified Data.Text as T + +-- | An iso which converts to/from 'Y.YiString' -> Text +asText :: Iso' Y.YiString T.Text +asText = iso Y.toText Y.fromText + +-- | An iso which converts to/from 'Y.YiString' -> String +asString :: Iso' Y.YiString String +asString = iso Y.toString Y.fromString + + +-- | An iso which converts to/from 'Y.YiString' -> ['Y.YiString'] +asLines :: Iso' Y.YiString [Y.YiString] +asLines = iso Y.lines Y.unlines