formatError takes Error String.

src/Data/Error.hs

@@ -28,8 +28,8 @@ type IncludeSource = Bool
 type Colourize = Bool
 
 -- | Format an 'Error', optionally with reference to the source where it occurred.
-formatError :: IncludeSource -> Colourize -> Blob -> Span -> [String] -> Maybe String -> String
-formatError includeSource colourize Blob{..} errorSpan errorExpected errorActual
+formatError :: IncludeSource -> Colourize -> Blob -> Error String -> String
+formatError includeSource colourize Blob{..} Error{..}
   = ($ "")
   $ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showSpan (maybe Nothing (const (Just blobPath)) blobKind) errorSpan . showString ": ")
   . withSGRCode colourize [SetColor Foreground Vivid Red] (showString "error" . showString ": " . showExpectation errorExpected errorActual . showChar '\n')

src/Renderer/TOC.hs

@@ -26,7 +26,7 @@ import Data.Align (crosswalk)
 import Data.Bifunctor (bimap, first)
 import Data.Blob
 import Data.ByteString.Lazy (toStrict)
-import Data.Error (formatError)
+import Data.Error as Error (Error(..), formatError)
 import Data.Foldable (fold, foldl', toList)
 import Data.Functor.Both hiding (fst, snd)
 import qualified Data.Functor.Both as Both
@@ -125,7 +125,7 @@ declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syn
 declarationAlgebra blob@Blob{..} (a :< r)
   | Just (Declaration.Function (identifier, _) _ _) <- prj r = Just $ FunctionDeclaration (getSource (extract identifier))
   | Just (Declaration.Method _ (identifier, _) _ _) <- prj r = Just $ MethodDeclaration (getSource (extract identifier))
-  | Just (Syntax.Error errorExpected errorActual _) <- prj r = Just $ ErrorDeclaration (T.pack (formatError False False blob (sourceSpan a) errorExpected errorActual)) blobLanguage
+  | Just (Syntax.Error errorExpected errorActual _) <- prj r = Just $ ErrorDeclaration (T.pack (formatError False False blob (Error.Error (sourceSpan a) errorExpected errorActual))) blobLanguage
   | otherwise = Nothing
   where getSource = toText . flip Source.slice blobSource . byteRange
 
@@ -135,7 +135,7 @@ markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error :< fs, HasField fiel
                      -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 markupSectionAlgebra blob@Blob{..} (a :< r)
   | Just (Markup.Section level (heading, _) _) <- prj r = Just $ SectionDeclaration (maybe (getSource (extract heading)) (firstLine . toText . flip Source.slice blobSource . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading)))) level
-  | Just (Syntax.Error errorExpected errorActual _) <- prj r = Just $ ErrorDeclaration (T.pack (formatError False False blob (sourceSpan a) errorExpected errorActual)) blobLanguage
+  | Just (Syntax.Error errorExpected errorActual _) <- prj r = Just $ ErrorDeclaration (T.pack (formatError False False blob (Error.Error (sourceSpan a) errorExpected errorActual))) blobLanguage
   | otherwise = Nothing
   where getSource = firstLine . toText . flip Source.slice blobSource . byteRange
         firstLine = T.takeWhile (/= '\n')

src/Semantic/Task.hs

@@ -199,20 +199,20 @@ runParser Options{..} blob@Blob{..} = go
             case res of
               Left err -> writeLog Error "failed parsing" blobFields >> pure (Left err)
               Right ast -> logTiming "assign" $ case Assignment.assignBy by blobSource assignment ast of
-                Left Assignment.Error{..} -> do
-                  writeLog Error (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob errorSpan (show <$> errorExpected) (show <$> errorActual)) blobFields
-                  pure $ Right (Syntax.makeTerm (totalRange blobSource :. totalSpan blobSource :. Nil) (Syntax.Error (show <$> errorExpected) (show <$> errorActual) []))
+                Left err -> do
+                  writeLog Error (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob (show <$> err)) blobFields
+                  pure $ Right (Syntax.makeTerm (totalRange blobSource :. totalSpan blobSource :. Nil) (Syntax.Error (show <$> Error.errorExpected err) (show <$> Error.errorActual err) []))
                 Right term -> do
-                  for_ (errors term) $ \ (errorSpan, errorExpected, errorActual) ->
-                    writeLog Warning (Error.formatError optionsPrintSource optionsEnableColour blob errorSpan errorExpected errorActual) blobFields
+                  for_ (errors term) $ \ err ->
+                    writeLog Warning (Error.formatError optionsPrintSource optionsEnableColour blob err) blobFields
                   pure $ Right term
           TreeSitterParser tslanguage -> logTiming "ts parse" $ liftIO (Right <$> treeSitterParser tslanguage blob)
           MarkdownParser -> logTiming "cmark parse" $ pure (Right (cmarkParser blobSource))
           LineByLineParser -> logTiming "line-by-line parse" $ pure (Right (lineByLineParser blobSource))
         blobFields = [ ("path", blobPath), ("language", maybe "" show blobLanguage) ]
-        errors :: (Syntax.Error :< fs, Foldable (Union fs), Functor (Union fs)) => Term (Union fs) (Record Assignment.Location) -> [(Span, [String], Maybe String)]
+        errors :: (Syntax.Error :< fs, Foldable (Union fs), Functor (Union fs)) => Term (Union fs) (Record Assignment.Location) -> [Error.Error String]
         errors = cata $ \ (a :< syntax) -> case syntax of
-          _ | Just (Syntax.Error expected actual _) <- prj syntax -> [(sourceSpan a, expected, actual)]
+          _ | Just (Syntax.Error expected actual _) <- prj syntax -> [Error.Error (sourceSpan a) expected actual]
           _ -> fold syntax
         logTiming :: String -> Task a -> Task a
         logTiming msg = time msg blobFields