From e9aaddc974ab4271eef419978653f3c36b4d168e Mon Sep 17 00:00:00 2001 From: Armin Friedl Date: Fri, 12 Aug 2016 12:55:12 +0200 Subject: [PATCH] unterm checks for assignments/returns --- src/App/Fontifier.hs | 120 +++++++++++++++++++++++++++---------------- 1 file changed, 77 insertions(+), 43 deletions(-) diff --git a/src/App/Fontifier.hs b/src/App/Fontifier.hs index 751b7f3..e5ffbc0 100644 --- a/src/App/Fontifier.hs +++ b/src/App/Fontifier.hs @@ -11,6 +11,8 @@ import qualified Text.Regex.TDFA as Tdfa ---- Various ---- import Data.Array import Data.String +import Lens.Micro ((^.), _1, _2) + {---- Type Definitions ----} -- defines an attribute for a text slice @@ -29,6 +31,9 @@ type CheckString = String {---- Functions ----} + +{--- Top-Level Functions ---} + fontMap :: [(AttrName, Vty.Attr)] fontMap = [ (attrName "assignment" , fg Vty.blue) , (attrName "return" , fg Vty.green) @@ -36,86 +41,101 @@ fontMap = [ (attrName "assignment" , fg Vty.blue) , (attrName "comment" , fg Vty.magenta) , (attrName "string" , fg Vty.green) , (attrName "err_brackets" , bg Vty.red) -- unbalanced brackets - , (attrName "err_string" , Vty.withStyle (fg Vty.red) Vty.underline) -- unterminated strings + , (attrName "err_quotes" , Vty.withStyle (fg Vty.red) Vty.underline) -- unbalanced quotes + , (attrName "err_unterm" , Vty.withStyle (fg Vty.red) Vty.underline) -- missing ; ] fontify :: CheckString -> Fontifications fontify = concatApply [ assignments, returns - , strings - , guards, comments + , strings, guards, comments , mismatchedBrackets - , untermStrings2 - , untermStrings] + , mismatchedQuotes + , untermStrings + , untermAssignments + , untermReturns] concatApply :: [Fontifier] -> CheckString -> Fontifications concatApply [] _ = [] concatApply (f:fs) s = f s ++ concatApply fs s + + +{--- Fontifier ---} + +{-- Regex-Based Fontifier --} + -- TODO: most of the .+ don't actually allow any whitespace-like character --- maybe we should use \w instead? +-- maybe we should use \w/(:word:) instead? -assignments :: CheckString -> Fontifications -assignments = matchAttrAll "assignment" "\\**.+=.+;" +-- :: CheckString -> Fontifications +assignments = slicesToFT (attrName "assignment") . matchStripCmts "\\**.+=.+;" +guards = slicesToFT (attrName "guard") . matchStripCmts "\\[.+:.+\\]" +returns = slicesToFT (attrName "return") . matchStripCmts "\\^.+;" +strings = slicesToFT (attrName "string") . matchStripCmts "\"[^%]*\"" +comments = slicesToFT (attrName "comment") . matchAll "%.*" -guards :: CheckString -> Fontifications -guards = matchAttrAll "guard" "\\[.+:.+\\]" -returns :: CheckString -> Fontifications -returns = matchAttrAll "return" "\\^.+;" +{- Utility Functions (Regex) -} +matchAll :: RegexStr -> CheckString -> Slices +matchAll regexString bs = let regex = Tdfa.makeRegex regexString :: Tdfa.Regex + in matchesToSlices $ Tdfa.matchAll regex bs -strings :: CheckString -> Fontifications -strings = matchAttrAll "string" "\"[^%]*\"" - -comments :: CheckString -> Fontifications -comments = matchAttrAll "comment" "%.*" - -matchAttrAll :: String -> RegexStr -> CheckString -> Fontifications -matchAttrAll attribute regexString bs = - let regex = Tdfa.makeRegex regexString :: Tdfa.Regex - in matchToFT (attrName attribute) $ Tdfa.matchAll regex bs - --- Converts contents of a MatchArray (result of a regex matching) --- to a fontification with the given attribute -matchToFT :: AttrName -> MatchResult -> Fontifications -matchToFT attrName matchArray = map sliceToFT (matchesToSlices matchArray) - where sliceToFT (start,end) = FT start end attrName +matchStripCmts :: RegexStr -> CheckString -> Slices +matchStripCmts r s = stripComments $ matchAll r s + where commentsFts = comments s + stripComments [] = [] + stripComments (slice:slices) = if penetratesFT slice commentsFts + then stripComments slices + else slice: stripComments slices matchesToSlices :: MatchResult -> Slices matchesToSlices [] = [] matchesToSlices (m:ms) = let match = m ! 0 -- get 1st elem of match array (this is the whole match, which we want) in (fst match, (fst match) + (snd match)): matchesToSlices ms + + +{-- Custom/Function-Based Fontifier --} + mismatchedBrackets :: CheckString -> Fontifications mismatchedBrackets s = concatMap fontifyMismatched pairs where fontifyMismatched = mismatched (attrName "err_brackets") s pairs = [('(',')'),('[',']'),('{','}')] mismatched :: AttrName -> CheckString -> (Char, Char) -> Fontifications -mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd orphans) - where orphans = mismatched' s 0 ([],[]) - stringsFts = strings s - commentsFts = comments s +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 + checkFts = strings s ++ comments s mismatched' [] _ ophs = ophs mismatched' (curChr:restStr) ix ophs - | or $ map (isFontified (ix,ix+1)) [stringsFts, commentsFts] = mismatched' restStr (ix+1) ophs -- already fontified? -> continue - | curChr == open = mismatched' restStr (ix+1) ((ix, ix+1):(fst ophs), snd ophs) -- open? -> assume orphan + | isFontified (ix,ix+1) checkFts = mismatched' restStr (ix+1) ophs -- already fontified? -> continue + | curChr == open = mismatched' restStr (ix+1) ((ix, ix+1):(fst ophs), snd ophs) -- open? -> assume orphan until proven otherwise | curChr == close = case null (fst ophs) of - True -> mismatched' restStr (ix+1) (fst ophs, (ix,ix+1):(snd ophs)) -- close but no orphaned open? -> fix as orphan + True -> mismatched' restStr (ix+1) (fst ophs, (ix,ix+1):(snd ophs)) -- close but no orphaned open? -> close is surely an orphan False -> mismatched' restStr (ix+1) (tail (fst ophs), snd ophs) -- close and ophaned open exists? -> delete nearest orphaned open | otherwise = mismatched' restStr (ix+1) ophs -- neither open nor close? -> continue untermStrings :: CheckString -> Fontifications -untermStrings s = slicesToFT (attrName "err_string") $ lastChar untermed - where regex = Tdfa.makeRegex ("\"[^%]*\"[^\\;]"::String) :: Tdfa.Regex - commentsFts = comments s - -- strip % from commentsFts - commentsFts' [] = [] - commentsFts' (ft: fts) = FT (ftStart ft + 1) (ftEnd ft) (ftAttr ft): commentsFts' fts +untermStrings = let regex = Tdfa.makeRegex ("\"[^%]*\"[^\\;]"::String) :: Tdfa.Regex + in slicesToFT (attrName "err_unterm") . unterm regex + +untermAssignments :: CheckString -> Fontifications +untermAssignments s = let regex = Tdfa.makeRegex ("\\**[^%]+=[^;%]+[^\\;]"::String) :: Tdfa.Regex + in slicesToFT (attrName "err_unterm") . prune (assignments s) $ unterm regex s + +untermReturns :: CheckString -> Fontifications +untermReturns s = let regex = Tdfa.makeRegex ("\\^[^;%]+[^\\;]"::String) :: Tdfa.Regex + in slicesToFT (attrName "err_unterm") . prune (returns s) $ unterm regex s + + +unterm :: Tdfa.Regex -> CheckString -> Slices +unterm regex s = lastChar untermed + where commentsFts = comments s untermed = prune commentsFts $ matchesToSlices $ Tdfa.matchAll regex s -untermStrings2 :: CheckString -> Fontifications -untermStrings2 s = slicesToFT (attrName "err_string") $ firstChar untermed +mismatchedQuotes :: CheckString -> Fontifications +mismatchedQuotes s = slicesToFT (attrName "err_quotes") $ firstChar untermed where regex = Tdfa.makeRegex ("\""::String) :: Tdfa.Regex matchedSlices = matchesToSlices $ Tdfa.matchAll regex s untermed = let commentsFts = comments s; stringsFts = strings s @@ -125,6 +145,11 @@ untermStrings2 s = slicesToFT (attrName "err_string") $ firstChar untermed | not $ isFontified curSlice checkFts = curSlice: negPrune checkFts slices | otherwise = negPrune checkFts slices + + + +{-- Utility Functions (General) --} + prune :: Fontifications -> Slices -> Slices prune _ [] = [] prune checkFts (curSlice: slices) @@ -156,3 +181,12 @@ isFontified _ [] = False isFontified slice@(start,end) (f:fs) | ftStart f <= start && ftEnd f >= end = True | otherwise = isFontified slice fs + +-- checks if a slice penetrats a fontification +penetratesFT :: Slice -> Fontifications -> Bool +penetratesFT _ [] = False +penetratesFT slice@(start,end) (f:fs) + | ftStart f <= start && ftEnd f >= end = True -- yummie sandwich + | ftStart f >= start && ftStart f <= end = True -- applied backstabbing + | ftEnd f <= end && ftEnd f >= start = True -- Et tu, Brute? :( + | otherwise = penetratesFT slice fs