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 ----}
|
||||
|
||||
-- Creates a AttrName type from a String
|
||||
-- Partially applies the AttrName to a
|
||||
-- function
|
||||
infixl 9 §:
|
||||
(§:) :: (AttrName -> a) -> String -> a
|
||||
f §: s = f $ attrName s
|
||||
|
||||
-- Creates a RegEx type from a string
|
||||
-- Partially applies the RegEx to a
|
||||
-- function
|
||||
infixl 9 §~
|
||||
(§~) :: (Regex -> a) -> String -> a
|
||||
f §~ s = f $ Tdfa.makeRegex s
|
||||
|
@ -58,6 +64,7 @@ f §. s = f . s
|
|||
|
||||
{--- Top-Level Functions ---}
|
||||
|
||||
-- Defines names for fontification specifications
|
||||
fontMap :: [(AttrName, Vty.Attr)]
|
||||
fontMap = [ (attrName "assignment" , fg Vty.blue)
|
||||
, (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)
|
||||
]
|
||||
|
||||
-- Applies fontification function and merges
|
||||
-- result into a single list of [Fontifiation]
|
||||
fontify :: CheckString -> Fontifications
|
||||
fontify = concatApply [ assignments, strings
|
||||
, returns, guards, comments
|
||||
|
@ -99,12 +108,6 @@ guards = slicesToFT §: "guard" §. matchGrpStripCmts 1 §~ "\\[([^
|
|||
{- Custom/Function-Based -}
|
||||
|
||||
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
|
||||
slicesToFT §: "warn_access" $ strip $ invalidAccesses s
|
||||
|
||||
|
@ -112,15 +115,23 @@ warnAccess s = let strip = prune $ (comments s) ++ (strings s) in
|
|||
|
||||
{- Regex Utilities -}
|
||||
|
||||
-- Gets the all regex matches for regexes without
|
||||
-- capture groups
|
||||
matchAll :: Regex -> CheckString -> Slices
|
||||
matchAll = matchGrpAll 0
|
||||
|
||||
-- Same as matchAll but returns slices of given
|
||||
-- capture group only
|
||||
matchGrpAll :: Int -> Regex -> CheckString -> Slices
|
||||
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 = matchGrpStripCmts 0
|
||||
|
||||
-- like matchStripCmts but for a given
|
||||
-- caputre group only
|
||||
matchGrpStripCmts :: Int -> Regex -> CheckString -> Slices
|
||||
matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r s
|
||||
where commentsFts = comments s
|
||||
|
@ -129,9 +140,13 @@ matchGrpStripCmts g r s = stripComments $ matchesGrpToSlices g $ Tdfa.matchAll r
|
|||
then stripComments slices
|
||||
else slice: stripComments slices
|
||||
|
||||
-- Creates list of start/end indices
|
||||
-- from a regex MatchResult
|
||||
matchesToSlices :: MatchResult -> Slices
|
||||
matchesToSlices = matchesGrpToSlices 0
|
||||
|
||||
-- same as matchesToSlice but for a given
|
||||
-- capture group only
|
||||
matchesGrpToSlices :: Int -> MatchResult -> Slices
|
||||
matchesGrpToSlices _ [] = []
|
||||
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 -}
|
||||
|
||||
-- Finds and fontifies mismatched things
|
||||
-- required matches are given by (Char,Char)
|
||||
mismatched :: AttrName -> CheckString -> (Char, Char) -> Fontifications
|
||||
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
|
||||
|
@ -157,11 +174,7 @@ mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd
|
|||
orphanedOpenExists = not $ null (fst ophs)
|
||||
alreadyFontified = isFontified (ix,ix+1) checkFts
|
||||
|
||||
unterm :: Regex -> CheckString -> Slices
|
||||
unterm regex s = lastChar untermed
|
||||
where commentsFts = comments s
|
||||
untermed = prune commentsFts $ matchesToSlices $ Tdfa.matchAll regex s
|
||||
|
||||
-- finds mismatched quotes
|
||||
mismatchedQuotes :: CheckString -> Fontifications
|
||||
mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed
|
||||
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
|
||||
| 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
|
||||
invalidAccesses = invAcc [] 0
|
||||
|
||||
-- (alternative if easier than invalid read/invalid write separated)
|
||||
-- :: CurrentAssignments -> AccumulatorString -> GlobalIndex
|
||||
-- :: CurrentAssignments -> GlobalIndex
|
||||
invAcc :: [(String,Slice,Bool)] -> Int -> CheckString -> Slices
|
||||
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) = 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)
|
||||
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)
|
||||
where g = length $ fst $ fromJust $ getRead 0 t
|
||||
invAcc a i ('"':t) = invAcc a (i+1 + g) (drop g t)
|
||||
|
|
|
@ -56,14 +56,15 @@ makeLenses ''HeditState
|
|||
|
||||
{---- Functions ----}
|
||||
|
||||
-- Start the editor widget
|
||||
runEditor :: FilePath -> IO ()
|
||||
runEditor f = do
|
||||
exists <- doesFileExist f
|
||||
content <- if exists then readFile f else return []
|
||||
st <- BrickMain.defaultMain theApp (initialState f content)
|
||||
-- putStr $ unpack $ toText $ createMarkup [] $ unlines $ EditWidget.getEditContents $ st^.hedit
|
||||
return ()
|
||||
|
||||
-- Configure the editor widget
|
||||
theApp :: App HeditState Vty.Event Names
|
||||
theApp = App { appDraw = drawUI
|
||||
, appChooseCursor = showFirstCursor
|
||||
|
@ -95,6 +96,7 @@ getAttrMap :: AttrMap
|
|||
getAttrMap = foldl merge uiMap [Fontifier.fontMap]
|
||||
where merge map list = applyAttrMappings list map -- just reverses arguments of apply
|
||||
|
||||
-- Draws the editor widget (static header + content)
|
||||
drawUI :: HeditState -> [Widget Names]
|
||||
drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget]
|
||||
-- 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
|
||||
-- 1 line high
|
||||
|
||||
-- Handles input (characters+commands)
|
||||
handleEvent :: HeditState -> Vty.Event -> EventM Names (Next HeditState)
|
||||
handleEvent st ev
|
||||
| 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
|
||||
where insertChar = EditWidget.applyEdit (TextZipper.insertChar a) e
|
||||
|
||||
-- Puts the fontified text into editor widget
|
||||
drawHeditText :: [String] -> Widget n
|
||||
drawHeditText lines = makeWidget $ makeMarkup $ getFontification text
|
||||
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
|
||||
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 text fontification = fontifyToMarkup' baseMarkup fontification
|
||||
-- fromText marks the given text with the default markup
|
||||
|
|
|
@ -4,6 +4,9 @@ import Control.Monad (when)
|
|||
import Gui (runEditor)
|
||||
import System.Environment (getArgs)
|
||||
|
||||
-- Entry point
|
||||
-- Reads argument (file to open), starts editor
|
||||
-- Fails with usage message if no file specified
|
||||
main = do
|
||||
args <- getArgs
|
||||
when (null args) $ error (msgWithUsage "Please specify a file")
|
||||
|
|
Loading…
Reference in a new issue