Merge pull request #45 from ChrisPenner/add-renderable

Refactor Views rendering; add Widgets

Author: ChrisPenner

README.md

@@ -22,8 +22,6 @@ You can find hackage documentation for rasa and some extensions here:
 - [rasa-ext-cursors](https://hackage.haskell.org/package/rasa-ext-cursors)
 - [rasa-ext-files](https://hackage.haskell.org/package/rasa-ext-files)
 - [rasa-ext-logger](https://hackage.haskell.org/package/rasa-ext-logger)
-- [rasa-ext-status-bar](https://hackage.haskell.org/package/rasa-ext-status-bar)
-- [rasa-ext-style](https://hackage.haskell.org/package/rasa-ext-style)
 
 What people are saying
 ----------------------
@@ -178,13 +176,11 @@ extra-deps:
 - rasa-0.1.0.0
 - rasa-ext-cursors-0.1.0.0
 - rasa-ext-logger-0.1.0.0
-- rasa-ext-status-bar-0.1.0.0
 - rasa-ext-vim-0.1.0.0
 - text-lens-0.1.0.0
 - rasa-ext-files-0.1.0.0
 - rasa-ext-cmd-0.1.0.0
 - rasa-ext-slate-0.1.0.0
-- rasa-ext-style-0.1.0.0
 - vty-5.14
 ```
 

cabal.project

@@ -8,8 +8,6 @@ packages:
  ./rasa-ext-files
  ./rasa-ext-logger
  ./rasa-ext-slate
- ./rasa-ext-status-bar
- ./rasa-ext-style
  ./rasa-ext-vim
  ./rasa-example-config
  ./text-lens

rasa-example-config/app/Main.hs

@@ -4,14 +4,15 @@ module Main where
 import Rasa (rasa)
 import Rasa.Ext
 import Rasa.Ext.Views
-import Rasa.Ext.Style
 import Rasa.Ext.Vim
 import Rasa.Ext.Files
-import Rasa.Ext.StatusBar
 import Rasa.Ext.Logger
 import Rasa.Ext.Cursors
 import Rasa.Ext.Slate
 
+-- import Control.Monad
+-- import Control.Monad.Trans
+
 -- | This is the main of an executable that runs rasa with any extensions the
 -- user wants
 --
@@ -21,10 +22,8 @@ main :: IO ()
 main = rasa $ do
   viewports
   vim
-  statusBar
   files
   cursors
   logger
   slate
-  style
-  onInit $ newBuffer "This is a buffer to get you started!\nYou can also pass command line args to rasa"
+  afterInit $ addBuffer "This is a buffer to get you started!\nYou can also pass command line args to rasa"

rasa-example-config/rasa-example-config.cabal

@@ -20,13 +20,13 @@ executable rasa
                      , rasa
                      , rasa-ext-views
                      , rasa-ext-vim
-                     , rasa-ext-style
                      , rasa-ext-cursors
-                     , rasa-ext-status-bar
                      , rasa-ext-logger
                      , rasa-ext-files
                      , rasa-ext-slate
                      , lens
+                     , data-default
+                     , yi-rope
                      , mtl
   default-language:    Haskell2010
   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N

rasa-ext-cursors/rasa-ext-cursors.cabal

@@ -20,7 +20,6 @@ library
                        Rasa.Ext.Cursors.Internal.Base
   build-depends:       base >= 4.8 && < 5
                      , rasa
-                     , rasa-ext-style
                      , text-lens
                      , lens
                      , mtl

rasa-ext-cursors/src/Rasa/Ext/Cursors.hs

@@ -27,4 +27,5 @@ import Rasa.Ext.Cursors.Internal.Actions
 
 -- | Registers listeners for the extension. The user should add this to their config.
 cursors :: Action ()
-cursors = beforeEveryRender_ $ buffersDo_ displayRange
+cursors = onInit . onBufAdded $
+  \(BufAdded bufRef) -> bufDo_ bufRef setStyleProvider

rasa-ext-cursors/src/Rasa/Ext/Cursors/Internal/Base.hs

@@ -8,12 +8,11 @@ module Rasa.Ext.Cursors.Internal.Base
   , setRanges
   , overEachRange
   , addRange
-  , displayRange
+  , setStyleProvider
   ) where
 
 
 import Rasa.Ext
-import Rasa.Ext.Style
 
 import Control.Monad.State
 import Control.Lens
@@ -73,9 +72,9 @@ overEachRange f = rangeDo f >>= setRanges
 addRange :: CrdRange -> BufAction ()
 addRange r = overRanges (++[r])
 
--- | Sets style attributes to show a given range.
-displayRange ::  BufAction ()
-displayRange = rangeDo_ setStyle
+-- | Adds cursor specific styles
+setStyleProvider :: BufAction ()
+setStyleProvider = void . addStyleProvider $ rangeDo setStyle
   where
-    setStyle :: CrdRange -> BufAction ()
-    setStyle r = addStyle r (flair ReverseVideo)
+    setStyle :: CrdRange -> BufAction (Span CrdRange Style)
+    setStyle r = return $ Span r (flair ReverseVideo)

rasa-ext-files/rasa-ext-files.cabal

@@ -21,11 +21,11 @@ library
   build-depends:       base >= 4.8 && < 5
                      , rasa
                      , rasa-ext-views
-                     , rasa-ext-status-bar
                      , rasa-ext-cmd
                      , data-default
                      , lens
                      , text
+                     , mtl
                      , yi-rope
   default-language:    Haskell2010
 

rasa-ext-files/src/Rasa/Ext/Files.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
+{-# language
+   OverloadedStrings
+#-}
 
 module Rasa.Ext.Files
   ( files
@@ -8,59 +10,104 @@ module Rasa.Ext.Files
 import qualified Data.Text.IO as TIO
 import System.Environment
 
-import Data.Foldable
 import Data.Typeable
 import Data.Default
-import Data.Monoid
+import Data.Maybe
 
-import Control.Monad.IO.Class
+import Control.Monad
+import Control.Monad.Trans
 import qualified Yi.Rope as Y
 
 import Rasa.Ext
 import Rasa.Ext.Views
 import Rasa.Ext.Cmd
-import Rasa.Ext.StatusBar
 
+-- | Stores filename
 data FileInfo =
-  FileInfo (Maybe Y.YiString)
+  FileInfo (Maybe String)
   deriving (Typeable, Show, Eq)
 
 instance Default FileInfo where
   def = FileInfo Nothing
 
+type Filename = String
+
+-- | Stores File status; Clean means all changes are saved
+data FileStatus =
+  Dirty
+  | Clean
+  deriving Show
+
+instance Default FileStatus where
+  def = Clean
+
+-- | Returns 'FileStatus' of current buffer
+getFileStatus :: BufAction FileStatus
+getFileStatus = getBufExt
+
+-- | Sets 'FileStatus' of current buffer
+setFileStatus :: FileStatus -> BufAction ()
+setFileStatus = setBufExt
+
+-- | Gets filename of current buffer
+getFilename :: BufAction (Maybe Filename)
+getFilename = do
+  FileInfo filename <- getBufExt
+  return filename
+
+-- | Main export, use this in your Rasa config
 files :: Action ()
 files = do
-  beforeEveryRender_ showFilename
-  onInit $ do
+  onEveryNewBuffer_ $ do
+    void . onBufTextChanged $ bufferChanged
+    void . addTopStatus $ fileStatus
+    void . addTopStatus $ (fmap Y.fromString <$> getFilename)
+
+  afterInit $ do
     loadFiles
-    addCmd "save" $ focusDo_ . saveAs . Y.fromString
+    addCmd "save" $ focusDo_ . saveAs
 
-showFilename :: Action ()
-showFilename = focusDo_ $ do
-  FileInfo mName <- getBufExt
-  traverse_ (leftStatus . disp) mName
-      where disp name = "<" <> name <> ">"
+-- | Renders the current file status
+fileStatus :: BufAction (Maybe RenderInfo)
+fileStatus = do
+  hasFilename <- isJust <$> getFilename
+  status <- getFileStatus
+  if hasFilename
+    then return . Just $
+       case status of
+         Dirty -> styleText "✘" $ fg Red
+         Clean -> styleText "✓" $ fg Green
+    else return Nothing
+
+-- | Keeps track of buffer status
+bufferChanged :: BufTextChanged -> BufAction ()
+bufferChanged _ = setFileStatus Dirty
 
-saveAs :: Y.YiString -> BufAction ()
-saveAs fName = getText >>= liftIO . TIO.writeFile (Y.toString fName) . Y.toText
+saveAs :: String -> BufAction ()
+saveAs fName = getText >>= liftIO . TIO.writeFile fName . Y.toText
 
+-- | Save the buffer if we have a filename
 save :: BufAction ()
 save = do
   FileInfo mName <- getBufExt
   case mName of
     Just fName -> saveAs fName
     Nothing -> return ()
+  setFileStatus Clean
 
-setFilename :: Y.YiString -> BufAction ()
+-- | Set the filename
+setFilename :: String -> BufAction ()
 setFilename fname = setBufExt $ FileInfo (Just fname)
 
-addFile :: Y.YiString -> Y.YiString -> Action ()
+-- | Add a buffer for a file
+addFile :: String -> Y.YiString -> Action ()
 addFile fname txt = do
-  newBuf <- newBuffer txt
+  newBuf <- addBuffer txt
   bufDo_ newBuf (setFilename fname)
 
+-- | Load files from command line
 loadFiles :: Action ()
 loadFiles = do
   fileNames <- liftIO getArgs
   fileTexts <- liftIO $ traverse TIO.readFile fileNames
-  mapM_ (uncurry addFile) $ zip (Y.fromString <$> fileNames) (Y.fromText <$> fileTexts)
+  mapM_ (uncurry addFile) $ zip fileNames (Y.fromText <$> fileTexts)

rasa-ext-slate/rasa-ext-slate.cabal

@@ -24,8 +24,6 @@ library
 
   build-depends:       base >= 4.8 && < 5
                      , rasa
-                     , rasa-ext-style
-                     , rasa-ext-status-bar
                      , rasa-ext-views
                      , recursion-schemes
                      , text

rasa-ext-slate/src/Rasa/Ext/Slate.hs

@@ -1,9 +1,9 @@
 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 Rasa.Ext.Slate.Internal.Render
+import Rasa.Ext.Slate.Internal.Event
+import Rasa.Ext.Slate.Internal.State
 
 import qualified Graphics.Vty as V
 import Control.Monad.IO.Class
@@ -18,7 +18,7 @@ import Control.Monad.IO.Class
 slate :: Action ()
 slate = do
   onInit terminalEvents
-  onEveryRender_ render
+  onEveryRender_ renderAll
   onExit shutdown
 
 -- | Call vty shutdown procedure (if this doesn't happen the terminal ends up in strange states)

rasa-ext-slate/src/Rasa/Ext/Slate/Internal/Attributes.hs

@@ -2,7 +2,6 @@
 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 Data.Bifunctor
@@ -51,17 +50,18 @@ instance Monoid AttrMonoid where
   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 CrdRange V.Attr] -> Y.YiString -> V.Image
-applyAttrs atts txt = textAndStylesToImage mergedSpans (padSpaces <$> Y.lines txt)
+applyAttrs :: RenderInfo -> V.Image
+applyAttrs (RenderInfo txt styles) = textAndStylesToImage mergedSpans (padSpaces <$> Y.lines txt)
   where mergedSpans = second getAttr <$> combineSpans (fmap AttrMonoid <$> atts)
         -- Newlines aren't rendered; so we replace them with spaces so they're selectable
         padSpaces = (`Y.append` "  ")
+        atts = second convertStyle <$> styles
 
+-- | Makes and image from text and styles
 textAndStylesToImage :: [(Coord, V.Attr)] -> [Y.YiString] -> V.Image
-textAndStylesToImage atts lines' = vertCat $ (reset V.<|>) . uncurry attrLine <$> pairLines atts lines'
+textAndStylesToImage atts lines' = V.vertCat $ wrapResets . uncurry attrLine <$> pairLines atts lines'
   where
-    vertCat = foldr ((V.<->) . (V.<|> reset)) V.emptyImage
-
+    wrapResets img = reset V.<|> img V.<|> reset
 
 -- | 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)