added comments
This commit is contained in:
parent
077b5a3f37
commit
f42368d583
3 changed files with 35 additions and 27 deletions
|
@ -37,10 +37,16 @@ type Regex = Tdfa.Regex
|
||||||
|
|
||||||
{---- Infix Operators ----}
|
{---- Infix Operators ----}
|
||||||
|
|
||||||
|
-- Creates a AttrName type from a String
|
||||||
|
-- Partially applies the AttrName to a
|
||||||
|
-- function
|
||||||
infixl 9 §:
|
infixl 9 §:
|
||||||
(§:) :: (AttrName -> a) -> String -> a
|
(§:) :: (AttrName -> a) -> String -> a
|
||||||
f §: s = f $ attrName s
|
f §: s = f $ attrName s
|
||||||
|
|
||||||
|
-- Creates a RegEx type from a string
|
||||||
|
-- Partially applies the RegEx to a
|
||||||
|
-- function
|
||||||
infixl 9 §~
|
infixl 9 §~
|
||||||
(§~) :: (Regex -> a) -> String -> a
|
(§~) :: (Regex -> a) -> String -> a
|
||||||
f §~ s = f $ Tdfa.makeRegex s
|
f §~ s = f $ Tdfa.makeRegex s
|
||||||
|
@ -58,6 +64,7 @@ f §. s = f . s
|
||||||
|
|
||||||
{--- Top-Level Functions ---}
|
{--- Top-Level Functions ---}
|
||||||
|
|
||||||
|
-- Defines names for fontification specifications
|
||||||
fontMap :: [(AttrName, Vty.Attr)]
|
fontMap :: [(AttrName, Vty.Attr)]
|
||||||
fontMap = [ (attrName "assignment" , fg Vty.blue)
|
fontMap = [ (attrName "assignment" , fg Vty.blue)
|
||||||
, (attrName "return" , Vty.withStyle (fg Vty.green) Vty.bold)
|
, (attrName "return" , Vty.withStyle (fg Vty.green) Vty.bold)
|
||||||
|
@ -71,6 +78,8 @@ fontMap = [ (attrName "assignment" , fg Vty.blue)
|
||||||
, (attrName "warn_access" , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated)
|
, (attrName "warn_access" , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- Applies fontification function and merges
|
||||||
|
-- result into a single list of [Fontifiation]
|
||||||
fontify :: CheckString -> Fontifications
|
fontify :: CheckString -> Fontifications
|
||||||
fontify = concatApply [ assignments, strings
|
fontify = concatApply [ assignments, strings
|
||||||
, returns, guards, comments
|
, returns, guards, comments
|
||||||
|
@ -99,12 +108,6 @@ guards = slicesToFT §: "guard" §. matchGrpStripCmts 1 §~ "\\[([^
|
||||||
{- Custom/Function-Based -}
|
{- Custom/Function-Based -}
|
||||||
|
|
||||||
mismatchedBrackets s = concatMap (mismatched §: "err_brackets" $ s) [('(',')'),('[',']'),('{','}')]
|
mismatchedBrackets s = concatMap (mismatched §: "err_brackets" $ s) [('(',')'),('[',']'),('{','}')]
|
||||||
|
|
||||||
-- warnAccess s = let strip = prune $ (comments s) ++ (strings s) in -- removes strings and comments from fontification
|
|
||||||
-- (slicesToFT §: "warn_read" $ strip $ invalidReads s) ++
|
|
||||||
-- (slicesToFT §: "warn_write" $ strip $ invalidWrites s)
|
|
||||||
|
|
||||||
-- (alternative if easier than invalid read/invalid write separated)
|
|
||||||
warnAccess s = let strip = prune $ (comments s) ++ (strings s) in
|
warnAccess s = let strip = prune $ (comments s) ++ (strings s) in
|
||||||
slicesToFT §: "warn_access" $ strip $ invalidAccesses s
|
slicesToFT §: "warn_access" $ strip $ invalidAccesses s
|
||||||
|
|
||||||
|
@ -112,15 +115,23 @@ warnAccess s = let strip = prune $ (comments s) ++ (strings s) in
|
||||||
|
|
||||||
{- Regex Utilities -}
|
{- Regex Utilities -}
|
||||||
|
|
||||||
|
-- Gets the all regex matches for regexes without
|
||||||
|
-- capture groups
|
||||||
matchAll :: Regex -> CheckString -> Slices
|
matchAll :: Regex -> CheckString -> Slices
|
||||||
matchAll = matchGrpAll 0
|
matchAll = matchGrpAll 0
|
||||||
|
|
||||||
|
-- Same as matchAll but returns slices of given
|
||||||
|
-- capture group only
|
||||||
matchGrpAll :: Int -> Regex -> CheckString -> Slices
|
matchGrpAll :: Int -> Regex -> CheckString -> Slices
|
||||||
matchGrpAll g r s = matchesGrpToSlices g $ Tdfa.matchAll r s
|
matchGrpAll g r s = matchesGrpToSlices g $ Tdfa.matchAll r s
|
||||||
|
|
||||||
|
-- like matchAll but strips matches that happen
|
||||||
|
-- to be inside a string
|
||||||
matchStripCmts :: Regex -> CheckString -> Slices
|
matchStripCmts :: Regex -> CheckString -> Slices
|
||||||
matchStripCmts = matchGrpStripCmts 0
|
matchStripCmts = matchGrpStripCmts 0
|
||||||
|
|
||||||
|
-- like matchStripCmts but for a given
|
||||||
|
-- caputre group only
|
||||||
matchGrpStripCmts :: Int -> Regex -> CheckString -> Slices
|
matchGrpStripCmts :: Int -> Regex -> CheckString -> Slices
|
||||||
matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r s
|
matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r s
|
||||||
where commentsFts = comments s
|
where commentsFts = comments s
|
||||||
|
@ -129,9 +140,13 @@ matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r
|
||||||
then stripComments slices
|
then stripComments slices
|
||||||
else slice: stripComments slices
|
else slice: stripComments slices
|
||||||
|
|
||||||
|
-- Creates list of start/end indices
|
||||||
|
-- from a regex MatchResult
|
||||||
matchesToSlices :: MatchResult -> Slices
|
matchesToSlices :: MatchResult -> Slices
|
||||||
matchesToSlices = matchesGrpToSlices 0
|
matchesToSlices = matchesGrpToSlices 0
|
||||||
|
|
||||||
|
-- same as matchesToSlice but for a given
|
||||||
|
-- capture group only
|
||||||
matchesGrpToSlices :: Int -> MatchResult -> Slices
|
matchesGrpToSlices :: Int -> MatchResult -> Slices
|
||||||
matchesGrpToSlices _ [] = []
|
matchesGrpToSlices _ [] = []
|
||||||
matchesGrpToSlices group (m:ms) = let match = m ! group -- extract the match group (0 = the whole match)
|
matchesGrpToSlices group (m:ms) = let match = m ! group -- extract the match group (0 = the whole match)
|
||||||
|
@ -139,6 +154,8 @@ matchesGrpToSlices group (m:ms) = let match = m ! group -- extract the match gro
|
||||||
|
|
||||||
{- Utilities for Custom Fontifiers -}
|
{- Utilities for Custom Fontifiers -}
|
||||||
|
|
||||||
|
-- Finds and fontifies mismatched things
|
||||||
|
-- required matches are given by (Char,Char)
|
||||||
mismatched :: AttrName -> CheckString -> (Char, Char) -> Fontifications
|
mismatched :: AttrName -> CheckString -> (Char, Char) -> Fontifications
|
||||||
mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd orphans) -- (fst orphans) = open without close,
|
mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd orphans) -- (fst orphans) = open without close,
|
||||||
where orphans = mismatched' s 0 ([],[]) -- (snd orphans) = close without open
|
where orphans = mismatched' s 0 ([],[]) -- (snd orphans) = close without open
|
||||||
|
@ -157,11 +174,7 @@ mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd
|
||||||
orphanedOpenExists = not $ null (fst ophs)
|
orphanedOpenExists = not $ null (fst ophs)
|
||||||
alreadyFontified = isFontified (ix,ix+1) checkFts
|
alreadyFontified = isFontified (ix,ix+1) checkFts
|
||||||
|
|
||||||
unterm :: Regex -> CheckString -> Slices
|
-- finds mismatched quotes
|
||||||
unterm regex s = lastChar untermed
|
|
||||||
where commentsFts = comments s
|
|
||||||
untermed = prune commentsFts $ matchesToSlices $ Tdfa.matchAll regex s
|
|
||||||
|
|
||||||
mismatchedQuotes :: CheckString -> Fontifications
|
mismatchedQuotes :: CheckString -> Fontifications
|
||||||
mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed
|
mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed
|
||||||
where matchedSlices = matchesToSlices $ (Tdfa.matchAll §~ "\"") s
|
where matchedSlices = matchesToSlices $ (Tdfa.matchAll §~ "\"") s
|
||||||
|
@ -172,30 +185,16 @@ mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed
|
||||||
| not $ isFontified curSlice checkFts = curSlice: negPrune checkFts slices
|
| not $ isFontified curSlice checkFts = curSlice: negPrune checkFts slices
|
||||||
| otherwise = negPrune checkFts slices
|
| otherwise = negPrune checkFts slices
|
||||||
|
|
||||||
-- ::CheckString -> Slices == ::String -> [(Int,Int)]
|
|
||||||
--invalidReads :: CheckString -> Slices
|
|
||||||
invalidReads s = [] -- do magic here
|
|
||||||
|
|
||||||
--invalidWrites :: CheckString -> Slices
|
|
||||||
invalidWrites s = [] -- do magic here
|
|
||||||
|
|
||||||
-- facade to init invAcc
|
-- facade to init invAcc
|
||||||
invalidAccesses = invAcc [] 0
|
invalidAccesses = invAcc [] 0
|
||||||
|
|
||||||
-- (alternative if easier than invalid read/invalid write separated)
|
-- :: CurrentAssignments -> GlobalIndex
|
||||||
-- :: CurrentAssignments -> AccumulatorString -> GlobalIndex
|
|
||||||
invAcc :: [(String,Slice,Bool)] -> Int -> CheckString -> Slices
|
invAcc :: [(String,Slice,Bool)] -> Int -> CheckString -> Slices
|
||||||
invAcc a i ('{':t) = invAcc (enterBlock a) (i+1) t
|
invAcc a i ('{':t) = invAcc (enterBlock a) (i+1) t
|
||||||
invAcc a i ('}':t) = getUnread a ++ invAcc (leaveBlock a) (i+1) t
|
invAcc a i ('}':t) = getUnread a ++ invAcc (leaveBlock a) (i+1) t
|
||||||
invAcc a i ('[':t) = map snd (filter (\x -> isUnassigned x a) r) ++ invAcc (markReads r a) (i+1 + g) (drop g t) -- TODO check reads in first part
|
invAcc a i ('[':t) = map snd (filter (\x -> isUnassigned x a) r) ++ invAcc (markReads r a) (i+1 + g) (drop g t) -- TODO check reads in first part
|
||||||
where g = fromJust (elemIndex ':' t)
|
where g = fromJust (elemIndex ':' t)
|
||||||
r = getReads (i+1) (take g t)
|
r = getReads (i+1) (take g t)
|
||||||
-- when reading an assignment :word: =
|
|
||||||
-- put :word:, slice, false in the list
|
|
||||||
-- when reading a read access scan the list for the variable
|
|
||||||
-- if it is found set its boolean value to true
|
|
||||||
-- if it is not found add its slice to the result
|
|
||||||
-- all variables with false at the end of a block are unused
|
|
||||||
invAcc a i ('.':t) = invAcc a (i+1 + g) (drop g t)
|
invAcc a i ('.':t) = invAcc a (i+1 + g) (drop g t)
|
||||||
where g = length $ fst $ fromJust $ getRead 0 t
|
where g = length $ fst $ fromJust $ getRead 0 t
|
||||||
invAcc a i ('"':t) = invAcc a (i+1 + g) (drop g t)
|
invAcc a i ('"':t) = invAcc a (i+1 + g) (drop g t)
|
||||||
|
|
|
@ -56,14 +56,15 @@ makeLenses ''HeditState
|
||||||
|
|
||||||
{---- Functions ----}
|
{---- Functions ----}
|
||||||
|
|
||||||
|
-- Start the editor widget
|
||||||
runEditor :: FilePath -> IO ()
|
runEditor :: FilePath -> IO ()
|
||||||
runEditor f = do
|
runEditor f = do
|
||||||
exists <- doesFileExist f
|
exists <- doesFileExist f
|
||||||
content <- if exists then readFile f else return []
|
content <- if exists then readFile f else return []
|
||||||
st <- BrickMain.defaultMain theApp (initialState f content)
|
st <- BrickMain.defaultMain theApp (initialState f content)
|
||||||
-- putStr $ unpack $ toText $ createMarkup [] $ unlines $ EditWidget.getEditContents $ st^.hedit
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
-- Configure the editor widget
|
||||||
theApp :: App HeditState Vty.Event Names
|
theApp :: App HeditState Vty.Event Names
|
||||||
theApp = App { appDraw = drawUI
|
theApp = App { appDraw = drawUI
|
||||||
, appChooseCursor = showFirstCursor
|
, appChooseCursor = showFirstCursor
|
||||||
|
@ -95,6 +96,7 @@ getAttrMap :: AttrMap
|
||||||
getAttrMap = foldl merge uiMap [Fontifier.fontMap]
|
getAttrMap = foldl merge uiMap [Fontifier.fontMap]
|
||||||
where merge map list = applyAttrMappings list map -- just reverses arguments of apply
|
where merge map list = applyAttrMappings list map -- just reverses arguments of apply
|
||||||
|
|
||||||
|
-- Draws the editor widget (static header + content)
|
||||||
drawUI :: HeditState -> [Widget Names]
|
drawUI :: HeditState -> [Widget Names]
|
||||||
drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget]
|
drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget]
|
||||||
-- the where is a bit ugly, for an intuitive understanding just don't look at it
|
-- the where is a bit ugly, for an intuitive understanding just don't look at it
|
||||||
|
@ -111,6 +113,7 @@ drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget]
|
||||||
-- that spans the whole width
|
-- that spans the whole width
|
||||||
-- 1 line high
|
-- 1 line high
|
||||||
|
|
||||||
|
-- Handles input (characters+commands)
|
||||||
handleEvent :: HeditState -> Vty.Event -> EventM Names (Next HeditState)
|
handleEvent :: HeditState -> Vty.Event -> EventM Names (Next HeditState)
|
||||||
handleEvent st ev
|
handleEvent st ev
|
||||||
| ev `elem` [esc, ctrl 'c'] = quit
|
| ev `elem` [esc, ctrl 'c'] = quit
|
||||||
|
@ -143,6 +146,7 @@ insertString string st = st & hedit %~ insertString' string -- uses some fancy l
|
||||||
-- inserts char a, returns resulting editor
|
-- inserts char a, returns resulting editor
|
||||||
where insertChar = EditWidget.applyEdit (TextZipper.insertChar a) e
|
where insertChar = EditWidget.applyEdit (TextZipper.insertChar a) e
|
||||||
|
|
||||||
|
-- Puts the fontified text into editor widget
|
||||||
drawHeditText :: [String] -> Widget n
|
drawHeditText :: [String] -> Widget n
|
||||||
drawHeditText lines = makeWidget $ makeMarkup $ getFontification text
|
drawHeditText lines = makeWidget $ makeMarkup $ getFontification text
|
||||||
where makeWidget = markup -- just a synonym for Brick.Markup.markup
|
where makeWidget = markup -- just a synonym for Brick.Markup.markup
|
||||||
|
@ -150,6 +154,8 @@ drawHeditText lines = makeWidget $ makeMarkup $ getFontification text
|
||||||
getFontification = Fontifier.fontify -- just a synonym
|
getFontification = Fontifier.fontify -- just a synonym
|
||||||
makeMarkup = fontifyToMarkup text -- curried fontifyToMarkup; needs an additional fontification list only
|
makeMarkup = fontifyToMarkup text -- curried fontifyToMarkup; needs an additional fontification list only
|
||||||
|
|
||||||
|
-- Creates a markup specification for the text from
|
||||||
|
-- Fontification definitions
|
||||||
fontifyToMarkup :: String -> [Fontification] -> Markup AttrName
|
fontifyToMarkup :: String -> [Fontification] -> Markup AttrName
|
||||||
fontifyToMarkup text fontification = fontifyToMarkup' baseMarkup fontification
|
fontifyToMarkup text fontification = fontifyToMarkup' baseMarkup fontification
|
||||||
-- fromText marks the given text with the default markup
|
-- fromText marks the given text with the default markup
|
||||||
|
|
|
@ -4,6 +4,9 @@ import Control.Monad (when)
|
||||||
import Gui (runEditor)
|
import Gui (runEditor)
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
|
|
||||||
|
-- Entry point
|
||||||
|
-- Reads argument (file to open), starts editor
|
||||||
|
-- Fails with usage message if no file specified
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
when (null args) $ error (msgWithUsage "Please specify a file")
|
when (null args) $ error (msgWithUsage "Please specify a file")
|
||||||
|
|
Loading…
Reference in a new issue