Reduce duplication for hlint

src/Semantic/Task.hs

@@ -188,7 +188,23 @@ instance Exception ParserCancelled
 
 -- | Parse a 'Blob' in 'IO'.
 runParser :: (Member (Exc SomeException) effs, Member IO effs, Member (Reader Config) effs, Member Telemetry effs, Member Trace effs) => Blob -> Parser term -> Eff effs term
-runParser blob@Blob{..} parser = case parser of
+runParser blob@Blob{..} parser =
+  let
+    parseFailureHandler (SomeException err) = do
+      writeStat (increment "parse.parse_failures" languageTag)
+      writeLog Error "failed parsing" (("task", "parse") : blobFields)
+      throwError (toException err)
+    writeErrorStats errors = for_ errors $ \ err -> case Error.errorActual err of
+      Just "ParseError" -> do
+        writeStat (increment "parse.parse_errors" languageTag)
+        logError config Warning blob err (("task", "parse") : blobFields)
+      _ -> do
+        writeStat (increment "parse.assign_warnings" languageTag)
+        logError config Warning blob err (("task", "assign") : blobFields)
+        when (optionsFailOnWarning (configOptions config)) $ throwError (toException err)
+
+  in
+  case parser of
     ASTParser language ->
       time "parse.tree_sitter_ast_parse" languageTag $ do
         config <- ask
@@ -196,10 +212,7 @@ runParser blob@Blob{..} parser = case parser of
           >>= maybeM (throwError (SomeException ParserTimedOut))
 
     AssignmentParser parser assignment -> do
-    ast <- runParser blob parser `catchError` \ (SomeException err) -> do
+      ast <- runParser blob parser `catchError` parseFailureHandler
-      writeStat (increment "parse.parse_failures" languageTag)
-      writeLog Error "failed parsing" (("task", "parse") : blobFields)
-      throwError (toException err)
       config <- ask
       time "parse.assign" languageTag $
         case Assignment.assign blobSource assignment ast of
@@ -208,22 +221,12 @@ runParser blob@Blob{..} parser = case parser of
             logError config Error blob err (("task", "assign") : blobFields)
             throwError (toException err)
           Right term -> do
-          for_ (errors term) $ \ err -> case Error.errorActual err of
+            writeErrorStats term
-              Just "ParseError" -> do
-                writeStat (increment "parse.parse_errors" languageTag)
-                logError config Warning blob err (("task", "parse") : blobFields)
-              _ -> do
-                writeStat (increment "parse.assign_warnings" languageTag)
-                logError config Warning blob err (("task", "assign") : blobFields)
-                when (optionsFailOnWarning (configOptions config)) $ throwError (toException err)
             writeStat (count "parse.nodes" (length term) languageTag)
             pure term
 
     DeterministicParser parser assignment -> do
-    ast <- runParser blob parser `catchError` \ (SomeException err) -> do
+      ast <- runParser blob parser `catchError` parseFailureHandler
-      writeStat (increment "parse.parse_failures" languageTag)
-      writeLog Error "failed parsing" (("task", "parse") : blobFields)
-      throwError (toException err)
       config <- ask
       time "parse.assign_deterministic" languageTag $
         case Deterministic.runAssignment (Deterministic.runTermAssignment assignment) blobSource (Deterministic.State 0 lowerBound [ast]) of
@@ -232,14 +235,7 @@ runParser blob@Blob{..} parser = case parser of
             logError config Error blob (either id show <$> err) (("task", "assign") : blobFields)
             throwError (toException (either id show <$> err))
           Right (_, term) -> do
-          for_ (errors term) $ \ err -> case Error.errorActual err of
+            writeErrorStats (errors term)
-              Just "ParseError" -> do
-                writeStat (increment "parse.parse_errors" languageTag)
-                logError config Warning blob err (("task", "parse") : blobFields)
-              _ -> do
-                writeStat (increment "parse.assign_warnings" languageTag)
-                logError config Warning blob err (("task", "assign") : blobFields)
-                when (optionsFailOnWarning (configOptions config)) $ throwError (toException err)
             writeStat (count "parse.nodes" (length term) languageTag)
             pure term