packages feed

rasa-ext-slate 0.1.0.0 → 0.1.2

raw patch · 11 files changed

+287/−280 lines, 11 filesdep +rasa-ext-bufsdep ~basedep ~lensdep ~rasaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: rasa-ext-bufs

Dependency ranges changed: base, lens, rasa, rasa-ext-logger, rasa-ext-status-bar, rasa-ext-style, text, vty, yi-rope

API changes (from Hackage documentation)

- Rasa.Renderer.Slate: slate :: Scheduler ()
- Rasa.Renderer.Slate: terminalEvents :: Action [Keypress]
+ Rasa.Ext.Slate: slate :: Scheduler ()

Files

rasa-ext-slate.cabal view
@@ -1,41 +1,42 @@-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+name: rasa-ext-slate+version: 0.1.2+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: 2016 Chris Penner+maintainer: christopher.penner@gmail.com+homepage: https://github.com/ChrisPenner/rasa/+synopsis: Rasa extension for rendering to terminal with vty+description:+    Rasa extension for rendering to terminal with vty+category: Extension+author: Chris Penner -  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+source-repository head+    type: git+    location: https://github.com/ChrisPenner/rasa -  ghc-options:         -Wall+library+    exposed-modules:+        Rasa.Ext.Slate+    build-depends:+        base >=4.8 && <5,+        rasa >=0.1.4 && <0.2,+        rasa-ext-bufs >=0.1.1 && <0.2,+        rasa-ext-style >=0.1.1 && <0.2,+        rasa-ext-status-bar >=0.1.1 && <0.2,+        text >=1.2.2.1 && <1.3,+        yi-rope >=0.7.0.2 && <0.8,+        lens ==4.14.*,+        vty ==5.14.*,+        rasa-ext-logger >=0.1.1 && <0.2+    default-language: Haskell2010+    hs-source-dirs: src+    other-modules:+        Rasa.Ext.Slate.Internal.Render+        Rasa.Ext.Slate.Internal.Event+        Rasa.Ext.Slate.Internal.State+        Rasa.Ext.Slate.Internal.Attributes+    ghc-options: -Wall -source-repository head-  type:     git-  location: https://github.com/ChrisPenner/rasa
+ src/Rasa/Ext/Slate.hs view
@@ -0,0 +1,28 @@+module Rasa.Ext.Slate (slate) where++import Rasa.Ext+import Rasa.Ext.Slate.Internal.Render (render)+import Rasa.Ext.Slate.Internal.Event (terminalEvents)+import Rasa.Ext.Slate.Internal.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+  onInit terminalEvents+  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/Ext/Slate/Internal/Attributes.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+module Rasa.Ext.Slate.Internal.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/Ext/Slate/Internal/Event.hs view
@@ -0,0 +1,34 @@+module Rasa.Ext.Slate.Internal.Event (terminalEvents) where++import Rasa.Ext++import Rasa.Ext.Slate.Internal.State++import qualified Graphics.Vty as V++-- | Provides keypress events from the terminal, converted from Vty events.+terminalEvents :: Action ()+terminalEvents = do+    v <- getVty+    eventProvider $ convertEvent <$> V.nextEvent v++-- | Converts a 'V.Event' into a keypress if possible.+convertEvent :: V.Event -> Keypress+convertEvent (V.EvKey e mods) = convertKeypress e mods+convertEvent _ = Unknown++-- | Converts a 'V.Event' into a keypress if possible.+convertKeypress :: V.Key -> [V.Modifier] -> Keypress+convertKeypress V.KEnter _ = Enter+convertKeypress V.KBS _ = BS+convertKeypress V.KEsc _ = Esc+convertKeypress (V.KChar c) mods  = Keypress c (fmap convertMod mods)+convertKeypress _ _ = Unknown++-- | 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/Ext/Slate/Internal/Render.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}+module Rasa.Ext.Slate.Internal.Render (render) where++import Rasa.Ext+import Rasa.Ext.Bufs+import Rasa.Ext.Style+import Rasa.Ext.StatusBar (left, center, right)+import Rasa.Ext.Slate.Internal.State+import Rasa.Ext.Slate.Internal.Attributes+++import qualified Graphics.Vty as V+import Control.Lens+import Control.Monad.IO.Class++import Data.Monoid+import Data.Foldable++import qualified Yi.Rope as Y++-- | 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 text+  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+  mBufImg <- focusDo $ renderBuf (width, height - 1)+  case mBufImg of+    Nothing -> return ()+    Just bufImg -> do+      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 = fmap fold . focusDo $ do+  statuses <- use bufExt+  let spacer = Y.replicate spacerSize " "+      spacerSize = (width - Y.length (Y.concat joinedParts)) `div` 2+      barParts = [ statuses^.left, statuses^.center, statuses^.right ]+      addSpacer = (<> spacer)+      joinedParts = Y.intercalate " | " <$> barParts+      fullLine = foldMap addSpacer joinedParts+  return $ V.text' V.defAttr (Y.toText fullLine)
+ src/Rasa/Ext/Slate/Internal/State.hs view
@@ -0,0 +1,28 @@+module Rasa.Ext.Slate.Internal.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
− src/Rasa/Renderer/Slate.hs 
@@ -1,27 +0,0 @@-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 
@@ -1,99 +0,0 @@-{-# 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 
@@ -1,36 +0,0 @@-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 
@@ -1,52 +0,0 @@-{-# 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 
@@ -1,28 +0,0 @@-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