unterm checks for assignments/returns
This commit is contained in:
Armin Friedl
parent
5a5ae4d92d
commit
e9aaddc974
1 changed files with 77 additions and 43 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue