diff --git a/src/App/Fontifier.hs b/src/App/Fontifier.hs index f5a4832..b20f197 100644 --- a/src/App/Fontifier.hs +++ b/src/App/Fontifier.hs @@ -17,7 +17,6 @@ import qualified Text.Regex.TDFA as Tdfa ---- Various ---- import Data.Array -import qualified Data.ByteString as BS import Data.String {---- Type Definitions ----} @@ -33,7 +32,7 @@ fontMap :: [(AttrName, Vty.Attr)] fontMap = [ (attrName "assignment" , fg Vty.blue) , (attrName "return" , fg Vty.green) , (attrName "guard" , fg Vty.yellow) - , (attrName "comment" , fg Vty.green) + , (attrName "comment" , fg Vty.magenta) , (attrName "string" , fg Vty.green) , (attrName "err_braces" , fg Vty.red) -- unbalanced braces , (attrName "err_string" , fg Vty.red) -- unterminated strings @@ -41,23 +40,41 @@ fontMap = [ (attrName "assignment" , fg Vty.blue) -- calls the fontification functions -- and returns a list of attributes for text slices +-- fontification functions must take an IsString +-- (either a ByteString, Text or normal String) and +-- return a [Fontification] list fontify :: String -> [Fontification] -fontify s = concat [guards bs, returns bs, strings bs, comments bs] - where bs = fromString s +fontify = concatApply [guards, returns, strings, comments] -guards :: BS.ByteString -> [Fontification] -guards = matchAttrAll "guard" "\\[.*:.*\\]" -returns :: BS.ByteString -> [Fontification] -returns = matchAttrAll "return" "\\^.*;" +-- applies the function in order +-- the fontification of the last function overrules +-- all previous ones in case more than one matches, +-- the last function has the highest precedence +-- can be useful to make e.g. comments "stronger" than strings +-- a string in a comment is then fontified as comment +concatApply :: [(String -> [Fontification])] -> String -> [Fontification] +concatApply [] _ = [] +concatApply (f:fs) s = (f $ fromString s) ++ concatApply fs s -strings :: BS.ByteString -> [Fontification] +-- the same as concatApply just that the first function +-- in the list has the highest precedence +concatRevply :: [(String -> [Fontification])] -> String -> [Fontification] +concatRevply fs = concatApply (reverse fs) + +guards :: String -> [Fontification] +guards = matchAttrAll "guard" "\\[.+:.+\\]" + +returns :: String -> [Fontification] +returns = matchAttrAll "return" "\\^.+;" + +strings :: String -> [Fontification] strings = matchAttrAll "string" "\".*\"" -comments :: BS.ByteString -> [Fontification] +comments :: String -> [Fontification] comments = matchAttrAll "comment" "%.*\n" -matchAttrAll :: String -> String -> BS.ByteString -> [Fontification] +matchAttrAll :: String -> String -> String -> [Fontification] matchAttrAll attribute regexString bs = let regex = Tdfa.makeRegex regexString :: Tdfa.Regex in matchToFT (attrName attribute) $ Tdfa.matchAll regex bs @@ -73,5 +90,5 @@ matchToFT attrName matchArray = matchToFT' matchArray end = (fst match) + (snd match) in FT {ftStart = start, ftEnd = end, ftAttr = attrName} : matchToFT' ms -mismatchedBrackets :: BS.ByteString -> [Fontification] +mismatchedBrackets :: String -> [Fontification] mismatchedBrackets bs = [] diff --git a/src/App/Gui.hs b/src/App/Gui.hs index 6b6d1e3..22a0931 100644 --- a/src/App/Gui.hs +++ b/src/App/Gui.hs @@ -135,7 +135,7 @@ handleEvent st ev return $ st & file .~ f -- replaces old state & hedit .~ EditWidget.editor Hedit drawHeditText Nothing content -- with new text/file --- just don't ask what this does --- inserts a string, returns the state. end of story. +-- inserts a string, returns the state insertString :: String -> HeditState -> HeditState insertString string st = st & hedit %~ insertString' string -- uses some fancy lense magic where insertString' [] e = e