diff --git a/src/App/Fontifier.hs b/src/App/Fontifier.hs index 1fdc18c..5d12f14 100644 --- a/src/App/Fontifier.hs +++ b/src/App/Fontifier.hs @@ -37,10 +37,16 @@ type Regex = Tdfa.Regex {---- Infix Operators ----} +-- Creates a AttrName type from a String +-- Partially applies the AttrName to a +-- function infixl 9 §: (§:) :: (AttrName -> a) -> String -> a f §: s = f $ attrName s +-- Creates a RegEx type from a string +-- Partially applies the RegEx to a +-- function infixl 9 §~ (§~) :: (Regex -> a) -> String -> a f §~ s = f $ Tdfa.makeRegex s @@ -58,6 +64,7 @@ f §. s = f . s {--- Top-Level Functions ---} +-- Defines names for fontification specifications fontMap :: [(AttrName, Vty.Attr)] fontMap = [ (attrName "assignment" , fg Vty.blue) , (attrName "return" , Vty.withStyle (fg Vty.green) Vty.bold) @@ -71,6 +78,8 @@ fontMap = [ (attrName "assignment" , fg Vty.blue) , (attrName "warn_access" , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated) ] +-- Applies fontification function and merges +-- result into a single list of [Fontifiation] fontify :: CheckString -> Fontifications fontify = concatApply [ assignments, strings , returns, guards, comments @@ -99,12 +108,6 @@ guards = slicesToFT §: "guard" §. matchGrpStripCmts 1 §~ "\\[([^ {- Custom/Function-Based -} mismatchedBrackets s = concatMap (mismatched §: "err_brackets" $ s) [('(',')'),('[',']'),('{','}')] - --- warnAccess s = let strip = prune $ (comments s) ++ (strings s) in -- removes strings and comments from fontification --- (slicesToFT §: "warn_read" $ strip $ invalidReads s) ++ --- (slicesToFT §: "warn_write" $ strip $ invalidWrites s) - --- (alternative if easier than invalid read/invalid write separated) warnAccess s = let strip = prune $ (comments s) ++ (strings s) in slicesToFT §: "warn_access" $ strip $ invalidAccesses s @@ -112,15 +115,23 @@ warnAccess s = let strip = prune $ (comments s) ++ (strings s) in {- Regex Utilities -} +-- Gets the all regex matches for regexes without +-- capture groups matchAll :: Regex -> CheckString -> Slices matchAll = matchGrpAll 0 +-- Same as matchAll but returns slices of given +-- capture group only matchGrpAll :: Int -> Regex -> CheckString -> Slices matchGrpAll g r s = matchesGrpToSlices g $ Tdfa.matchAll r s +-- like matchAll but strips matches that happen +-- to be inside a string matchStripCmts :: Regex -> CheckString -> Slices matchStripCmts = matchGrpStripCmts 0 +-- like matchStripCmts but for a given +-- caputre group only matchGrpStripCmts :: Int -> Regex -> CheckString -> Slices matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r s where commentsFts = comments s @@ -129,9 +140,13 @@ matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r then stripComments slices else slice: stripComments slices +-- Creates list of start/end indices +-- from a regex MatchResult matchesToSlices :: MatchResult -> Slices matchesToSlices = matchesGrpToSlices 0 +-- same as matchesToSlice but for a given +-- capture group only matchesGrpToSlices :: Int -> MatchResult -> Slices matchesGrpToSlices _ [] = [] matchesGrpToSlices group (m:ms) = let match = m ! group -- extract the match group (0 = the whole match) @@ -139,6 +154,8 @@ matchesGrpToSlices group (m:ms) = let match = m ! group -- extract the match gro {- Utilities for Custom Fontifiers -} +-- Finds and fontifies mismatched things +-- required matches are given by (Char,Char) mismatched :: AttrName -> CheckString -> (Char, Char) -> Fontifications mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd orphans) -- (fst orphans) = open without close, where orphans = mismatched' s 0 ([],[]) -- (snd orphans) = close without open @@ -157,11 +174,7 @@ mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd orphanedOpenExists = not $ null (fst ophs) alreadyFontified = isFontified (ix,ix+1) checkFts -unterm :: Regex -> CheckString -> Slices -unterm regex s = lastChar untermed - where commentsFts = comments s - untermed = prune commentsFts $ matchesToSlices $ Tdfa.matchAll regex s - +-- finds mismatched quotes mismatchedQuotes :: CheckString -> Fontifications mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed where matchedSlices = matchesToSlices $ (Tdfa.matchAll §~ "\"") s @@ -172,30 +185,16 @@ mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed | not $ isFontified curSlice checkFts = curSlice: negPrune checkFts slices | otherwise = negPrune checkFts slices --- ::CheckString -> Slices == ::String -> [(Int,Int)] ---invalidReads :: CheckString -> Slices -invalidReads s = [] -- do magic here - ---invalidWrites :: CheckString -> Slices -invalidWrites s = [] -- do magic here - -- facade to init invAcc invalidAccesses = invAcc [] 0 --- (alternative if easier than invalid read/invalid write separated) --- :: CurrentAssignments -> AccumulatorString -> GlobalIndex +-- :: CurrentAssignments -> GlobalIndex invAcc :: [(String,Slice,Bool)] -> Int -> CheckString -> Slices invAcc a i ('{':t) = invAcc (enterBlock a) (i+1) t invAcc a i ('}':t) = getUnread a ++ invAcc (leaveBlock a) (i+1) t invAcc a i ('[':t) = map snd (filter (\x -> isUnassigned x a) r) ++ invAcc (markReads r a) (i+1 + g) (drop g t) -- TODO check reads in first part where g = fromJust (elemIndex ':' t) r = getReads (i+1) (take g t) --- when reading an assignment :word: = --- put :word:, slice, false in the list --- when reading a read access scan the list for the variable --- if it is found set its boolean value to true --- if it is not found add its slice to the result --- all variables with false at the end of a block are unused invAcc a i ('.':t) = invAcc a (i+1 + g) (drop g t) where g = length $ fst $ fromJust $ getRead 0 t invAcc a i ('"':t) = invAcc a (i+1 + g) (drop g t) diff --git a/src/App/Gui.hs b/src/App/Gui.hs index 92f83a2..bdee069 100644 --- a/src/App/Gui.hs +++ b/src/App/Gui.hs @@ -56,14 +56,15 @@ makeLenses ''HeditState {---- Functions ----} +-- Start the editor widget runEditor :: FilePath -> IO () runEditor f = do exists <- doesFileExist f content <- if exists then readFile f else return [] st <- BrickMain.defaultMain theApp (initialState f content) --- putStr $ unpack $ toText $ createMarkup [] $ unlines $ EditWidget.getEditContents $ st^.hedit return () +-- Configure the editor widget theApp :: App HeditState Vty.Event Names theApp = App { appDraw = drawUI , appChooseCursor = showFirstCursor @@ -95,6 +96,7 @@ getAttrMap :: AttrMap getAttrMap = foldl merge uiMap [Fontifier.fontMap] where merge map list = applyAttrMappings list map -- just reverses arguments of apply +-- Draws the editor widget (static header + content) drawUI :: HeditState -> [Widget Names] drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget] -- the where is a bit ugly, for an intuitive understanding just don't look at it @@ -111,6 +113,7 @@ drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget] -- that spans the whole width -- 1 line high +-- Handles input (characters+commands) handleEvent :: HeditState -> Vty.Event -> EventM Names (Next HeditState) handleEvent st ev | ev `elem` [esc, ctrl 'c'] = quit @@ -143,6 +146,7 @@ insertString string st = st & hedit %~ insertString' string -- uses some fancy l -- inserts char a, returns resulting editor where insertChar = EditWidget.applyEdit (TextZipper.insertChar a) e +-- Puts the fontified text into editor widget drawHeditText :: [String] -> Widget n drawHeditText lines = makeWidget $ makeMarkup $ getFontification text where makeWidget = markup -- just a synonym for Brick.Markup.markup @@ -150,6 +154,8 @@ drawHeditText lines = makeWidget $ makeMarkup $ getFontification text getFontification = Fontifier.fontify -- just a synonym makeMarkup = fontifyToMarkup text -- curried fontifyToMarkup; needs an additional fontification list only +-- Creates a markup specification for the text from +-- Fontification definitions fontifyToMarkup :: String -> [Fontification] -> Markup AttrName fontifyToMarkup text fontification = fontifyToMarkup' baseMarkup fontification -- fromText marks the given text with the default markup diff --git a/src/Main.hs b/src/Main.hs index 881fe5d..7afc8e1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,6 +4,9 @@ import Control.Monad (when) import Gui (runEditor) import System.Environment (getArgs) +-- Entry point +-- Reads argument (file to open), starts editor +-- Fails with usage message if no file specified main = do args <- getArgs when (null args) $ error (msgWithUsage "Please specify a file")