import Brick import Brick.Markup import Data.Maybe import Data.Monoid import Data.List import Data.Tuple import Data.Default import Data.Text (pack, singleton, unpack) import Data.Text.Markup import Control.Monad import Control.Monad.IO.Class import Control.Concurrent import Control.DeepSeq import System.Environment 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 :: String -> 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 :: String -> St -> V.Event -> EventM Name (Next St) appEvent s st ev = case ev of V.EvKey V.KEsc [] -> halt st V.EvKey (V.KChar 'c') [V.MCtrl] -> halt st V.EvKey (V.KChar 's') [V.MCtrl] -> liftIO (writeFile s (unlines $ E.getEditContents $ st)) >> continue st _ -> continue =<< E.handleEditorEvent ev st theApp :: String -> App St V.Event Name theApp s = App { appDraw = drawUI , appChooseCursor = showFirstCursor , appHandleEvent = appEvent s , appStartEvent = return , appAttrMap = const (attrMap V.defAttr [ ]) , appLiftVtyEvent = id } main = do f <- do a <- getArgs return $ head a c <- readFile f st <- defaultMain (theApp f) (initialState c) void $ return st -- putStrLn $ unlines $ E.getEditContents $ st