Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Report correct location for parse error diagnostics (Language Server) #176

Merged
merged 1 commit into from
Apr 2, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 26 additions & 2 deletions rzk/src/Language/Rzk/VSCode/Handlers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,9 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecordWildCards #-}

module Language.Rzk.VSCode.Handlers (
typecheckFromConfigFile,
Expand Down Expand Up @@ -40,6 +41,7 @@ import Language.LSP.VFS (virtualFileText)
import System.FilePath (makeRelative, (</>))
import System.FilePath.Glob (compile, globDir)

import Data.Char (isDigit)
import Language.Rzk.Free.Syntax (RzkPosition (RzkPosition),
VarIdent (getVarIdent))
import Language.Rzk.Syntax (Module, VarIdent' (VarIdent),
Expand All @@ -53,6 +55,7 @@ import Rzk.Format (FormattingEdit (..),
formatTextEdits)
import Rzk.Project.Config (ProjectConfig (include))
import Rzk.TypeCheck
import Text.Read (readMaybe)

-- | Given a list of file paths, reads them and parses them as Rzk modules,
-- returning the same list of file paths but with the parsed module (or parse error)
Expand Down Expand Up @@ -181,7 +184,7 @@ typecheckFromConfigFile = do
line = fromIntegral $ fromMaybe 0 $ extractLineNumber err

diagnosticOfParseError :: String -> Diagnostic
diagnosticOfParseError err = Diagnostic (Range (Position 0 0) (Position 0 0))
diagnosticOfParseError err = Diagnostic (Range (Position errLine errColumnStart) (Position errLine errColumnEnd))
(Just DiagnosticSeverity_Error)
(Just $ InR "parse-error")
Nothing
Expand All @@ -190,6 +193,27 @@ typecheckFromConfigFile = do
Nothing
(Just [])
Nothing
where
(errLine, errColumnStart, errColumnEnd) = fromMaybe (0, 0, 0) $
case words err of
-- Happy parse error
(take 9 -> ["syntax", "error", "at", "line", lineStr, "column", columnStr, "before", token]) -> do
line <- readMaybe (takeWhile isDigit lineStr)
columnStart <- readMaybe (takeWhile isDigit columnStr)
return (line - 1, columnStart - 1, columnStart + fromIntegral (length token) - 3)
-- Happy parse error due to lexer error
(take 7 -> ["syntax", "error", "at", "line", lineStr, "column", columnStr]) -> do
line <- readMaybe (takeWhile isDigit lineStr)
columnStart <- readMaybe (takeWhile isDigit columnStr)
return (line - 1, columnStart - 1, columnStart - 1)
-- BNFC layout resolver error
(take 14 -> ["Layout", "error", "at", "line", _lineStr, "column", _columnStr, "found", token, "at", "line", lineStr', "column", columnStr']) -> do
-- line <- readMaybe (takeWhile isDigit lineStr)
-- columnStart <- readMaybe (takeWhile isDigit columnStr)
line' <- readMaybe (takeWhile isDigit lineStr')
columnStart' <- readMaybe (takeWhile isDigit columnStr')
return (line' - 1, columnStart', columnStart' + fromIntegral (length token) - 2)
_ -> Nothing

instance Default T.Text where def = ""
instance Default CompletionItem
Expand Down
Loading