added highlighting for string literals

This commit is contained in:
Johannes Winklehner 2016-07-27 17:34:48 +02:00
parent 9fed792c40
commit 4472025157

View file

@ -1,4 +1,10 @@
import Brick import Brick
import Brick.Markup
import Data.Maybe
import Data.Monoid
import Data.List
import Data.Text (pack, singleton)
import Data.Text.Markup ((@@))
import qualified Brick.Widgets.Edit as E import qualified Brick.Widgets.Edit as E
import qualified Graphics.Vty as V import qualified Graphics.Vty as V
@ -6,7 +12,18 @@ data Name = Text deriving (Ord, Show, Eq)
type St = E.Editor Name type St = E.Editor Name
initialState :: St initialState :: St
initialState = E.editor Text (str . unlines) Nothing "" initialState = E.editor Text drawContent Nothing ""
drawContent :: [String] -> Widget n
drawContent = markup . createMarkup . unlines
createMarkup :: String -> Markup V.Attr
createMarkup [] = mempty
createMarkup s@('"':ss) = case i of
Just n -> (pack (take (2+n) s) @@ fg V.blue) <> (createMarkup (drop (1+n) ss))
Nothing -> pack s @@ fg V.red
where i = elemIndex '"' ss
createMarkup (c:ss) = (singleton c @@ fg V.white) <> (createMarkup ss)
drawUI :: St -> [Widget Name] drawUI :: St -> [Widget Name]
drawUI st = [E.renderEditor True st] drawUI st = [E.renderEditor True st]