check for mismatched brackets

This commit is contained in:
Johannes Winklehner 2016-08-03 17:21:22 +02:00
parent 4472025157
commit 80b83098cb

View file

@ -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]