Improve parsing error for missing @ in named application (#3012)

- Closes #2796 

Example:
```
module NamedApplicationMissingAt;

type T := t;

fun (a : T)
 : T := t;

main : T := fun {a := t};
```

The error displays as:

![image](https://github.com/user-attachments/assets/e36232cb-9ec3-462c-8ee4-8332924b4b07)

src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs

@@ -543,7 +543,7 @@ goFunctionDef def = do
   defHeader (def ^. signName) sig' (def ^. signDoc)
   where
     funSig :: Sem r Html
-    funSig = ppHelper (ppFunctionSignature def)
+    funSig = ppHelper (ppCode (functionDefLhs def))
 
 goInductive :: forall r. (Members '[Reader HtmlOptions] r) => InductiveDef 'Scoped -> Sem r Html
 goInductive def = do

src/Juvix/Compiler/Concrete/Language/Base.hs

@@ -2801,7 +2801,19 @@ deriving stock instance Ord (JudocAtom 'Parsed)
 
 deriving stock instance Ord (JudocAtom 'Scoped)
 
+data FunctionLhs (s :: Stage) = FunctionLhs
+  { _funLhsBuiltin :: Maybe (WithLoc BuiltinFunction),
+    _funLhsTerminating :: Maybe KeywordRef,
+    _funLhsInstance :: Maybe KeywordRef,
+    _funLhsCoercion :: Maybe KeywordRef,
+    _funLhsName :: FunctionName s,
+    _funLhsArgs :: [SigArg s],
+    _funLhsColonKw :: Irrelevant (Maybe KeywordRef),
+    _funLhsRetType :: Maybe (ExpressionType s)
+  }
+
 makeLenses ''SideIfs
+makeLenses ''FunctionLhs
 makeLenses ''Statements
 makeLenses ''NamedArgumentFunctionDef
 makeLenses ''NamedArgumentPun
@@ -2888,6 +2900,19 @@ makeLenses ''RecordInfo
 makeLenses ''MarkdownInfo
 makePrisms ''NamedArgumentNew
 
+functionDefLhs :: FunctionDef s -> FunctionLhs s
+functionDefLhs FunctionDef {..} =
+  FunctionLhs
+    { _funLhsBuiltin = _signBuiltin,
+      _funLhsTerminating = _signTerminating,
+      _funLhsInstance = _signInstance,
+      _funLhsCoercion = _signCoercion,
+      _funLhsName = _signName,
+      _funLhsArgs = _signArgs,
+      _funLhsColonKw = _signColonKw,
+      _funLhsRetType = _signRetType
+    }
+
 fixityFieldHelper :: SimpleGetter (ParsedFixityFields s) (Maybe a) -> SimpleGetter (ParsedFixityInfo s) (Maybe a)
 fixityFieldHelper l = to (^? fixityFields . _Just . l . _Just)
 

src/Juvix/Compiler/Concrete/Print/Base.hs

@@ -1123,34 +1123,34 @@ instance (SingI s) => PrettyPrint (SigArg s) where
         defaultVal = ppCode <$> _sigArgDefault
     ppCode l <> arg <+?> defaultVal <> ppCode r
 
-ppFunctionSignature :: (SingI s) => PrettyPrinting (FunctionDef s)
-ppFunctionSignature FunctionDef {..} = do
-  let termin' = (<> line) . ppCode <$> _signTerminating
-      coercion' = (<> if isJust instance' then space else line) . ppCode <$> _signCoercion
-      instance' = (<> line) . ppCode <$> _signInstance
-      builtin' = (<> line) . ppCode <$> _signBuiltin
-      margs' = fmap ppCode <$> nonEmpty _signArgs
-      mtype' = case _signColonKw ^. unIrrelevant of
-        Just col -> Just (ppCode col <+> ppExpressionType (fromJust _signRetType))
-        Nothing -> Nothing
-      argsAndType' = case mtype' of
-        Nothing -> margs'
-        Just ty' -> case margs' of
-          Nothing -> Just (pure ty')
-          Just args' -> Just (args' <> pure ty')
-      name' = annDef _signName (ppSymbolType _signName)
-   in builtin'
-        ?<> termin'
-        ?<> coercion'
-        ?<> instance'
-        ?<> (name' <>? (oneLineOrNext . sep <$> argsAndType'))
+instance (SingI s) => PrettyPrint (FunctionLhs s) where
+  ppCode FunctionLhs {..} = do
+    let termin' = (<> line) . ppCode <$> _funLhsTerminating
+        coercion' = (<> if isJust instance' then space else line) . ppCode <$> _funLhsCoercion
+        instance' = (<> line) . ppCode <$> _funLhsInstance
+        builtin' = (<> line) . ppCode <$> _funLhsBuiltin
+        margs' = fmap ppCode <$> nonEmpty _funLhsArgs
+        mtype' = case _funLhsColonKw ^. unIrrelevant of
+          Just col -> Just (ppCode col <+> ppExpressionType (fromJust _funLhsRetType))
+          Nothing -> Nothing
+        argsAndType' = case mtype' of
+          Nothing -> margs'
+          Just ty' -> case margs' of
+            Nothing -> Just (pure ty')
+            Just args' -> Just (args' <> pure ty')
+        name' = annDef _funLhsName (ppSymbolType _funLhsName)
+    builtin'
+      ?<> termin'
+      ?<> coercion'
+      ?<> instance'
+      ?<> (name' <>? (oneLineOrNext . sep <$> argsAndType'))
 
 instance (SingI s) => PrettyPrint (FunctionDef s) where
   ppCode :: forall r. (Members '[ExactPrint, Reader Options] r) => FunctionDef s -> Sem r ()
   ppCode fun@FunctionDef {..} = do
     let doc' :: Maybe (Sem r ()) = ppCode <$> _signDoc
         pragmas' :: Maybe (Sem r ()) = ppCode <$> _signPragmas
-        sig' = ppFunctionSignature fun
+        sig' = ppCode (functionDefLhs fun)
         body' = case _signBody of
           SigBodyExpression e -> space <> ppCode Kw.kwAssign <> oneLineOrNext (ppTopExpressionType e)
           SigBodyClauses k -> line <> indent (vsep (ppCode <$> k))

src/Juvix/Compiler/Concrete/Translation/FromSource/ParserResultBuilder.hs

@@ -68,6 +68,13 @@ registerLiteral l =
 registerItem' :: (Member (State ParserState) r) => ParsedItem -> Sem r ()
 registerItem' i = modify' (over parserStateParsedItems (i :))
 
+evalParserResultBuilder ::
+  (Member HighlightBuilder r) =>
+  ParserState ->
+  Sem (ParserResultBuilder ': r) a ->
+  Sem r a
+evalParserResultBuilder s = fmap snd . runParserResultBuilder s
+
 execParserResultBuilder ::
   (Member HighlightBuilder r) =>
   ParserState ->

src/Juvix/Data/CodeAnn.hs

@@ -245,7 +245,7 @@ kwDot :: Doc Ann
 kwDot = delimiter "."
 
 kwAt :: Doc Ann
-kwAt = delimiter Str.at_
+kwAt = keyword Str.at_
 
 code :: Doc Ann -> Doc Ann
 code = annotate AnnCode

src/Juvix/Parser/Error.hs

@@ -23,10 +23,10 @@ data ParserError
   | ErrWrongTopModuleName WrongTopModuleName
   | ErrWrongTopModuleNameOrphan WrongTopModuleNameOrphan
   | ErrStdinOrFile StdinOrFileError
+  | ErrNamedApplicationMissingAt NamedApplicationMissingAt
   | ErrDanglingJudoc DanglingJudoc
   | ErrMarkdownBackend MarkdownBackendError
   | ErrFlatParseError FlatParseError
-  deriving stock (Show)
 
 instance ToGenericError ParserError where
   genericError = \case
@@ -38,6 +38,7 @@ instance ToGenericError ParserError where
     ErrDanglingJudoc e -> genericError e
     ErrMarkdownBackend e -> genericError e
     ErrFlatParseError e -> genericError e
+    ErrNamedApplicationMissingAt e -> genericError e
 
 newtype FlatParseError = FlatParseError
   { _flatParseErrorLoc :: Interval
@@ -201,3 +202,39 @@ instance ToGenericError DanglingJudoc where
     where
       i :: Interval
       i = getLoc _danglingJudoc
+
+data NamedApplicationMissingAt = NamedApplicationMissingAt
+  { _namedApplicationMissingAtLoc :: Interval,
+    _namedApplicationMissingAtFun :: Symbol,
+    _namedApplicationMissingAtLhs :: FunctionLhs 'Parsed
+  }
+
+instance ToGenericError NamedApplicationMissingAt where
+  genericError NamedApplicationMissingAt {..} = do
+    opts <- fromGenericOptions <$> ask @GenericOptions
+    let lhs :: FunctionLhs 'Parsed = _namedApplicationMissingAtLhs
+        funWord :: Text
+          | null (lhs ^. funLhsArgs) = "assignment"
+          | otherwise = "function definition"
+        fun' = ppCode opts _namedApplicationMissingAtFun
+        msg :: Doc CodeAnn =
+          "Unexpected "
+            <> pretty funWord
+            <+> ppCode opts _namedApplicationMissingAtLhs
+            <+> kwAssign
+              <> "\nPerhaps you intended to write a named application and missed the"
+            <+> kwAt
+            <+> "symbol? That would be something like"
+              <> line
+              <> fun'
+              <> kwAt
+              <> "{arg1 := ...; arg2 := ...; ... }"
+    return
+      GenericError
+        { _genericErrorLoc = i,
+          _genericErrorMessage = mkAnsiText msg,
+          _genericErrorIntervals = [i]
+        }
+    where
+      i :: Interval
+      i = _namedApplicationMissingAtLoc

test/Parsing/Negative.hs

@@ -82,6 +82,13 @@ parserErrorTests =
       $ \case
         ErrMegaparsec {} -> Nothing
         _ -> wrongError,
+    negTest
+      "Missing @ in named application"
+      $(mkRelDir ".")
+      $(mkRelFile "NamedApplicationMissingAt.juvix")
+      $ \case
+        ErrNamedApplicationMissingAt {} -> Nothing
+        _ -> wrongError,
     negTest
       "Error on local instances"
       $(mkRelDir ".")

tests/negative/NamedApplicationMissingAt.juvix

@@ -0,0 +1,8 @@
+module NamedApplicationMissingAt;
+
+type T := t;
+
+fun (a : T)
+ : T := t;
+
+main : T := fun {a := t};