Pass the position, expected, & actual fields to formatErrorWithOptions separately.

src/Data/Syntax/Assignment.hs

@@ -213,11 +213,11 @@ type IncludeSource = Bool
 type Colourize = Bool
 
 -- | Format an 'Error', optionally with reference to the source where it occurred.
-formatErrorWithOptions :: Show grammar => IncludeSource -> Colourize -> Blob -> Error grammar -> String
-formatErrorWithOptions includeSource colourize Blob{..} Error{..}
+formatErrorWithOptions :: IncludeSource -> Colourize -> Blob -> Info.Pos -> [String] -> Maybe String -> String
+formatErrorWithOptions includeSource colourize Blob{..} errorPos errorExpected errorActual
   = ($ "")
   $ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showPos (maybe Nothing (const (Just blobPath)) blobKind) errorPos . showString ": ")
-  . withSGRCode colourize [SetColor Foreground Vivid Red] (showString "error" . showString ": " . showExpectation (show <$> errorExpected) (show <$> errorActual) . showChar '\n')
+  . withSGRCode colourize [SetColor Foreground Vivid Red] (showString "error" . showString ": " . showExpectation errorExpected errorActual . showChar '\n')
   . (if includeSource
     then showString (unpack context) . (if "\n" `isSuffixOf` context then id else showChar '\n')
        . showString (replicate (succ (Info.posColumn errorPos + lineNumberDigits)) ' ') . withSGRCode colourize [SetColor Foreground Vivid Green] (showChar '^' . showChar '\n')

src/Renderer/TOC.hs

@@ -38,7 +38,7 @@ import Data.Output
 import Data.Record
 import Data.Semigroup ((<>), sconcat)
 import Data.Source as Source
-import Data.Syntax.Assignment (formatErrorWithOptions)
+import Data.Syntax.Assignment as Assignment (Error(..), formatErrorWithOptions)
 import Data.Text (toLower)
 import qualified Data.Text as T
 import Data.Text.Listable
@@ -119,23 +119,23 @@ syntaxDeclarationAlgebra Blob{..} (a :< r) = case r of
   where getSource = toText . flip Source.slice blobSource . byteRange . extract
 
 -- | Compute 'Declaration's for methods and functions.
-declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syntax.Error :< fs, Apply1 Functor fs, HasField fields Range)
+declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syntax.Error :< fs, Apply1 Functor fs, HasField fields Range, HasField fields Span)
                    => Blob
                    -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 declarationAlgebra blob@Blob{..} (_ :< 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 err _) <- prj r = Just $ ErrorDeclaration (T.pack (formatErrorWithOptions False False blob err)) blobLanguage
+  | Just (Syntax.Error Assignment.Error{..} _) <- prj r = Just $ ErrorDeclaration (T.pack (formatErrorWithOptions False False blob errorPos errorExpected errorActual)) blobLanguage
   | otherwise = Nothing
   where getSource = toText . flip Source.slice blobSource . byteRange
 
 -- | Compute 'Declaration's with the headings of 'Markup.Section's.
-markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error :< fs, HasField fields Range, Apply1 Functor fs, Apply1 Foldable fs)
+markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error :< fs, HasField fields Range, HasField fields Span, Apply1 Functor fs, Apply1 Foldable fs)
                      => Blob
                      -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 markupSectionAlgebra blob@Blob{..} (_ :< 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 err _) <- prj r = Just $ ErrorDeclaration (T.pack (formatErrorWithOptions False False blob err)) blobLanguage
+  | Just (Syntax.Error Assignment.Error{..} _) <- prj r = Just $ ErrorDeclaration (T.pack (formatErrorWithOptions False False blob errorPos errorExpected errorActual)) blobLanguage
   | otherwise = Nothing
   where getSource = firstLine . toText . flip Source.slice blobSource . byteRange
         firstLine = T.takeWhile (/= '\n')

src/Semantic/Task.hs

@@ -197,12 +197,12 @@ 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 err -> do
-                  writeLog Error (Assignment.formatErrorWithOptions optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err) blobFields
+                Left err@Assignment.Error{..} -> do
+                  writeLog Error (Assignment.formatErrorWithOptions optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob errorPos (show <$> errorExpected) (show <$> errorActual)) blobFields
                   pure $ Right (Syntax.makeTerm (totalRange blobSource :. totalSpan blobSource :. Nil) (Syntax.Error (fmap show err) []))
                 Right term -> do
-                  for_ (errors term) $ \ err ->
-                    writeLog Warning (Assignment.formatErrorWithOptions optionsPrintSource optionsEnableColour blob err) blobFields
+                  for_ (errors term) $ \ Assignment.Error{..} ->
+                    writeLog Warning (Assignment.formatErrorWithOptions optionsPrintSource optionsEnableColour blob errorPos errorExpected errorActual) blobFields
                   pure $ Right term
           TreeSitterParser tslanguage -> logTiming "ts parse" $ liftIO (Right <$> treeSitterParser tslanguage blob)
           MarkdownParser -> logTiming "cmark parse" $ pure (Right (cmarkParser blobSource))