beautifications

src/App/Fontifier.hs

@@ -26,8 +26,26 @@ type Fontifier = (CheckString -> Fontifications)
 type Slice           = (Int,Int)
 type Slices          = [Slice]
 type MatchResult     = [Tdfa.MatchArray]
-type RegexStr = String
 type CheckString     = String
+type Regex           = Tdfa.Regex
+
+{---- Infix Operators ----}
+
+infixl 9 §:
+(§:) :: (AttrName -> a) -> String -> a
+f §: s = f $ attrName s
+
+infixl 9 §~
+(§~) :: (Regex -> a) -> String -> a
+f §~ s = f $ Tdfa.makeRegex s
+
+-- reduces precedence of (.) to work
+-- more "naturally" in combination with
+-- §: / §~ 
+infixr 8 §.
+(§.) :: (b -> c) -> (a -> b) -> a -> c
+f §. s = f . s
+
 
 {---- Functions ----}
 
@@ -60,27 +78,35 @@ 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/(:word:) instead?
-
 -- :: CheckString -> Fontifications
-assignments  = slicesToFT (attrName "assignment")  . matchStripCmts "\\**.+=.+;"
+
-guards       = slicesToFT (attrName "guard")       . matchStripCmts "\\[.+:.+\\]"
+{- Regex-Based -}
-returns      = slicesToFT (attrName "return")      . matchStripCmts "\\^.+;"
+
-strings      = slicesToFT (attrName "string")      . matchStripCmts "\"[^%]*\""
+assignments  = slicesToFT §: "assignment"  §. matchStripCmts §~ "\\**.+=.+;"
-comments     = slicesToFT (attrName "comment")     . matchAll "%.*"
+guards       = slicesToFT §: "guard"       §. matchStripCmts §~ "\\[.+:.+\\]"
+returns      = slicesToFT §: "return"      §. matchStripCmts §~ "\\^.+;"
+strings      = slicesToFT §: "string"      §. matchStripCmts §~ "\"[^%]*\""
+comments     = slicesToFT §: "comment"     §. matchAll       §~ "%.*"
 
 
-{- Utility Functions (Regex) -}
+{- Custom/Function-Based -}
-matchAll :: RegexStr -> CheckString -> Slices
-matchAll regexString bs = let regex = Tdfa.makeRegex regexString :: Tdfa.Regex
-                          in  matchesToSlices $ Tdfa.matchAll regex bs
 
-matchStripCmts :: RegexStr -> CheckString -> Slices
+untermStrings              = slicesToFT §: "err_unterm"                          §. unterm §~ "\"[^%]*\"[^\\;]"
+untermAssignments  s       = slicesToFT §: "err_unterm" §. prune (assignments s) $ (unterm §~ "\"[^%]*\"[^\\;]") s
+untermReturns      s       = slicesToFT §: "err_unterm" §. prune (returns s)     $ (unterm §~ "\\^[^;%]+[^\\;]") s
+
+mismatchedBrackets s       = concatMap (mismatched §: "err_brackets" $ s) [('(',')'),('[',']'),('{','}')]
+
+{--- Utility Functions ---}
+
+{- Regex Utilities -}
+
+matchAll :: Regex -> CheckString -> Slices
+matchAll r s = matchesToSlices $ Tdfa.matchAll r s
+
+matchStripCmts :: Regex -> CheckString -> Slices
 matchStripCmts r s = stripComments $ matchAll r s
   where commentsFts = comments s
         stripComments [] = []
@@ -94,13 +120,7 @@ matchesToSlices (m:ms) = let match = m ! 0 -- get 1st elem of match array (this
                          in (fst match, (fst match) + (snd match)): matchesToSlices ms
 
 
-
+{- Custom Fontifier Utilities -}
-{-- 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) -- (fst orphans) = open without close,
@@ -108,36 +128,26 @@ mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd
         checkFts = strings s ++ comments s
         mismatched' [] _ ophs = ophs
         mismatched' (curChr:restStr) ix ophs
-          | isFontified (ix,ix+1) checkFts = mismatched' restStr (ix+1) ophs -- already fontified? -> continue
+          | alreadyFontified  = proceedWith ophs
-          | curChr == open = mismatched' restStr (ix+1) ((ix, ix+1):(fst ophs), snd ophs) -- open? -> assume orphan until proven otherwise
+          | curChr == open    = proceedWith addOrphanedOpen            -- assume orphan until proven otherwise
-          | curChr == close = case null (fst ophs) of
+          | curChr == close   = proceedWith $ if orphanedOpenExists then adoptNearestOpen else addOrphanedClose
-              True  -> mismatched' restStr (ix+1) (fst ophs, (ix,ix+1):(snd ophs)) -- close but no orphaned open? -> close is surely an orphan
+          | otherwise         = proceedWith ophs
-              False -> mismatched' restStr (ix+1) (tail (fst ophs), snd ophs) -- close and ophaned open exists? -> delete nearest orphaned open
+          -- try just reading the cases, ignore the where
-          | otherwise = mismatched' restStr (ix+1) ophs -- neither open nor close? -> continue
+          where proceedWith = mismatched' restStr (ix+1)
+                addOrphanedOpen = ((ix,ix+1):(fst ophs), snd ophs) -- (ix,ix+1) = slice of curChr
+                addOrphanedClose = (fst ophs, (ix,ix+1):(snd ophs))
+                adoptNearestOpen = (tail (fst ophs), snd ophs) -- delete nearest orphaned open
+                orphanedOpenExists = not $ null (fst ophs)
+                alreadyFontified = isFontified (ix,ix+1) checkFts
 
-
+unterm :: Regex -> CheckString -> Slices
-untermStrings :: CheckString -> Fontifications
-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
 
 mismatchedQuotes :: CheckString -> Fontifications
-mismatchedQuotes s = slicesToFT (attrName "err_quotes") $ firstChar untermed
+mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed
-  where regex = Tdfa.makeRegex ("\""::String) :: Tdfa.Regex
+  where matchedSlices = matchesToSlices $ (Tdfa.matchAll §~ "\"") s
-        matchedSlices = matchesToSlices $ Tdfa.matchAll regex s
         untermed = let commentsFts = comments s; stringsFts = strings s
                    in negPrune (commentsFts++stringsFts) matchedSlices
         negPrune _ [] = []
@@ -148,7 +158,7 @@ mismatchedQuotes s = slicesToFT (attrName "err_quotes") $ firstChar untermed
 
 
 
-{-- Utility Functions (General) --}
+{- General Fontification Utilities -}
 
 prune :: Fontifications -> Slices -> Slices
 prune _ [] = []
@@ -168,7 +178,6 @@ firstChar [] = []
 firstChar (curSlice:slices) = let start = fst curSlice
                               in  (start, start+1): firstChar slices
 
-
 slicesToFT :: AttrName -> Slices -> Fontifications
 slicesToFT attrName slices = slicesToFT' slices
   where slicesToFT' [] = []
@@ -182,11 +191,11 @@ isFontified slice@(start,end) (f:fs)
   | ftStart f <= start && ftEnd f >= end = True
   | otherwise = isFontified slice fs
 
--- checks if a slice penetrats a fontification
+-- checks if a slice penetrates 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 
+  | otherwise = penetratesFT slice fs             -- See ya at tha crossroads