check for mismatched brackets
This commit is contained in:
parent
4472025157
commit
80b83098cb
1 changed files with 34 additions and 8 deletions
42
editor.hs
42
editor.hs
|
@ -3,27 +3,53 @@ import Brick.Markup
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Text (pack, singleton)
|
import Data.Tuple
|
||||||
import Data.Text.Markup ((@@))
|
import Data.Text (pack, singleton, unpack)
|
||||||
|
import Data.Text.Markup
|
||||||
|
import Control.Monad
|
||||||
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
|
||||||
|
|
||||||
|
import Control.Exception.Base
|
||||||
|
import Debug.Trace
|
||||||
|
|
||||||
data Name = Text deriving (Ord, Show, Eq)
|
data Name = Text deriving (Ord, Show, Eq)
|
||||||
type St = E.Editor Name
|
type St = E.Editor Name
|
||||||
|
|
||||||
|
brackets = [('(',')'),('[',']'),('{','}')]
|
||||||
|
|
||||||
initialState :: St
|
initialState :: St
|
||||||
initialState = E.editor Text drawContent Nothing ""
|
initialState = E.editor Text drawContent Nothing ""
|
||||||
|
|
||||||
drawContent :: [String] -> Widget n
|
drawContent :: [String] -> Widget n
|
||||||
drawContent = markup . createMarkup . unlines
|
drawContent = markup . (createMarkup []) . unlinesWA
|
||||||
|
|
||||||
createMarkup :: String -> Markup V.Attr
|
-- workaround because empty lines don't work with Markup
|
||||||
createMarkup [] = mempty
|
unlinesWA :: [String] -> String
|
||||||
createMarkup s@('"':ss) = case i of
|
unlinesWA [] = ""
|
||||||
Just n -> (pack (take (2+n) s) @@ fg V.blue) <> (createMarkup (drop (1+n) ss))
|
unlinesWA (l:ls) = l ++ (" \n" ++ unlinesWA ls)
|
||||||
|
|
||||||
|
createMarkup :: String -> String -> Markup V.Attr
|
||||||
|
createMarkup _ [] = mempty
|
||||||
|
createMarkup p s@('"':ss) = case i of
|
||||||
|
Just n -> (pack (take (2+n) s) @@ fg V.blue) <> (createMarkup (reverse (take (2+n) s) ++ s) (drop (1+n) ss))
|
||||||
Nothing -> pack s @@ fg V.red
|
Nothing -> pack s @@ fg V.red
|
||||||
where i = elemIndex '"' ss
|
where i = elemIndex '"' ss
|
||||||
createMarkup (c:ss) = (singleton c @@ fg V.white) <> (createMarkup ss)
|
createMarkup p (c:ss)
|
||||||
|
| isJust ob && mismatched (fromJust ob) ss 1
|
||||||
|
|| isJust cb && mismatched (swap $ fromJust cb) p 1 = (singleton c @@ bg V.red) <> r
|
||||||
|
| otherwise = (singleton c @@ fg V.white) <> r
|
||||||
|
where ob = find ((== c).fst) brackets
|
||||||
|
cb = find ((== c).snd) brackets
|
||||||
|
r = createMarkup (c:p) ss
|
||||||
|
|
||||||
|
mismatched :: (Char, Char) -> String -> Int -> Bool
|
||||||
|
mismatched _ _ 0 = False
|
||||||
|
mismatched _ [] _ = True
|
||||||
|
mismatched b@(ob, cb) (c:cs) d
|
||||||
|
| c == ob = mismatched b cs $ d+1
|
||||||
|
| c == cb = mismatched b cs $ d-1
|
||||||
|
| otherwise = mismatched b cs d
|
||||||
|
|
||||||
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