added highlighting for string literals
This commit is contained in:
parent
9fed792c40
commit
4472025157
1 changed files with 18 additions and 1 deletions
19
editor.hs
19
editor.hs
|
@ -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]
|
||||||
|
|
Loading…
Reference in a new issue