added comments

This commit is contained in:
Armin Friedl 2016-08-29 21:44:59 +02:00
parent 077b5a3f37
commit f42368d583
3 changed files with 35 additions and 27 deletions

View file

@ -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)

View file

@ -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

View file

@ -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")