github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Streamline logTiming

Browse Source
This commit is contained in:
Timothy Clem 2017-10-06 11:44:53 -07:00
parent 27c0520105
commit 0780d675c5
1 changed files with 8 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Semantic/Task.hs
View File

@ -199,18 +199,18 @@ runParser Options{..} blob@Blob{..} = go
go :: Parser term -> Task term go :: Parser term -> Task term
go parser = case parser of go parser = case parser of
ASTParser language -> ASTParser language ->
logTiming "parse.tree_sitter_ast_parse" $ time "parse.tree_sitter_ast_parse" languageTag $
liftIO ((Right <$> parseToAST language blob) `catchError` (pure . Left . toException)) >>= either throwError pure liftIO ((Right <$> parseToAST language blob) `catchError` (pure . Left . toException)) >>= either throwError pure
AssignmentParser parser assignment -> do AssignmentParser parser assignment -> do
ast <- go parser `catchError` \ err -> do ast <- go parser `catchError` \ err -> do
writeStat (Stat.increment "parse.parse_failures" languageTag) writeStat (Stat.increment "parse.parse_failures" languageTag)
writeLog Error "failed parsing" (("tag", "parse") : blobFields) >> throwError err writeLog Error "failed parsing" (("tag", "parse") : blobFields)
logTiming "parse.assign" $ throwError err
time "parse.assign" languageTag $
case Assignment.assign blobSource assignment ast of case Assignment.assign blobSource assignment ast of
Left err -> do Left err -> do
writeStat (Stat.increment "parse.assign_errors" languageTag) writeStat (Stat.increment "parse.assign_errors" languageTag)
let formatted = Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err writeLog Error (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err) (("tag", "assign") : blobFields)
writeLog Error formatted (("tag", "assign") : blobFields)
throwError (toException err) throwError (toException err)
Right term -> do Right term -> do
for_ (errors term) $ \ err -> do for_ (errors term) $ \ err -> do
@ -218,21 +218,17 @@ runParser Options{..} blob@Blob{..} = go
writeLog Warning (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err) (("tag", "assign") : blobFields) writeLog Warning (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err) (("tag", "assign") : blobFields)
pure term pure term
TreeSitterParser tslanguage -> TreeSitterParser tslanguage ->
logTiming "parse.tree_sitter_parse" $ time "parse.tree_sitter_parse" languageTag $
liftIO (treeSitterParser tslanguage blob) liftIO (treeSitterParser tslanguage blob)
MarkdownParser -> MarkdownParser ->
logTiming "parse.cmark_parse" $ time "parse.cmark_parse" languageTag $
pure (cmarkParser blobSource) pure (cmarkParser blobSource)
blobFields = ("path", blobPath) : languageTag blobFields = ("path", blobPath) : languageTag
languageTag = maybe [] (pure . (,) "language" . show) blobLanguage languageTag = maybe [] (pure . (,) ("language" :: String) . show) blobLanguage
errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Union fs) (Record Assignment.Location) -> [Error.Error String] errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Union fs) (Record Assignment.Location) -> [Error.Error String]
errors = cata $ \ (In a syntax) -> case syntax of errors = cata $ \ (In a syntax) -> case syntax of
_ | Just err@Syntax.Error{} <- prj syntax -> [Syntax.unError (sourceSpan a) err] _ | Just err@Syntax.Error{} <- prj syntax -> [Syntax.unError (sourceSpan a) err]
_ -> fold syntax _ -> fold syntax
logTiming :: String -> Task a -> Task a
logTiming statName t = do
writeLog Info statName blobFields
time statName languageTag t
instance MonadIO Task where instance MonadIO Task where
liftIO action = LiftIO action `Then` return liftIO action = LiftIO action `Then` return