78 lines
2.4 KiB
Haskell
78 lines
2.4 KiB
Haskell
import Brick
|
|
import Brick.Markup
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Data.List
|
|
import Data.Tuple
|
|
import Data.Text (pack, singleton, unpack)
|
|
import Data.Text.Markup
|
|
import Control.Monad
|
|
import qualified Brick.Widgets.Edit as E
|
|
import qualified Graphics.Vty as V
|
|
|
|
import Control.Exception.Base
|
|
import Debug.Trace
|
|
|
|
data Name = Text deriving (Ord, Show, Eq)
|
|
type St = E.Editor Name
|
|
|
|
brackets = [('(',')'),('[',']'),('{','}')]
|
|
|
|
initialState :: St
|
|
initialState = E.editor Text drawContent Nothing ""
|
|
|
|
drawContent :: [String] -> Widget n
|
|
drawContent = markup . (createMarkup []) . unlinesWA
|
|
|
|
-- workaround because empty lines don't work with Markup
|
|
unlinesWA :: [String] -> String
|
|
unlinesWA [] = ""
|
|
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
|
|
where i = elemIndex '"' 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 = [E.renderEditor True st]
|
|
|
|
appCursor :: St -> [CursorLocation Name] -> Maybe (CursorLocation Name)
|
|
appCursor st c = Just (head c)
|
|
|
|
appEvent :: St -> V.Event -> EventM Name (Next St)
|
|
appEvent st ev =
|
|
case ev of
|
|
V.EvKey V.KEsc [] -> halt st
|
|
_ -> continue =<< E.handleEditorEvent ev st
|
|
|
|
theApp :: App St V.Event Name
|
|
theApp =
|
|
App { appDraw = drawUI
|
|
, appChooseCursor = appCursor
|
|
, appHandleEvent = appEvent
|
|
, appStartEvent = return
|
|
, appAttrMap = const (attrMap V.defAttr [ ])
|
|
, appLiftVtyEvent = id
|
|
}
|
|
|
|
main = do
|
|
st <- defaultMain theApp initialState
|
|
putStrLn $ unlines $ E.getEditContents $ st
|