Refactoring, 25% speedup.

* Checks now use Writer monad instead of State

* Parser no longer emits notes unrelated to parsing.

* All checks are now passed a parameter value, containing shell type,
  map from notes to parents and such. This eliminates recalculation
  and removes the need for a special group of parent examining checks.
This commit is contained in:
Vidar Holen 2014-02-02 04:59:17 -08:00
parent 8ec9fa43fd
commit 76a39f254b
4 changed files with 388 additions and 377 deletions

File diff suppressed because it is too large Load Diff

View File

@ -17,7 +17,7 @@
-} -}
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction #-}
module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), notesFromMap, Metadata(..), sortNotes) where module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote) where
import ShellCheck.AST import ShellCheck.AST
import ShellCheck.Data import ShellCheck.Data
@ -98,20 +98,20 @@ nbsp = do
return ' ' return ' '
--------- Message/position annotation on top of user state --------- Message/position annotation on top of user state
data Note = Note Severity Code String deriving (Show, Eq) data Note = Note Id Severity Code String deriving (Show, Eq)
data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq) data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq)
data Metadata = Metadata SourcePos [Note] deriving (Show)
data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord) data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord)
data Context = ContextName SourcePos String | ContextAnnotation [Annotation] data Context = ContextName SourcePos String | ContextAnnotation [Annotation]
type Code = Integer type Code = Integer
codeForNote (Note _ code _) = code
codeForParseNote (ParseNote _ _ code _) = code codeForParseNote (ParseNote _ _ code _) = code
noteToParseNote map (Note id severity code message) =
ParseNote pos severity code message
where
pos = fromJust $ Map.lookup id map
initialState = (Id $ -1, Map.empty, []) initialState = (Id $ -1, Map.empty, [])
getInitialMeta pos = Metadata pos []
getLastId = do getLastId = do
(id, _, _) <- getState (id, _, _) <- getState
return id return id
@ -119,7 +119,7 @@ getLastId = do
getNextIdAt sourcepos = do getNextIdAt sourcepos = do
(id, map, notes) <- getState (id, map, notes) <- getState
let newId = incId id let newId = incId id
let newMap = Map.insert newId (getInitialMeta sourcepos) map let newMap = Map.insert newId sourcepos map
putState (newId, newMap, notes) putState (newId, newMap, notes)
return newId return newId
where incId (Id n) = (Id $ n+1) where incId (Id n) = (Id $ n+1)
@ -187,11 +187,6 @@ parseProblemAt pos level code msg = do
Ms.modify (\(list, current) -> ((ParseNote pos level code msg):list, current)) Ms.modify (\(list, current) -> ((ParseNote pos level code msg):list, current))
-- Store non-parse problems inside -- Store non-parse problems inside
addNoteFor id note = modifyMap $ Map.adjust (\(Metadata pos notes) -> Metadata pos (note:notes)) id
addNote note = do
id <- getLastId
addNoteFor id note
parseNote c l a = do parseNote c l a = do
pos <- getPosition pos <- getPosition
@ -331,8 +326,6 @@ readConditionContents single = do
readCondAndOp = do readCondAndOp = do
id <- getNextId id <- getNextId
x <- try (string "&&" <|> string "-a") x <- try (string "&&" <|> string "-a")
when (single && x == "&&") $ addNoteFor id $ Note ErrorC 1022 "You can't use && inside [..]. Use [[..]] instead."
when (not single && x == "-a") $ addNoteFor id $ Note ErrorC 1023 "In [[..]], use && instead of -a."
softCondSpacing softCondSpacing
return $ TC_And id typ x return $ TC_And id typ x
@ -340,8 +333,6 @@ readConditionContents single = do
optional guardArithmetic optional guardArithmetic
id <- getNextId id <- getNextId
x <- try (string "||" <|> string "-o") x <- try (string "||" <|> string "-o")
when (single && x == "||") $ addNoteFor id $ Note ErrorC 1024 "You can't use || inside [..]. Use [[..]] instead."
when (not single && x == "-o") $ addNoteFor id $ Note ErrorC 1025 "In [[..]], use || instead of -o."
softCondSpacing softCondSpacing
return $ TC_Or id typ x return $ TC_Or id typ x
@ -1885,7 +1876,7 @@ isOk p s = (fst cs) && (null . snd $ cs) where cs = checkString p s
checkString parser string = checkString parser string =
case rp (parser >> eof >> getState) "-" string of case rp (parser >> eof >> getState) "-" string of
(Right (tree, map, notes), (problems, _)) -> (True, (notesFromMap map) ++ notes ++ problems) (Right (tree, map, notes), (problems, _)) -> (True, notes ++ problems)
(Left _, (n, _)) -> (False, n) (Left _, (n, _)) -> (False, n)
parseWithNotes parser = do parseWithNotes parser = do
@ -1894,16 +1885,11 @@ parseWithNotes parser = do
parseNotes <- getParseNotes parseNotes <- getParseNotes
return (item, map, nub . sortNotes $ parseNotes) return (item, map, nub . sortNotes $ parseNotes)
toParseNotes (Metadata pos list) = map (\(Note level code note) -> ParseNote pos level code note) list
notesFromMap map = Map.fold (\x -> (++) (toParseNotes x)) [] map
getAllNotes result = (concatMap (notesFromMap . snd) (maybeToList . parseResult $ result)) ++ (parseNotes result)
compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare (pos1, level1) (pos2, level2) compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare (pos1, level1) (pos2, level2)
sortNotes = sortBy compareNotes sortNotes = sortBy compareNotes
data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id Metadata), parseNotes :: [ParseNote] } deriving (Show) data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id SourcePos), parseNotes :: [ParseNote] } deriving (Show)
makeErrorFor parsecError = makeErrorFor parsecError =
ParseNote (errorPos parsecError) ErrorC 1072 $ getStringFromParsec $ errorMessages parsecError ParseNote (errorPos parsecError) ErrorC 1072 $ getStringFromParsec $ errorMessages parsecError
@ -1923,9 +1909,11 @@ getStringFromParsec errors =
parseShell filename contents = do parseShell filename contents = do
case rp (parseWithNotes readScript) filename contents of case rp (parseWithNotes readScript) filename contents of
(Right (script, map, notes), (parsenotes, _)) -> ParseResult (Just (script, map)) (nub $ sortNotes $ notes ++ parsenotes) (Right (script, map, notes), (parsenotes, _)) ->
(Left err, (p, context)) -> ParseResult Nothing (nub $ sortNotes $ p ++ (notesForContext context) ++ ([makeErrorFor err])) ParseResult (Just (script, map)) (nub $ sortNotes $ notes ++ parsenotes)
(Left err, (p, context)) ->
ParseResult Nothing
(nub $ sortNotes $ p ++ (notesForContext context) ++ ([makeErrorFor err]))
where where
isName (ContextName _ _) = True isName (ContextName _ _) = True
isName _ = False isName _ = False

View File

@ -44,9 +44,9 @@ shellCheck :: String -> [ShellCheckComment]
shellCheck script = shellCheck script =
let (ParseResult result notes) = parseShell "-" script in let (ParseResult result notes) = parseShell "-" script in
let allNotes = notes ++ (concat $ maybeToList $ do let allNotes = notes ++ (concat $ maybeToList $ do
(tree, map) <- result (tree, posMap) <- result
let newMap = runAllAnalytics tree map let list = runAnalytics [] tree
return $ notesFromMap $ filterByAnnotation tree newMap return $ map (noteToParseNote posMap) $ filterByAnnotation tree list
) )
in in
map formatNote $ nub $ sortNotes allNotes map formatNote $ nub $ sortNotes allNotes