changed ByteString to String since it doesn't matter anyway for this mini editor

This commit is contained in:
Armin Friedl 2016-08-11 08:10:41 +02:00
parent 81298593c1
commit 8b5bfe2450
2 changed files with 30 additions and 13 deletions

View file

@ -17,7 +17,6 @@ import qualified Text.Regex.TDFA as Tdfa
---- Various ---- ---- Various ----
import Data.Array import Data.Array
import qualified Data.ByteString as BS
import Data.String import Data.String
{---- Type Definitions ----} {---- Type Definitions ----}
@ -33,7 +32,7 @@ fontMap :: [(AttrName, Vty.Attr)]
fontMap = [ (attrName "assignment" , fg Vty.blue) fontMap = [ (attrName "assignment" , fg Vty.blue)
, (attrName "return" , fg Vty.green) , (attrName "return" , fg Vty.green)
, (attrName "guard" , fg Vty.yellow) , (attrName "guard" , fg Vty.yellow)
, (attrName "comment" , fg Vty.green) , (attrName "comment" , fg Vty.magenta)
, (attrName "string" , fg Vty.green) , (attrName "string" , fg Vty.green)
, (attrName "err_braces" , fg Vty.red) -- unbalanced braces , (attrName "err_braces" , fg Vty.red) -- unbalanced braces
, (attrName "err_string" , fg Vty.red) -- unterminated strings , (attrName "err_string" , fg Vty.red) -- unterminated strings
@ -41,23 +40,41 @@ fontMap = [ (attrName "assignment" , fg Vty.blue)
-- calls the fontification functions -- calls the fontification functions
-- and returns a list of attributes for text slices -- 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 :: String -> [Fontification]
fontify s = concat [guards bs, returns bs, strings bs, comments bs] fontify = concatApply [guards, returns, strings, comments]
where bs = fromString s
guards :: BS.ByteString -> [Fontification]
guards = matchAttrAll "guard" "\\[.*:.*\\]"
returns :: BS.ByteString -> [Fontification] -- applies the function in order
returns = matchAttrAll "return" "\\^.*;" -- 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" "\".*\"" strings = matchAttrAll "string" "\".*\""
comments :: BS.ByteString -> [Fontification] comments :: String -> [Fontification]
comments = matchAttrAll "comment" "%.*\n" comments = matchAttrAll "comment" "%.*\n"
matchAttrAll :: String -> String -> BS.ByteString -> [Fontification] matchAttrAll :: String -> String -> String -> [Fontification]
matchAttrAll attribute regexString bs = matchAttrAll attribute regexString bs =
let regex = Tdfa.makeRegex regexString :: Tdfa.Regex let regex = Tdfa.makeRegex regexString :: Tdfa.Regex
in matchToFT (attrName attribute) $ Tdfa.matchAll regex bs in matchToFT (attrName attribute) $ Tdfa.matchAll regex bs
@ -73,5 +90,5 @@ matchToFT attrName matchArray = matchToFT' matchArray
end = (fst match) + (snd match) end = (fst match) + (snd match)
in FT {ftStart = start, ftEnd = end, ftAttr = attrName} : matchToFT' ms in FT {ftStart = start, ftEnd = end, ftAttr = attrName} : matchToFT' ms
mismatchedBrackets :: BS.ByteString -> [Fontification] mismatchedBrackets :: String -> [Fontification]
mismatchedBrackets bs = [] mismatchedBrackets bs = []

View file

@ -135,7 +135,7 @@ handleEvent st ev
return $ st & file .~ f -- replaces old state return $ st & file .~ f -- replaces old state
& hedit .~ EditWidget.editor Hedit drawHeditText Nothing content -- with new text/file & 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 -> HeditState -> HeditState
insertString string st = st & hedit %~ insertString' string -- uses some fancy lense magic insertString string st = st & hedit %~ insertString' string -- uses some fancy lense magic
where insertString' [] e = e where insertString' [] e = e