changed ByteString to String since it doesn't matter anyway for this mini editor
This commit is contained in:
parent
81298593c1
commit
8b5bfe2450
2 changed files with 30 additions and 13 deletions
|
@ -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 = []
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue