dhall-lsp-server: Rework diagnostics backend + detailed error messages on hover (#982)
* Refactor Diagnostics backend This commits refactors Backend.Dhall.Diagnostics, cleaning things up and adding comments along the way. We also lose Backend.Dhall.DhallErrors. The user-facing result is a step backwards, as we revert to using Dhall's Show instances to print errors, which gives us error messages that don't fit the LSP use case very well at the moment. In the future we should change Dhall's error printing API (the Show instances) to make them more generally useful (in particular for the LSP use case), thus saving us from having to duplicate code (as was previously did, when dhall-lsp-server was not yet part of the upstream project). * Proof of concept: Provide detailed error messages This proof of concept provides detailed explanations on hovering over type errors. Currently this is done by injecting the explanation directly into the hover text, which 1. conflicts with the short error messages, which are still being displayed at the same time and 2. is not particularly readable, since the explanations are meant to be rendered at least 80 characters wide. For future work I am planning to instead only add an "explain" link to the hover window, which when clicked opens the explanation in a separate window (inspired by how the haskell ide engine presents documentation links). This will require a small amount of client-side logic. * Explain error messages via VSCode Command URIs The first proof of concept simply spit out the explanations as hover text; in order to make the feature a bit more useful, we now encode the explanation text into a VSCode command URI (that still needs to be implemented client-side), so that upon hovering over an error the user is presented with a clickable "Explain error message" link. The feature is still in the prototype stage! * Use custom URI scheme instead of command URIs Use URIs of the form "dhall-explain:?text" to present detailed explanations on hovering. Previously we used command URIs, which are specific to VSCode. Needs a correspondingly patched vscode-lsp-server to handle the "dhall-explain" URI scheme. * Fix handling of relative imports in diagnostics In refactoring the diagnostics backend I forgot to initialise the settings passed to the Dhall type-checker, which are needed to properly resolve relative imports. An easy fix for a silly mistake ;) * Remove outdated TODO comment * Make GHC stricter when building dhall-lsp-server Add -Wall and -fwarn-incomplete-uni-patterns to the GHC options when building dhall-lsp-server. This brings it in line with the rest of dhall-haskell. * Fix warnings when building dhall-lsp-server * Fix review comments Fixes Gabriel's PR comments. Note that I leave a proper fix to DhallException for the future (I want to work on something else for a bit ;)). * Use underscores to pacify warnings
This commit is contained in:
Frederik Ramcke
GitHub
parent
98c7d4dfca
commit
49d29d685f
|
|
@ -1,25 +1,11 @@
|
|||
|
||||
module Main (main) where
|
||||
|
||||
|
||||
|
||||
|
||||
import Data.Default
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import qualified Data.Text as T
|
||||
import qualified System.Exit
|
||||
import qualified System.Log.Logger as L
|
||||
|
||||
|
||||
|
||||
import qualified Data.Text.IO
|
||||
import qualified System.IO
|
||||
import qualified Data.Map as Map
|
||||
import Options.Applicative (Parser, ParserInfo)
|
||||
import qualified Options.Applicative
|
||||
import Control.Applicative ((<|>))
|
||||
|
||||
import qualified System.IO.Unsafe
|
||||
import System.Exit (exitSuccess, exitWith)
|
||||
|
||||
import LSP.Server(run)
|
||||
|
|
|
|||
|
|
@ -20,7 +20,6 @@ source-repository head
|
|||
|
||||
library
|
||||
exposed-modules:
|
||||
Backend.Dhall.DhallErrors
|
||||
Backend.Dhall.Diagnostics
|
||||
Backend.Dhall.Formatting
|
||||
LSP.Common
|
||||
|
|
@ -30,6 +29,7 @@ library
|
|||
LSP.Server
|
||||
other-modules:
|
||||
Paths_dhall_lsp_server
|
||||
Util
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables
|
||||
|
|
@ -53,8 +53,10 @@ library
|
|||
, text
|
||||
, transformers
|
||||
, unordered-containers
|
||||
, uri-encode
|
||||
, yi-rope
|
||||
default-language: Haskell2010
|
||||
GHC-Options: -Wall -fwarn-incomplete-uni-patterns
|
||||
|
||||
executable dhall-lsp-server
|
||||
main-is: Main.hs
|
||||
|
|
@ -87,6 +89,7 @@ executable dhall-lsp-server
|
|||
, unordered-containers
|
||||
, yi-rope
|
||||
default-language: Haskell2010
|
||||
GHC-Options: -Wall -fwarn-incomplete-uni-patterns
|
||||
|
||||
test-suite dhall-lsp-server-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
|
@ -98,7 +101,7 @@ test-suite dhall-lsp-server-test
|
|||
hs-source-dirs:
|
||||
test
|
||||
default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||
build-tool-depends:
|
||||
tasty-discover:tasty-discover
|
||||
build-depends:
|
||||
|
|
|
|||
|
|
@ -1,229 +0,0 @@
|
|||
module Backend.Dhall.DhallErrors(simpleTypeMessage) where
|
||||
|
||||
{-| This file contains mostly copy-paste error formatting code from <root>/dhall/src/Dhall/TypeCheck.hs
|
||||
This had to be necessary as to strip down extra information that standard error formatting provides (location, ascii-formatting).
|
||||
-}
|
||||
|
||||
import Dhall.Binary (ToTerm)
|
||||
import Dhall.TypeCheck
|
||||
import Dhall.Core(Expr)
|
||||
import Dhall.Pretty(Ann(..), layoutOpts)
|
||||
|
||||
import qualified Dhall.Diff
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.String as R
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
prettyDiff :: (Eq a, Pretty.Pretty a, ToTerm a) => Expr s a -> Expr s a -> Text
|
||||
prettyDiff exprL exprR = T.pack . R.renderString . Pretty.layoutPretty layoutOpts . Pretty.unAnnotate $ diff
|
||||
where
|
||||
diff = Dhall.Diff.diffNormalized exprL exprR
|
||||
|
||||
simpleTypeMessage
|
||||
:: (Eq a, Pretty.Pretty a, ToTerm a) => TypeMessage s a -> Text
|
||||
simpleTypeMessage (UnboundVariable x) =
|
||||
"Unbound variable: " <> x
|
||||
|
||||
simpleTypeMessage (InvalidInputType expr) =
|
||||
"Invalid function input"
|
||||
|
||||
simpleTypeMessage (InvalidOutputType expr) =
|
||||
"Invalid function output"
|
||||
|
||||
simpleTypeMessage (NotAFunction expr0 expr1) =
|
||||
"Not a function"
|
||||
|
||||
simpleTypeMessage (TypeMismatch expr0 expr1 expr2 expr3) =
|
||||
"Wrong type of function argument\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr1 expr3
|
||||
|
||||
simpleTypeMessage (AnnotMismatch expr0 expr1 expr2) =
|
||||
"Expression doesn't match annotation\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr1 expr2
|
||||
|
||||
|
||||
simpleTypeMessage Untyped =
|
||||
"❰Sort❱ has no type, kind, or sort"
|
||||
|
||||
|
||||
|
||||
simpleTypeMessage (InvalidPredicate expr0 expr1) =
|
||||
"Invalid predicate for ❰if❱"
|
||||
|
||||
simpleTypeMessage (IfBranchMustBeTerm b expr0 expr1 expr2) =
|
||||
"❰if❱ branch is not a term"
|
||||
|
||||
simpleTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) =
|
||||
"❰if❱ branches must have matching types\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr1 expr3
|
||||
|
||||
simpleTypeMessage (InvalidListType expr0) =
|
||||
"Invalid type for ❰List❱ elements"
|
||||
|
||||
simpleTypeMessage MissingListType =
|
||||
"An empty list requires a type annotation"
|
||||
|
||||
simpleTypeMessage (MismatchedListElements i expr0 _expr1 expr2) =
|
||||
"List elements should all have the same type\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr0 expr2
|
||||
|
||||
simpleTypeMessage (InvalidListElement i expr0 _expr1 expr2) =
|
||||
"List element has the wrong type\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr0 expr2
|
||||
|
||||
simpleTypeMessage (InvalidOptionalType expr0) =
|
||||
"Invalid type for ❰Optional❱ element"
|
||||
|
||||
simpleTypeMessage (InvalidOptionalElement expr0 expr1 expr2) =
|
||||
"❰Optional❱ element has the wrong type\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr0 expr2
|
||||
|
||||
|
||||
simpleTypeMessage (InvalidSome expr0 expr1 expr2) =
|
||||
"❰Some❱ argument has the wrong type"
|
||||
|
||||
simpleTypeMessage (InvalidFieldType k expr0) =
|
||||
"Invalid field type"
|
||||
|
||||
simpleTypeMessage (FieldAnnotationMismatch k0 expr0 c0 k1 expr1 c1) =
|
||||
"Field annotation mismatch"
|
||||
|
||||
simpleTypeMessage (FieldMismatch k0 expr0 c0 k1 expr1 c1) =
|
||||
"Field mismatch"
|
||||
|
||||
simpleTypeMessage (InvalidField k expr0) =
|
||||
"Invalid field"
|
||||
|
||||
simpleTypeMessage (InvalidAlternativeType k expr0) =
|
||||
"Invalid alternative type"
|
||||
|
||||
simpleTypeMessage (InvalidAlternative k expr0) =
|
||||
"Invalid alternative"
|
||||
|
||||
simpleTypeMessage (AlternativeAnnotationMismatch k0 expr0 c0 k1 expr1 c1) =
|
||||
"Alternative annotation mismatch"
|
||||
|
||||
simpleTypeMessage (ListAppendMismatch expr0 expr1) =
|
||||
"You can only append ❰List❱s with matching element types\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr0 expr1
|
||||
|
||||
simpleTypeMessage (DuplicateAlternative k) =
|
||||
"Duplicate union alternative"
|
||||
|
||||
simpleTypeMessage (MustCombineARecord c expr0 expr1) =
|
||||
"You can only combine records"
|
||||
|
||||
simpleTypeMessage (RecordMismatch c expr0 expr1 const0 const1) =
|
||||
"Record mismatch"
|
||||
|
||||
simpleTypeMessage (CombineTypesRequiresRecordType expr0 expr1) =
|
||||
"❰⩓❱ requires arguments that are record types"
|
||||
|
||||
simpleTypeMessage (RecordTypeMismatch const0 const1 expr0 expr1) =
|
||||
"Record type mismatch"
|
||||
|
||||
simpleTypeMessage (FieldCollision k) =
|
||||
"Field collision"
|
||||
|
||||
simpleTypeMessage (MustMergeARecord expr0 expr1) =
|
||||
"❰merge❱ expects a record of handlers"
|
||||
|
||||
simpleTypeMessage (MustMergeUnion expr0 expr1) =
|
||||
"❰merge❱ expects a union"
|
||||
|
||||
simpleTypeMessage (UnusedHandler ks) =
|
||||
"Unused handler"
|
||||
|
||||
simpleTypeMessage (MissingHandler ks) =
|
||||
"Missing handler"
|
||||
|
||||
simpleTypeMessage MissingMergeType =
|
||||
"An empty ❰merge❱ requires a type annotation"
|
||||
|
||||
simpleTypeMessage (HandlerInputTypeMismatch expr0 expr1 expr2) =
|
||||
"Wrong handler input type\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr1 expr2
|
||||
|
||||
simpleTypeMessage (InvalidHandlerOutputType expr0 expr1 expr2) =
|
||||
"Wrong handler output type\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr1 expr2
|
||||
|
||||
simpleTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) =
|
||||
"Handlers should have the same output type\n"
|
||||
<> "\n"
|
||||
<> prettyDiff expr0 expr1
|
||||
|
||||
simpleTypeMessage (HandlerNotAFunction k expr0) =
|
||||
"Handler is not a function"
|
||||
|
||||
simpleTypeMessage (ConstructorsRequiresAUnionType expr0 expr1) =
|
||||
"❰constructors❱ requires a union type"
|
||||
|
||||
simpleTypeMessage (CantAccess lazyText0 expr0 expr1) =
|
||||
"Not a record or a union"
|
||||
|
||||
simpleTypeMessage (CantProject lazyText0 expr0 expr1) =
|
||||
"Not a record"
|
||||
|
||||
simpleTypeMessage (MissingField k expr0) =
|
||||
"Missing record field"
|
||||
|
||||
simpleTypeMessage (CantAnd expr0 expr1) =
|
||||
buildBooleanOperator "&&" expr0 expr1
|
||||
|
||||
simpleTypeMessage (CantOr expr0 expr1) =
|
||||
buildBooleanOperator "||" expr0 expr1
|
||||
|
||||
simpleTypeMessage (CantEQ expr0 expr1) =
|
||||
buildBooleanOperator "==" expr0 expr1
|
||||
|
||||
simpleTypeMessage (CantNE expr0 expr1) =
|
||||
buildBooleanOperator "!=" expr0 expr1
|
||||
|
||||
simpleTypeMessage (CantInterpolate expr0 expr1) =
|
||||
"You can only interpolate ❰Text❱"
|
||||
|
||||
simpleTypeMessage (CantTextAppend expr0 expr1) =
|
||||
"❰++❱ only works on ❰Text❱"
|
||||
|
||||
simpleTypeMessage (CantListAppend expr0 expr1) =
|
||||
"❰#❱ only works on ❰List❱s"
|
||||
|
||||
simpleTypeMessage (CantAdd expr0 expr1) =
|
||||
buildNaturalOperator "+" expr0 expr1
|
||||
|
||||
simpleTypeMessage (CantMultiply expr0 expr1) =
|
||||
buildNaturalOperator "*" expr0 expr1
|
||||
|
||||
simpleTypeMessage (NoDependentTypes expr0 expr1) =
|
||||
"No dependent types"
|
||||
|
||||
buildBooleanOperator :: Text -> Expr s a -> Expr s a -> Text
|
||||
buildBooleanOperator operator expr0 expr1 =
|
||||
"❰" <> txt2 <> "❱ only works on ❰Bool❱s"
|
||||
where
|
||||
txt2 = operator
|
||||
|
||||
buildNaturalOperator :: Text -> Expr s a -> Expr s a -> Text
|
||||
buildNaturalOperator operator expr0 expr1 =
|
||||
"❰" <> txt2 <> "❱ only works on ❰Natural❱s"
|
||||
|
||||
|
||||
where
|
||||
txt2 = operator
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,234 +1,183 @@
|
|||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Backend.Dhall.Diagnostics( compilerDiagnostics
|
||||
, defaultDiagnosticSource
|
||||
) where
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Backend.Dhall.Diagnostics
|
||||
( DhallException
|
||||
, runDhall
|
||||
, diagnose
|
||||
, explain
|
||||
, Position
|
||||
, Range(..)
|
||||
, Diagnosis(..)
|
||||
)
|
||||
where
|
||||
|
||||
{-|
|
||||
This module is responsible for producing dhall compiler diagnostic (errors, warns, etc ...)
|
||||
-}
|
||||
|
||||
import Control.Exception (SomeException)
|
||||
import qualified Control.Exception
|
||||
import qualified Dhall
|
||||
import Dhall(rootDirectory, sourceName, defaultInputSettings, inputExprWithSettings)
|
||||
import Dhall.Parser(ParseError(..), Src(..), SourcedException(..))
|
||||
import qualified Dhall.Core
|
||||
import qualified System.Exit
|
||||
import qualified System.IO
|
||||
import Lens.Family (LensLike', set, view)
|
||||
import Dhall.Binary (DecodingFailure)
|
||||
import Dhall.Parser (ParseError, SourcedException(..), Src(..), unwrap)
|
||||
import Dhall.Import (MissingImports)
|
||||
import Dhall.TypeCheck (DetailedTypeError(..), TypeError(..), X)
|
||||
import Dhall.Core (Expr(Note))
|
||||
import Dhall
|
||||
(rootDirectory, sourceName, defaultInputSettings, inputExprWithSettings)
|
||||
|
||||
import Dhall.Binary(DecodingFailure(..))
|
||||
import Dhall.Import(Imported(..), Cycle(..), ReferentiallyOpaque(..),
|
||||
MissingFile, MissingEnvironmentVariable, MissingImports(..) )
|
||||
import Util
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.Text as Text
|
||||
import Control.Exception (handle, SomeException)
|
||||
import Lens.Family (set)
|
||||
import System.FilePath (splitFileName)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import qualified Text.Megaparsec as Megaparsec
|
||||
|
||||
-- | An exception that occurred while trying to parse, type-check and normalise
|
||||
-- the input. TODO: make this list exhaustive! We currently report too many
|
||||
-- exceptions as "internal errors".
|
||||
data DhallException
|
||||
= ExceptionInternal SomeException
|
||||
| ExceptionCBOR DecodingFailure -- CBOR decoding failure (not relevant?)
|
||||
| ExceptionImport (SourcedException MissingImports) -- Failure to resolve an import statement
|
||||
| ExceptionTypecheck (TypeError Src X) -- Input does not type-check
|
||||
| ExceptionParse ParseError -- Input does not parse
|
||||
|
||||
|
||||
import qualified Text.Megaparsec
|
||||
import qualified Text.Megaparsec.Error
|
||||
import Text.Show(ShowS)
|
||||
import qualified Data.Set
|
||||
import Data.Foldable (foldl')
|
||||
import qualified System.FilePath
|
||||
-- | A (line, col) pair representing a position in a source file; 0-based.
|
||||
type Position = (Int, Int)
|
||||
-- | A source code range.
|
||||
data Range = Range {left, right :: Position}
|
||||
-- | A diagnosis, optionally tagged with a source code range.
|
||||
data Diagnosis = Diagnosis {
|
||||
-- | Where the diagnosis came from, e.g. Dhall.TypeCheck.
|
||||
doctor :: Text,
|
||||
range :: Maybe Range, -- ^ The range of code the diagnosis concerns
|
||||
diagnosis :: Text
|
||||
}
|
||||
|
||||
import Backend.Dhall.DhallErrors(simpleTypeMessage)
|
||||
|
||||
import Language.Haskell.LSP.Types(
|
||||
Diagnostic(..)
|
||||
, Range(..)
|
||||
, DiagnosticSeverity(..)
|
||||
, DiagnosticSource(..)
|
||||
, DiagnosticRelatedInformation(..)
|
||||
, Position(..)
|
||||
-- | Parse, type-check and normalise the given Dhall code, collecting any
|
||||
-- occurring errors.
|
||||
runDhall :: FilePath -> Text -> IO [DhallException]
|
||||
runDhall path txt =
|
||||
(handle' ExceptionInternal
|
||||
. handle' ExceptionCBOR
|
||||
. handle' ExceptionImport
|
||||
. handle' ExceptionTypecheck
|
||||
. handle' ExceptionParse
|
||||
)
|
||||
|
||||
tshow :: Show a => a -> Text
|
||||
tshow = T.pack . show
|
||||
|
||||
defaultDiagnosticSource :: DiagnosticSource
|
||||
defaultDiagnosticSource = "dhall-lsp-server"
|
||||
|
||||
-- TODO: don't use show for import msgs (requires alternative typeclass)
|
||||
-- TODO: file consisting with only comments shouldn't produce an error msg
|
||||
compilerDiagnostics :: FilePath -> Text -> IO [Diagnostic]
|
||||
compilerDiagnostics path txt = handle ast
|
||||
go
|
||||
where
|
||||
(rootDir, bufferName) = System.FilePath.splitFileName path
|
||||
settings = ( set rootDirectory rootDir
|
||||
. set sourceName bufferName) defaultInputSettings
|
||||
isEmpty = T.null $ T.strip txt
|
||||
ast = if isEmpty
|
||||
then pure []
|
||||
else [] <$ inputExprWithSettings settings txt
|
||||
handle = Control.Exception.handle allErrors
|
||||
. Control.Exception.handle decodingFailure
|
||||
. Control.Exception.handle missingImports
|
||||
. Control.Exception.handle parseErrors
|
||||
. Control.Exception.handle typeErrors
|
||||
|
||||
|
||||
allErrors e = do
|
||||
let _ = e :: SomeException
|
||||
numLines = length $ T.lines txt
|
||||
pure [Diagnostic {
|
||||
_range = Range (Position 0 0) (Position numLines 0)
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = "Internal error has occurred: " <> (tshow e)
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
decodingFailure e = do
|
||||
let (CBORIsNotDhall term) = e
|
||||
pure [Diagnostic {
|
||||
_range = Range (Position 0 0) (Position 1 0)
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = "Cannot decode CBOR to Dhall " <> (tshow term)
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
parseErrors e = do
|
||||
let _ = e :: ParseError
|
||||
errors = errorBundleToDiagnostics $ unwrap e
|
||||
System.IO.hPrint System.IO.stderr errors
|
||||
pure $ errors
|
||||
missingImports (SourcedException src e) = do
|
||||
let _ = e :: MissingImports
|
||||
pure [Diagnostic {
|
||||
_range = sanitiseRange (sourceToRange src) txt
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = removeAsciiColors $ tshow e
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
typeErrors e = do
|
||||
let _ = e :: TypeError Src X
|
||||
(TypeError ctx expr msg) = e
|
||||
pure [ Diagnostic {
|
||||
_range = sanitiseRange (getSourceRange e) txt
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = (simpleTypeMessage msg)
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
handle' constructor = handle (return . return . constructor)
|
||||
-- we need to tell Dhall the path in order for relative imports to be resolved correctly
|
||||
(dir, file) = splitFileName path
|
||||
dhallparams =
|
||||
(set rootDirectory dir . set sourceName file) defaultInputSettings
|
||||
go :: IO [DhallException]
|
||||
go = do
|
||||
_ <- inputExprWithSettings dhallparams txt
|
||||
return [] -- If we got this far the input was a valid Dhall program.
|
||||
|
||||
|
||||
removeAsciiColors :: Text -> Text
|
||||
removeAsciiColors = T.replace "\ESC[1;31m" "" . T.replace "\ESC[0m" ""
|
||||
|
||||
|
||||
getSourceRange :: TypeError Src X -> Range
|
||||
getSourceRange (TypeError ctx expr msg) = case expr of
|
||||
Dhall.Core.Note src _ -> sourceToRange src
|
||||
_ -> error "Expected note" -- FIXME: either justify this error or provide a default case
|
||||
-- | Give a short diagnosis for a given error that can be shown to the end user.
|
||||
diagnose :: Text -> DhallException -> [Diagnosis]
|
||||
diagnose _ (ExceptionInternal e) = [Diagnosis { .. }]
|
||||
where
|
||||
unPos = Text.Megaparsec.unPos
|
||||
doctor = "Dhall"
|
||||
range = Nothing
|
||||
diagnosis =
|
||||
"An internal error has occurred while trying to process the Dhall file: "
|
||||
<> tshow e
|
||||
|
||||
sourcePosToRange :: Text.Megaparsec.SourcePos -> Text.Megaparsec.SourcePos -> Range
|
||||
sourcePosToRange (Text.Megaparsec.SourcePos _ bl bc) (Text.Megaparsec.SourcePos _ el ec) =
|
||||
Range (Position (unPos bl - 1) (unPos bc - 1)) (Position (unPos el - 1) (unPos ec - 1))
|
||||
diagnose _ (ExceptionCBOR t) = [Diagnosis { .. }]
|
||||
where
|
||||
unPos = Text.Megaparsec.unPos
|
||||
doctor = "Dhall.Binary"
|
||||
range = Nothing
|
||||
diagnosis = "Failed to decode CBOR Dhall representation: " <> tshow t
|
||||
|
||||
sourceToRange :: Src -> Range
|
||||
sourceToRange (Src start end _) = sourcePosToRange start end
|
||||
|
||||
---------------------- Megaparsec utils: ----------------------------------------
|
||||
|
||||
-- see Text.Megaparsec.Error::errorBundlePretty for reference
|
||||
errorBundleToDiagnostics
|
||||
:: forall s e. ( Text.Megaparsec.Stream s
|
||||
, Text.Megaparsec.Error.ShowErrorComponent e
|
||||
)
|
||||
=> Text.Megaparsec.ParseErrorBundle s e
|
||||
-> [Diagnostic]
|
||||
errorBundleToDiagnostics Text.Megaparsec.Error.ParseErrorBundle {..} =
|
||||
fst $ foldl' f ([], bundlePosState) bundleErrors
|
||||
diagnose txt (ExceptionImport (SourcedException src e)) = [Diagnosis { .. }]
|
||||
where
|
||||
f :: forall s e. ( Text.Megaparsec.Stream s, Text.Megaparsec.Error.ShowErrorComponent e)
|
||||
=> ([Diagnostic], Text.Megaparsec.PosState s)
|
||||
-> Text.Megaparsec.ParseError s e
|
||||
-> ([Diagnostic], Text.Megaparsec.PosState s)
|
||||
f (r, !pst) e = (diagnostics:r, pst')
|
||||
where
|
||||
(epos, line, pst') = Text.Megaparsec.reachOffset (Text.Megaparsec.errorOffset e) pst
|
||||
errorText = Text.Megaparsec.Error.parseErrorTextPretty e
|
||||
lineNumber = (Text.Megaparsec.unPos . Text.Megaparsec.sourceLine) epos - 1
|
||||
startColumn = Text.Megaparsec.unPos (Text.Megaparsec.sourceColumn epos) - 1
|
||||
diagnostics = Diagnostic {
|
||||
_range = Range (Position lineNumber startColumn) (Position lineNumber endColumn)
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = T.pack errorText
|
||||
, _relatedInformation = Nothing
|
||||
}
|
||||
|
||||
endColumn = startColumn + errorLength
|
||||
|
||||
lineLength = length line
|
||||
errorLength =
|
||||
case e of
|
||||
Text.Megaparsec.TrivialError _ Nothing _ -> 1
|
||||
Text.Megaparsec.TrivialError _ (Just x) _ -> errorItemLength x
|
||||
Text.Megaparsec.FancyError _ xs ->
|
||||
Data.Set.foldl' (\a b -> max a (errorFancyLength b)) 1 xs
|
||||
doctor = "Dhall.Import"
|
||||
range = (Just . sanitiseRange txt . rangeFromDhall) src
|
||||
diagnosis = tshow e
|
||||
|
||||
-- | Get length of the “pointer” to display under a given 'ErrorItem'.
|
||||
diagnose txt (ExceptionTypecheck e@(TypeError _ expr _)) = [Diagnosis { .. }]
|
||||
where
|
||||
doctor = "Dhall.TypeCheck"
|
||||
range = fmap (sanitiseRange txt . rangeFromDhall) (note expr)
|
||||
diagnosis = tshow e
|
||||
|
||||
errorItemLength :: Text.Megaparsec.ErrorItem t -> Int
|
||||
errorItemLength = \case
|
||||
Text.Megaparsec.Tokens ts -> length ts
|
||||
_ -> 1
|
||||
diagnose txt (ExceptionParse e) =
|
||||
[ Diagnosis { .. } | (diagnosis, range) <- zip diagnoses (map Just ranges) ]
|
||||
where
|
||||
doctor = "Dhall.Parser"
|
||||
errors = (NonEmpty.toList . Megaparsec.bundleErrors . unwrap) e
|
||||
diagnoses = map (Text.pack . Megaparsec.parseErrorTextPretty) errors
|
||||
positions =
|
||||
map (positionFromMegaparsec . snd) . fst $ Megaparsec.attachSourcePos
|
||||
Megaparsec.errorOffset
|
||||
errors
|
||||
(Megaparsec.bundlePosState (unwrap e))
|
||||
lengths = map parseErrorLength errors
|
||||
ranges =
|
||||
[ Range pos r
|
||||
| (pos, len) <- zip positions lengths
|
||||
, let r = offsetToPosition txt $ positionToOffset txt pos + len
|
||||
]
|
||||
{- Since Dhall doesn't use custom errors (corresponding to the FancyError
|
||||
ParseError constructor) we only need to handle the case of plain
|
||||
Megaparsec errors (i.e. TrivialError), and only those who actually
|
||||
include a list of tokens that we can compute the length of. -}
|
||||
parseErrorLength :: Megaparsec.ParseError s e -> Int
|
||||
parseErrorLength (Megaparsec.TrivialError _ (Just (Megaparsec.Tokens ts)) _)
|
||||
= length ts
|
||||
parseErrorLength _ = 0
|
||||
|
||||
errorFancyLength :: Text.Megaparsec.ShowErrorComponent e => Text.Megaparsec.ErrorFancy e -> Int
|
||||
errorFancyLength = \case
|
||||
Text.Megaparsec.ErrorCustom a -> Text.Megaparsec.errorComponentLen a
|
||||
_ -> 1
|
||||
|
||||
-- sanitise range to exclude surrounding whitespace
|
||||
-- makes sure that the resulting range is well-formed
|
||||
sanitiseRange :: Range -> Text -> Range
|
||||
sanitiseRange (Range l r) text = Range l (max l r')
|
||||
where r' = trimEndPosition r text
|
||||
-- | Give a detailed explanation for the given error; if no detailed explanation
|
||||
-- is available return @Nothing@ instead.
|
||||
explain :: Text -> DhallException -> Maybe Diagnosis
|
||||
explain txt (ExceptionTypecheck e@(TypeError _ expr _)) = Just
|
||||
(Diagnosis { .. })
|
||||
where
|
||||
doctor = "Dhall.TypeCheck"
|
||||
range = fmap (sanitiseRange txt . rangeFromDhall) (note expr)
|
||||
diagnosis = tshow (DetailedTypeError e)
|
||||
explain _ _ = Nothing -- only type errors have detailed explanations so far
|
||||
|
||||
-- Variants of T.lines and T.unlines that are inverses of one another.
|
||||
-- T.lines always returns at least the empty line!
|
||||
lines' :: Text -> NonEmpty Text
|
||||
lines' text =
|
||||
case T.split (== '\n') text of
|
||||
[] -> "" :| [] -- this case never occurs!
|
||||
l : ls -> l :| ls
|
||||
|
||||
unlines' :: [Text] -> Text
|
||||
unlines' = T.intercalate "\n"
|
||||
-- Adjust a given range to exclude any trailing whitespace.
|
||||
sanitiseRange :: Text -> Range -> Range
|
||||
sanitiseRange txt (Range l r) = Range l (max l r')
|
||||
where
|
||||
off = positionToOffset txt r
|
||||
r' =
|
||||
(offsetToPosition txt . Text.length . Text.stripEnd . Text.take off) txt
|
||||
|
||||
|
||||
-- Given an annotated AST return the note at the top-most node.
|
||||
note :: Expr s a -> Maybe s
|
||||
note (Note s _) = Just s
|
||||
note _ = Nothing
|
||||
|
||||
|
||||
-- Megaparsec's positions are 1-based while ours are 0-based.
|
||||
positionFromMegaparsec :: Megaparsec.SourcePos -> Position
|
||||
positionFromMegaparsec (Megaparsec.SourcePos _ line col) =
|
||||
(Megaparsec.unPos line - 1, Megaparsec.unPos col - 1)
|
||||
|
||||
|
||||
-- Convert a source range from Dhalls @Src@ format.
|
||||
rangeFromDhall :: Src -> Range
|
||||
rangeFromDhall (Src left right _) =
|
||||
Range (positionFromMegaparsec left) (positionFromMegaparsec right)
|
||||
|
||||
|
||||
-- Convert a (line,column) position into the corresponding character offset
|
||||
-- and back, such that the two are inverses of eachother.
|
||||
positionToOffset :: Text -> Position -> Int
|
||||
positionToOffset txt (Position line col) =
|
||||
if line < length ls
|
||||
then T.length . unlines' $ take line ls ++ [T.take col (ls !! line)]
|
||||
else T.length txt -- position lies outside txt
|
||||
where
|
||||
ls = NonEmpty.toList (lines' txt)
|
||||
positionToOffset txt (line, col) = if line < length ls
|
||||
then Text.length . unlines' $ take line ls ++ [Text.take col (ls !! line)]
|
||||
else Text.length txt -- position lies outside txt
|
||||
where ls = NonEmpty.toList (lines' txt)
|
||||
|
||||
offsetToPosition :: Text -> Int -> Position
|
||||
offsetToPosition txt off = Position (length ls - 1) (T.length (NonEmpty.last ls))
|
||||
where ls = lines' (T.take off txt)
|
||||
|
||||
|
||||
-- adjust a given position to exclude any trailing whitespace
|
||||
trimEndPosition :: Position -> Text -> Position
|
||||
trimEndPosition pos txt =
|
||||
offsetToPosition txt (T.length . T.stripEnd . T.take off $ txt)
|
||||
where off = positionToOffset txt pos
|
||||
offsetToPosition txt off = (length ls - 1, Text.length (NonEmpty.last ls))
|
||||
where ls = lines' (Text.take off txt)
|
||||
|
|
|
|||
|
|
@ -4,9 +4,7 @@ module LSP.Common(sendToClient, nextLspReqId) where
|
|||
import Language.Haskell.LSP.Messages
|
||||
import qualified Language.Haskell.LSP.Core as LSP.Core
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Language.Haskell.LSP.Types as J
|
||||
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
import Control.Monad.Reader.Class (ask, asks)
|
||||
import Control.Monad.Reader (ReaderT)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
|
@ -18,4 +16,4 @@ sendToClient msg = do
|
|||
liftIO $ LSP.Core.sendFunc lf msg
|
||||
|
||||
nextLspReqId :: ReaderT (LSP.Core.LspFuncs ()) IO J.LspId
|
||||
nextLspReqId = asks LSP.Core.getNextReqId >>= liftIO
|
||||
nextLspReqId = asks LSP.Core.getNextReqId >>= liftIO
|
||||
|
|
|
|||
|
|
@ -2,18 +2,17 @@ module LSP.Dispatcher(dispatcher) where
|
|||
|
||||
import Control.Concurrent.STM.TChan
|
||||
import Language.Haskell.LSP.Messages
|
||||
import qualified Language.Haskell.LSP.Control as LSP.Control
|
||||
import qualified Language.Haskell.LSP.Core as LSP.Core
|
||||
import qualified Language.Haskell.LSP.Types as LSP.Types
|
||||
import qualified Language.Haskell.LSP.Utility as LSP.Utility
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Language.Haskell.LSP.Types as J
|
||||
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
|
||||
import LSP.Common
|
||||
import LSP.Handlers.Diagnostics
|
||||
import LSP.Handlers.DocumentFormatting
|
||||
import Backend.Dhall.Diagnostics
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad (forever)
|
||||
|
|
@ -21,6 +20,10 @@ import Control.Monad.Trans (liftIO)
|
|||
import Control.Monad.Reader (ReaderT, runReaderT)
|
||||
import Control.Monad.Reader.Class (ask)
|
||||
import GHC.Conc (atomically)
|
||||
import qualified Data.Text.IO
|
||||
import Data.Maybe (mapMaybe)
|
||||
import qualified Network.URI.Encode as URI
|
||||
import qualified Data.Text as Text
|
||||
|
||||
-- ! FIXME: replace logs/logm (which are just utilities) with own logging functions to make intent clearer
|
||||
-- | A basic router, which reads from Client messages queue `inp` and executes appropriate actions
|
||||
|
|
@ -109,10 +112,39 @@ dispatcher lf inp = do
|
|||
formattedDocument <- formatDocument uri tabSize insertSpaces
|
||||
publish req RspDocumentFormatting formattedDocument
|
||||
|
||||
-- This is a quick-and-dirty prototype implementation that will be
|
||||
-- completely rewritten!
|
||||
ReqHover req -> do
|
||||
liftIO $ LSP.Utility.logm "****** reactor: processing ReqHover"
|
||||
let (J.Position line col) = req ^. (J.params . J.position)
|
||||
doc = req ^. (J.params . J.textDocument . J.uri)
|
||||
fileName = case J.uriToFilePath doc of
|
||||
Nothing -> fail "Failed to parse URI in ReqHover."
|
||||
Just path -> path
|
||||
txt <- liftIO $ Data.Text.IO.readFile fileName
|
||||
errors <- liftIO $ runDhall fileName txt
|
||||
let explanations = mapMaybe (explain txt) errors
|
||||
isHovered :: Diagnosis -> Bool
|
||||
isHovered (Diagnosis _ Nothing _) = False
|
||||
isHovered (Diagnosis _ (Just (Range left right)) _)
|
||||
= left <= (line,col) && (line,col) <= right
|
||||
hover = case filter isHovered explanations of
|
||||
[] -> Nothing
|
||||
(diag : _) -> hoverFromDiagnosis diag
|
||||
publish req RspHover hover
|
||||
|
||||
unknown ->
|
||||
liftIO $ LSP.Utility.logs $ "\nIGNORING!!!\n HandlerRequest:" ++ show unknown
|
||||
|
||||
|
||||
hoverFromDiagnosis :: Diagnosis -> Maybe J.Hover
|
||||
hoverFromDiagnosis (Diagnosis _ Nothing _) = Nothing
|
||||
hoverFromDiagnosis (Diagnosis _ (Just (Range left right)) diagnosis) = Just J.Hover{..}
|
||||
where
|
||||
_range = Just $ J.Range (uncurry J.Position left) (uncurry J.Position right)
|
||||
encodedDiag = URI.encode (Text.unpack diagnosis)
|
||||
command = "[Explain error](dhall-explain:?" <> Text.pack encodedDiag <> ")"
|
||||
_contents = J.List [J.PlainString command]
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -3,19 +3,18 @@ module LSP.Handlers.Diagnostics( sendEmptyDiagnostics
|
|||
, sendDiagnostics
|
||||
) where
|
||||
|
||||
import Language.Haskell.LSP.Messages
|
||||
-- import Language.Haskell.LSP.Messages
|
||||
import Language.Haskell.LSP.Diagnostics
|
||||
import qualified Language.Haskell.LSP.Control as LSP.Control
|
||||
-- import qualified Language.Haskell.LSP.Control as LSP.Control
|
||||
import qualified Language.Haskell.LSP.Core as LSP.Core
|
||||
import qualified Language.Haskell.LSP.Types as LSP.Types
|
||||
import qualified Language.Haskell.LSP.Utility as LSP.Utility
|
||||
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Language.Haskell.LSP.Types as J
|
||||
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
import qualified Language.Haskell.LSP.Types as LSP
|
||||
-- import qualified Language.Haskell.LSP.Types.Lens as LSP
|
||||
|
||||
import qualified System.IO.Unsafe
|
||||
-- import qualified System.IO.Unsafe
|
||||
import qualified Data.Text.IO
|
||||
import qualified Data.SortedList
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
|
@ -23,6 +22,8 @@ import Control.Monad.Reader (ReaderT)
|
|||
import Control.Monad.Reader.Class (ask)
|
||||
import Control.Monad.Trans (lift, liftIO)
|
||||
|
||||
import Data.Text (Text)
|
||||
|
||||
import Backend.Dhall.Diagnostics
|
||||
|
||||
|
||||
|
|
@ -30,27 +31,47 @@ import Backend.Dhall.Diagnostics
|
|||
-- TODO: Make max number of errors parameter configurable (not rly relevant since we got 1, but still)
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Y no method to flush particular source errors?
|
||||
sendEmptyDiagnostics :: J.Uri -> Maybe Int -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
sendEmptyDiagnostics :: LSP.Uri -> Maybe Int -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
sendEmptyDiagnostics fileUri version =
|
||||
publishDiagnostics 10 fileUri version defaultDiagnosticBySource
|
||||
|
||||
defaultDiagnosticBySource :: DiagnosticsBySource
|
||||
defaultDiagnosticBySource = Map.singleton (Just defaultDiagnosticSource) (Data.SortedList.toSortedList [])
|
||||
defaultDiagnosticBySource = Map.singleton (Just "Dhall") (Data.SortedList.toSortedList [])
|
||||
|
||||
diagnosisToLSP :: Diagnosis -> LSP.Diagnostic
|
||||
diagnosisToLSP Diagnosis{..} = LSP.Diagnostic {..}
|
||||
where
|
||||
_range = case range of
|
||||
Just (Range (line1, col1) (line2, col2)) ->
|
||||
LSP.Range (LSP.Position line1 col1) (LSP.Position line2 col2)
|
||||
Nothing -> LSP.Range (LSP.Position 0 0) (LSP.Position 0 0)
|
||||
_severity = Just LSP.DsError
|
||||
-- TODO use @doctor@ instead. Seems incompatible with LSP.Core's API...
|
||||
_source = Just "Dhall"
|
||||
_code = Nothing
|
||||
_message = diagnosis
|
||||
_relatedInformation = Nothing
|
||||
|
||||
|
||||
compilerDiagnostics :: FilePath -> Text -> IO [LSP.Diagnostic]
|
||||
compilerDiagnostics path txt = do
|
||||
errors <- runDhall path txt
|
||||
let diagnoses = concatMap (diagnose txt) errors
|
||||
return (map diagnosisToLSP diagnoses)
|
||||
|
||||
-- | Analyze the file and send any diagnostics to the client in a
|
||||
-- "textDocument/publishDiagnostics" notification
|
||||
|
||||
sendDiagnostics :: J.Uri -> Maybe Int -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
sendDiagnostics :: LSP.Uri -> Maybe Int -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
sendDiagnostics fileUri version = do
|
||||
let
|
||||
filePath = maybe (error "can't convert uri to file path") id $ J.uriToFilePath fileUri -- !FIXME: handle non-file uris
|
||||
filePath = maybe (error "can't convert uri to file path") id $ LSP.uriToFilePath fileUri -- !FIXME: handle non-file uris
|
||||
txt <- lift $ Data.Text.IO.readFile filePath
|
||||
diags' <- lift $ compilerDiagnostics filePath txt
|
||||
lift $ LSP.Utility.logs $ "diagnostic: " <> show diags'
|
||||
publishDiagnostics 10 fileUri version (Map.union (partitionBySource diags') defaultDiagnosticBySource)
|
||||
|
||||
|
||||
publishDiagnostics :: Int -> J.Uri -> J.TextDocumentVersion -> DiagnosticsBySource -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
publishDiagnostics :: Int -> LSP.Uri -> LSP.TextDocumentVersion -> DiagnosticsBySource -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
publishDiagnostics maxToPublish uri v diags = do
|
||||
lf <- ask
|
||||
liftIO $ (LSP.Core.publishDiagnosticsFunc lf) maxToPublish uri v diags
|
||||
|
|
|
|||
|
|
@ -6,15 +6,11 @@ import qualified Backend.Dhall.Formatting as Formatting
|
|||
|
||||
import qualified Language.Haskell.LSP.Core as LSP.Core
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Language.Haskell.LSP.Types as J
|
||||
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
import qualified Language.Haskell.LSP.Utility as LSP.Utility
|
||||
import Language.Haskell.LSP.Messages
|
||||
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.IO
|
||||
import qualified Data.SortedList
|
||||
import Control.Monad.Trans (lift)
|
||||
import Control.Monad.Reader (ReaderT)
|
||||
|
||||
|
|
@ -22,7 +18,7 @@ import Control.Monad.Reader (ReaderT)
|
|||
-- * Note: any formatting errors would be swallowed. I think this is fine in this case, but generally we'd like to send user a notification
|
||||
-- (e.g. the error occurred in the formatter itself, and user requests format constantly and nothing happens)
|
||||
formatDocument :: J.Uri -> Int -> Bool -> ReaderT (LSP.Core.LspFuncs ()) IO (J.List J.TextEdit)
|
||||
formatDocument fileUri tabSize insertSpaces = do
|
||||
formatDocument fileUri _tabSize _insertSpaces = do
|
||||
let
|
||||
filePath = maybe (error "can't convert uri to file path") id $ J.uriToFilePath fileUri -- !FIXME: handle non-file uris
|
||||
txt <- lift $ Data.Text.IO.readFile filePath
|
||||
|
|
|
|||
|
|
@ -6,7 +6,6 @@ module LSP.Server(run) where
|
|||
|
||||
import Control.Concurrent(forkIO)
|
||||
import Control.Concurrent.STM.TChan
|
||||
import qualified GHC.IO.Exception
|
||||
import qualified Control.Exception
|
||||
import Data.Default
|
||||
import Language.Haskell.LSP.Messages
|
||||
|
|
@ -14,9 +13,7 @@ import qualified Language.Haskell.LSP.Control as LSP.Control
|
|||
import qualified Language.Haskell.LSP.Core as LSP.Core
|
||||
import qualified Language.Haskell.LSP.Utility as LSP.Utility
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Language.Haskell.LSP.Types as J
|
||||
import qualified Language.Haskell.LSP.Types.Lens as J
|
||||
|
||||
import qualified System.Log.Logger
|
||||
import GHC.Conc (atomically)
|
||||
|
|
@ -83,7 +80,7 @@ lspHandlers :: TChan FromClientMessage -> LSP.Core.Handlers
|
|||
lspHandlers rin
|
||||
= def { LSP.Core.initializedHandler = Just $ passHandler rin NotInitialized
|
||||
-- , Core.renameHandler = Just $ passHandler rin ReqRename
|
||||
-- , Core.hoverHandler = Just $ passHandler rin ReqHover
|
||||
, LSP.Core.hoverHandler = Just $ passHandler rin ReqHover
|
||||
, LSP.Core.didOpenTextDocumentNotificationHandler = Just $ passHandler rin NotDidOpenTextDocument
|
||||
, LSP.Core.didSaveTextDocumentNotificationHandler = Just $ passHandler rin NotDidSaveTextDocument
|
||||
, LSP.Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
|
||||
|
|
|
|||
28
dhall-lsp-server/src/Util.hs
Normal file
28
dhall-lsp-server/src/Util.hs
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
-- | Miscellaneous utility functions
|
||||
|
||||
module Util (
|
||||
tshow,
|
||||
lines',
|
||||
unlines'
|
||||
) where
|
||||
|
||||
import Data.Text
|
||||
import Data.List.NonEmpty
|
||||
|
||||
-- | Shorthand for @pack . show@. Useful since we are mostly working with Text
|
||||
-- rather than String.
|
||||
tshow :: Show a => a -> Text
|
||||
tshow = pack . show
|
||||
|
||||
-- | A variant of @Data.Text.lines@ that does not swallow the last empty. Always
|
||||
-- returns at least the empty line!
|
||||
lines' :: Text -> NonEmpty Text
|
||||
lines' text =
|
||||
case split (== '\n') text of
|
||||
[] -> "" :| [] -- this case never occurs!
|
||||
l : ls -> l :| ls
|
||||
|
||||
-- | A variant of @Data.Text.unlines@ that is the exact inverse to @lines'@ (and
|
||||
-- vice-versa).
|
||||
unlines' :: [Text] -> Text
|
||||
unlines' = intercalate "\n"
|
||||
Loading…
Reference in New Issue
Block a user