unterm checks for assignments/returns

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
+                      , strings, guards, comments
-                      , guards, comments
                       , mismatchedBrackets
-                      , untermStrings2
+                      , mismatchedQuotes
-                      , untermStrings]
+                      , 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
+-- :: CheckString -> Fontifications
-assignments = matchAttrAll "assignment" "\\**.+=.+;"
+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
+{- Utility Functions (Regex) -}
-returns = matchAttrAll "return" "\\^.+;"
+matchAll :: RegexStr -> CheckString -> Slices
+matchAll regexString bs = let regex = Tdfa.makeRegex regexString :: Tdfa.Regex
+                          in  matchesToSlices $ Tdfa.matchAll regex bs
 
-strings :: CheckString -> Fontifications
+matchStripCmts :: RegexStr -> CheckString -> Slices
-strings = matchAttrAll "string" "\"[^%]*\""
+matchStripCmts r s = stripComments $ matchAll r s
-
+  where commentsFts = comments s
-comments :: CheckString -> Fontifications
+        stripComments [] = []
-comments = matchAttrAll "comment" "%.*"
+        stripComments (slice:slices) = if penetratesFT slice commentsFts
-
+                                       then stripComments slices
-matchAttrAll :: String -> RegexStr -> CheckString -> Fontifications
+                                       else slice: stripComments slices
-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
 
 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)
+mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd orphans) -- (fst orphans) = open without close, 
-  where orphans = mismatched' s 0 ([],[])
+  where orphans = mismatched' s 0 ([],[])                                                -- (snd orphans) = close without open
-        stringsFts = strings s 
+        checkFts = strings s ++ comments s
-        commentsFts = 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
+          | 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
+          | 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
+untermStrings = let regex = Tdfa.makeRegex ("\"[^%]*\"[^\\;]"::String) :: Tdfa.Regex
-  where regex = Tdfa.makeRegex ("\"[^%]*\"[^\\;]"::String) :: Tdfa.Regex
+                in  slicesToFT (attrName "err_unterm") . unterm regex
-        commentsFts = comments s
+
-        -- strip % from commentsFts
+untermAssignments :: CheckString -> Fontifications
-        commentsFts' [] = []
+untermAssignments s = let regex = Tdfa.makeRegex ("\\**[^%]+=[^;%]+[^\\;]"::String) :: Tdfa.Regex
-        commentsFts' (ft: fts) = FT (ftStart ft + 1) (ftEnd ft) (ftAttr ft): commentsFts' fts
+                      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
+mismatchedQuotes :: CheckString -> Fontifications
-untermStrings2 s = slicesToFT (attrName "err_string") $ firstChar untermed
+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