packages feed

rasa-ext-slate (empty) → 0.1.0.0

raw patch · 8 files changed

+306/−0 lines, 8 filesdep +basedep +lensdep +rasasetup-changed

Dependencies added: base, lens, rasa, rasa-ext-logger, rasa-ext-status-bar, rasa-ext-style, text, vty, yi-rope

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rasa-ext-slate.cabal view
@@ -0,0 +1,41 @@+name:                rasa-ext-slate+version:             0.1.0.0+synopsis:            Rasa extension for rendering to terminal with vty+description:         Rasa extension for rendering to terminal with vty+homepage:            https://github.com/ChrisPenner/rasa/+license:             MIT+license-file:        LICENSE+author:              Chris Penner+maintainer:          christopher.penner@gmail.com+copyright:           2016 Chris Penner+category:            Extension+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+                       Rasa.Renderer.Slate+  other-modules:+                       Rasa.Renderer.Slate.Render+                       Rasa.Renderer.Slate.Event+                       Rasa.Renderer.Slate.State+                       Rasa.Renderer.Slate.Attributes++  build-depends:       base >= 4.7 && < 5+                     , rasa+                     , rasa-ext-style+                     , rasa-ext-status-bar+                     , text+                     , yi-rope+                     , lens+                     , vty >= 5.14+                     , rasa-ext-logger+  default-language:    Haskell2010++  ghc-options:         -Wall++source-repository head+  type:     git+  location: https://github.com/ChrisPenner/rasa
+ src/Rasa/Renderer/Slate.hs view
@@ -0,0 +1,27 @@+module Rasa.Renderer.Slate (slate, terminalEvents) where++import Rasa.Ext+import Rasa.Renderer.Slate.Render (render)+import Rasa.Renderer.Slate.Event (terminalEvents)+import Rasa.Renderer.Slate.State (getVty)++import qualified Graphics.Vty as V+import Control.Monad.IO.Class++-- | The main export for this extension. Add this to your user config.+--+-- e.g.+--+-- > rasa [...] $ do+-- >    slate+-- >    ...+slate :: Scheduler ()+slate = do+  onRender render+  onExit shutdown++-- | Call vty shutdown procedure (if this doesn't happen the terminal ends up in strange states)+shutdown :: Action ()+shutdown = do+  v <- getVty+  liftIO $ V.shutdown v
+ src/Rasa/Renderer/Slate/Attributes.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+module Rasa.Renderer.Slate.Attributes where++import Rasa.Ext+import Rasa.Ext.Style+import qualified Yi.Rope as Y+import qualified Graphics.Vty as V+import Control.Lens++-- | Convert style from "Rasa.Ext.Style" into 'V.Attr's+convertStyle :: Style -> V.Attr+convertStyle (Style (fg', bg', flair')) = V.Attr+                                        (maybe V.KeepCurrent convertFlair flair')+                                        (maybe V.KeepCurrent convertColor fg')+                                        (maybe V.KeepCurrent convertColor bg')++-- | Convert flair from "Rasa.Ext.Style" into 'V.Style's+convertFlair :: Flair -> V.MaybeDefault V.Style+convertFlair Standout = V.SetTo V.standout+convertFlair Underline = V.SetTo V.underline+convertFlair ReverseVideo = V.SetTo V.reverseVideo+convertFlair Blink =  V.SetTo V.blink+convertFlair Dim = V.SetTo  V.dim+convertFlair Bold = V.SetTo V.bold+convertFlair DefFlair = V.Default++-- | Convert colors from "Rasa.Ext.Style" into 'V.Color's+convertColor :: Color -> V.MaybeDefault V.Color+convertColor Black = V.SetTo V.black+convertColor Red = V.SetTo V.red+convertColor Green = V.SetTo V.green+convertColor Yellow = V.SetTo V.yellow+convertColor Blue = V.SetTo V.blue+convertColor Magenta = V.SetTo V.magenta+convertColor Cyan = V.SetTo V.cyan+convertColor White = V.SetTo V.white+convertColor DefColor = V.Default++-- | helper to reset to default attributes+reset :: V.Image+reset = V.text' V.defAttr ""++-- | A newtype to define a (not necessarily law abiding) Monoid for 'V.Attr' which acts as we like.+newtype AttrMonoid = AttrMonoid {+  attr' :: V.Attr+}++-- | We want 'mempty' to be 'V.defAttr' instead of 'V.currentAttr' for use in 'combineSpans'.+instance Monoid AttrMonoid where+  mempty = AttrMonoid V.defAttr+  AttrMonoid v `mappend` AttrMonoid v' = AttrMonoid $ v `mappend` v'++-- | Apply a list of styles to the given text, resulting in a 'V.Image'.+applyAttrs :: [Span V.Attr] -> Y.YiString -> V.Image+applyAttrs atts txt = applyAttrs' converted (Y.lines txt)+  where combined = combineSpans (atts & traverse.mapped %~ AttrMonoid)+        converted = combined & traverse._2 %~ attr'++applyAttrs' :: [(Coord, V.Attr)] -> [Y.YiString] -> V.Image+applyAttrs' atts lines' = vertCat $ uncurry attrLine <$> pairLines atts lines'+  where+    vertCat = foldr ((V.<->) . (V.<|> reset)) V.emptyImage+++-- | Applies the list of attrs to the line and returns a 'V.Image'. It assumes that the list+-- contains only 'Coord's on the same line (i.e. row == 0)+--+-- Should be able to clean this up and provide better guarantees if I do a scan+-- over attrs and get each successive mappend of them, then do T.splitAt for+-- each offset, then apply the attr for each section at the begining of each+-- of T.lines within each group. Ugly I know.+attrLine :: [(Coord, V.Attr)] -> Y.YiString -> V.Image+attrLine [] txt = plainText txt+attrLine atts "" = V.text' (mconcat (snd <$> atts)) ""+attrLine ((Coord _ 0, attr):atts) txt = V.text' attr "" V.<|> attrLine atts txt+attrLine atts@((Coord _ col, _):_) txt =+  let (prefix, suffix) = Y.splitAt col txt+   in plainText prefix V.<|> attrLine (decrCol col atts) suffix++-- | Pairs up lines with their styles.+pairLines :: [(Coord, b)] -> [a] -> [([(Coord, b)], a)]+pairLines _ [] = []+pairLines [] ls = zip (repeat []) ls+pairLines crds@((Coord 0 _, _):_) (l:ls) = (takeWhile isSameRow crds, l) : pairLines (decrRow $ dropWhile isSameRow crds) ls+  where isSameRow (Coord 0 _, _) = True+        isSameRow _ = False+pairLines crds (l:ls) = ([], l): pairLines (decrRow crds) ls++-- | Decrements the row of all future attrs' location+decrRow :: [(Coord, a)] -> [(Coord, a)]+decrRow = fmap (\(Coord r c, a) -> (Coord (r-1) c, a))++-- | Decrements the column of all future attrs' location by the given amount+decrCol :: Int -> [(Coord, a)] -> [(Coord, a)]+decrCol n = fmap (\(Coord r c, a) -> (Coord r (c-n), a))++-- | Creates a text image without any new attributes.+plainText :: Y.YiString -> V.Image+plainText = V.text' V.currentAttr . Y.toText
+ src/Rasa/Renderer/Slate/Event.hs view
@@ -0,0 +1,36 @@+module Rasa.Renderer.Slate.Event (terminalEvents) where++import Rasa.Ext++import Rasa.Renderer.Slate.State+import Control.Monad.IO.Class+import Data.Maybe++import qualified Graphics.Vty as V++-- | Provides keypress events from the terminal, converted from Vty events.+terminalEvents :: Action [Keypress]+terminalEvents = do+    v <- getVty+    liftIO $ maybeToList . convertEvent <$> V.nextEvent v++-- | Converts a 'V.Event' into a keypress if possible.+convertEvent :: V.Event -> Maybe Keypress+convertEvent (V.EvKey e mods) = convertKeypress e mods+convertEvent _ = Nothing++-- | Converts a 'V.Event' into a keypress if possible.+convertKeypress :: V.Key -> [V.Modifier] -> Maybe Keypress+convertKeypress V.KEnter _ = Just Enter+convertKeypress V.KBS _ = Just BS+convertKeypress V.KEsc _ = Just Esc+convertKeypress (V.KChar c) mods  = Just $ Keypress c (fmap convertMod mods)+convertKeypress _ _  = Nothing++-- | Converts a 'V.Modifier' into a 'Mod'.+convertMod :: V.Modifier -> Mod+convertMod m = case m of+                 V.MShift -> Shift+                 V.MCtrl -> Ctrl+                 V.MMeta -> Alt+                 V.MAlt -> Alt
+ src/Rasa/Renderer/Slate/Render.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}+module Rasa.Renderer.Slate.Render (render) where++import Rasa.Ext+import Rasa.Ext.Style+import Rasa.Ext.StatusBar (left, center, right)+import Rasa.Renderer.Slate.State+import Rasa.Renderer.Slate.Attributes+import Control.Monad.IO.Class++import qualified Graphics.Vty as V+import Control.Lens++import qualified Data.Text as T+import Data.Monoid++-- | Given a window size, creates a 'BufAction' which will return an image representing the buffer it's run in.+renderBuf :: (Int, Int) -> BufAction V.Image+renderBuf (width, height) = do+  txt <- use rope+  atts <- fmap (fmap convertStyle) <$> use styles+  let img = applyAttrs atts txt+  return $ V.resize width height img++-- | Get the current terminal size.+getSize :: Action (Int, Int)+getSize = do+  v <- getVty+  liftIO $ V.displayBounds $ V.outputIface v++-- | Render the Editor+render :: Action ()+render = do+  (width, height) <- getSize+  bufImg <- focusDo $ renderBuf (width, height - 1)+  statusBar <- renderStatus width+  let img = bufImg V.<-> statusBar+      pic = V.picForImage img+  v <- getVty+  liftIO $ V.update v pic++-- | Render the status bar.+renderStatus :: Int -> Action V.Image+renderStatus width = focusDo $ do+  statuses <- use bufExt+  let spacer = T.replicate spacerSize " "+      spacerSize = (width - T.length (T.concat joinedParts)) `div` 2+      barParts = [ statuses^.left, statuses^.center, statuses^.right ]+      addSpacer = (<> spacer)+      joinedParts = T.intercalate " | " <$> barParts+      fullLine = foldMap addSpacer joinedParts+  return $ V.text' V.defAttr fullLine
+ src/Rasa/Renderer/Slate/State.hs view
@@ -0,0 +1,28 @@+module Rasa.Renderer.Slate.State (getVty) where++import Rasa.Ext+import Control.Lens++import Control.Monad.IO.Class+import qualified Graphics.Vty as V++-- | Store 'V.Vty' state globally+newtype Slate = Slate V.Vty+instance Show Slate where+  show _ = "Slate"++-- | V.Vty must be initialized, this takes IO to perform.+initUi :: Action V.Vty+initUi = do+  cfg <- liftIO V.standardIOConfig+  v <- liftIO $ V.mkVty cfg+  ext .= Just (Slate v)+  return v++-- | Gets vty by checking if it has been initialized yet, if not it runs the initialization.+getVty :: Action V.Vty+getVty = do+  v <- use ext+  case v of+    Just (Slate v') -> return v'+    Nothing -> initUi