Add dhall-lsp-server (#843)
This commit is contained in:
PanAeon
Gabriel Gonzalez
parent
e392657540
commit
f2f4fc2979
|
|
@ -11,7 +11,7 @@ environment:
|
|||
STACK_VERSION: 1.9.3
|
||||
|
||||
matrix:
|
||||
- STACK_YAML: stack.yaml
|
||||
- STACK_YAML: stack-nightly-2018-12-17.yaml
|
||||
- STACK_YAML: stack-lts-6.yaml
|
||||
|
||||
install:
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
packages: ./dhall ./dhall-bash ./dhall-json ./dhall-text
|
||||
packages: ./dhall ./dhall-bash ./dhall-json ./dhall-text ./dhall-lsp-server
|
||||
|
|
|
|||
|
|
@ -0,0 +1,3 @@
|
|||
# Changelog for dhall-lsp-server
|
||||
|
||||
## Unreleased changes
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
MIT License
|
||||
|
||||
Copyright (c) 2019 PanAeon
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
|
||||
# dhall-lsp-server
|
||||
```[](https://travis-ci.org/PanAeon/dhall-lsp-server)```
|
||||
|
||||
**This project is in alpha state !!!**
|
||||
|
||||
This is a [Language Server Protocol](https://microsoft.github.io/language-server-protocol/) server implementation for the [Dhall](https://dhall-lang.org) programming language.
|
||||
|
||||
|
||||
## Installation
|
||||
|
||||
### From source
|
||||
|
||||
[Haskell Tool Stack](https://docs.haskellstack.org/en/stable/README/) should be installed.
|
||||
|
||||
```bash
|
||||
cd ./dhall-lsp-server
|
||||
stack install
|
||||
```
|
||||
|
||||
Stack will copy executables to the current user's executable directory. On macOS this is `/Users/<username>/.local/bin`. On linux this should be `/Home/<username>/.local/bin`.
|
||||
If you are using VSCode there's also an option in the [VSCode Dhall plugin](https://github.com/PanAeon/vscode-dhall-lsp-server) to specify the path to the executable directly, which might be useful if you have multiple executables or you can't use global PATH for some reason.
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
|
||||
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 qualified System.IO.Unsafe
|
||||
|
||||
import LSP.Server(run)
|
||||
|
||||
data Options = Options {
|
||||
command :: Command
|
||||
, logFile :: Maybe String -- file where the server process debug log should be written
|
||||
}
|
||||
|
||||
data Command = CmdVersion | Default
|
||||
|
||||
parseOptions :: Parser Options
|
||||
parseOptions = Options <$> parseMode
|
||||
<*> Options.Applicative.optional parseLogFile
|
||||
where
|
||||
parseLogFile = Options.Applicative.strOption
|
||||
(
|
||||
Options.Applicative.long "log"
|
||||
<> Options.Applicative.help "If present writes debug output to the specified file")
|
||||
|
||||
|
||||
subcommand :: String -> String -> Parser a -> Parser a
|
||||
subcommand name description parser =
|
||||
Options.Applicative.hsubparser
|
||||
( Options.Applicative.command name parserInfo
|
||||
<> Options.Applicative.metavar name
|
||||
)
|
||||
where
|
||||
parserInfo =
|
||||
Options.Applicative.info parser
|
||||
( Options.Applicative.fullDesc
|
||||
<> Options.Applicative.progDesc description
|
||||
)
|
||||
|
||||
parseMode :: Parser Command
|
||||
parseMode =
|
||||
subcommand
|
||||
"version"
|
||||
"Display version"
|
||||
(pure CmdVersion)
|
||||
<|> pure Default
|
||||
|
||||
parserInfoOptions :: ParserInfo Options
|
||||
parserInfoOptions =
|
||||
Options.Applicative.info
|
||||
(Options.Applicative.helper <*> parseOptions)
|
||||
( Options.Applicative.progDesc "Interpreter for the Dhall language"
|
||||
<> Options.Applicative.fullDesc
|
||||
)
|
||||
|
||||
runCommand :: Options -> IO ()
|
||||
runCommand Options{..} = case command of
|
||||
CmdVersion -> putStrLn "0.0.1.0" -- TODO: read from build
|
||||
Default ->
|
||||
run logFile (pure ()) >>= \case
|
||||
0 -> exitSuccess
|
||||
c -> exitWith . System.Exit.ExitFailure $ c
|
||||
|
||||
main :: IO ()
|
||||
main = Options.Applicative.execParser parserInfoOptions >>= runCommand
|
||||
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
(import ../nix/shared.nix {}).possibly-static.dhall
|
||||
|
|
@ -0,0 +1,128 @@
|
|||
cabal-version: 1.12
|
||||
name: dhall-lsp-server
|
||||
version: 0.1.0.0
|
||||
description: Please see the README on GitHub at <https://github.com/githubuser/dhall-lsp-server#readme>
|
||||
homepage: https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme
|
||||
bug-reports: https://github.com/dhall-lang/dhall-haskell/issues
|
||||
author: panaeon
|
||||
maintainer: panaeon
|
||||
copyright: 2019 panaeon
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md
|
||||
ChangeLog.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/dhall-lang/dhall-haskell
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Backend.Dhall.DhallErrors
|
||||
Backend.Dhall.Diagnostics
|
||||
LSP.Common
|
||||
LSP.Dispatcher
|
||||
LSP.Handlers.Diagnostics
|
||||
LSP.Server
|
||||
Prelude
|
||||
other-modules:
|
||||
Paths_dhall_lsp_server
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables
|
||||
build-depends:
|
||||
aeson
|
||||
, base-noprelude >=4.7 && <5
|
||||
, containers
|
||||
, data-default
|
||||
, dhall
|
||||
, filepath
|
||||
, haskell-lsp
|
||||
, hslogger
|
||||
, lens
|
||||
, lens-family-core
|
||||
, megaparsec
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, prettyprinter
|
||||
, relude
|
||||
, sorted-list
|
||||
, stm
|
||||
, text
|
||||
, transformers
|
||||
, unordered-containers
|
||||
, yi-rope
|
||||
default-language: Haskell2010
|
||||
|
||||
executable dhall-lsp-server
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Paths_dhall_lsp_server
|
||||
hs-source-dirs:
|
||||
app
|
||||
default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables
|
||||
ghc-options: -rtsopts
|
||||
build-depends:
|
||||
aeson
|
||||
, base-noprelude >=4.7 && <5
|
||||
, containers
|
||||
, data-default
|
||||
, dhall
|
||||
, dhall-lsp-server
|
||||
, filepath
|
||||
, haskell-lsp
|
||||
, hslogger
|
||||
, lens
|
||||
, lens-family-core
|
||||
, megaparsec
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, prettyprinter
|
||||
, relude
|
||||
, sorted-list
|
||||
, stm
|
||||
, text
|
||||
, transformers
|
||||
, unordered-containers
|
||||
, yi-rope
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite dhall-lsp-server-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Paths_dhall_lsp_server
|
||||
hs-source-dirs:
|
||||
test
|
||||
default-extensions: LambdaCase OverloadedStrings FlexibleInstances TypeApplications RecordWildCards ScopedTypeVariables
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
aeson
|
||||
, base-noprelude >=4.7 && <5
|
||||
, containers
|
||||
, data-default
|
||||
, dhall
|
||||
, dhall-lsp-server
|
||||
, filepath
|
||||
, haskell-lsp
|
||||
, hslogger
|
||||
, lens
|
||||
, lens-family-core
|
||||
, megaparsec
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, prettyprinter
|
||||
, relude
|
||||
, sorted-list
|
||||
, stm
|
||||
, tasty
|
||||
, tasty-discover
|
||||
, tasty-hspec
|
||||
, tasty-quickcheck
|
||||
, text
|
||||
, transformers
|
||||
, unordered-containers
|
||||
, yi-rope
|
||||
default-language: Haskell2010
|
||||
|
|
@ -0,0 +1 @@
|
|||
(import ../nix/shared.nix { coverage = true; }).shell-dhall
|
||||
|
|
@ -0,0 +1,226 @@
|
|||
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.TypeCheck
|
||||
import qualified Dhall.Diff
|
||||
import Dhall.Core(Expr)
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.String as R
|
||||
import Dhall.Pretty(Ann(..), layoutOpts)
|
||||
import qualified Data.Text as T
|
||||
|
||||
prettyDiff :: (Eq a, Pretty.Pretty 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 :: (Pretty.Pretty a, Eq 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"
|
||||
|
||||
|
||||
-- ! FIXME: missing AlternativeAnnotationMismatch
|
||||
-- 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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,260 @@
|
|||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Backend.Dhall.Diagnostics( compilerDiagnostics
|
||||
, defaultDiagnosticSource
|
||||
) where
|
||||
|
||||
|
||||
{-|
|
||||
This module is responsible for producing dhall compiler diagnostic (errors, warns, etc ...)
|
||||
-}
|
||||
|
||||
import qualified Control.Exception
|
||||
import qualified Dhall
|
||||
import Dhall(rootDirectory, sourceName, defaultInputSettings, inputExprWithSettings)
|
||||
import Dhall.Parser(ParseError(..), Src(..))
|
||||
import qualified Dhall.Core
|
||||
import qualified System.Exit
|
||||
import qualified System.IO
|
||||
import Lens.Family (LensLike', set, view)
|
||||
import Dhall.TypeCheck (DetailedTypeError(..), TypeError(..), X)
|
||||
|
||||
import Dhall.Binary(DecodingFailure(..))
|
||||
import Dhall.Import(Imported(..), Cycle(..), ReferentiallyOpaque(..),
|
||||
MissingFile, MissingEnvironmentVariable, MissingImports )
|
||||
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
import qualified Text.Megaparsec
|
||||
import qualified Text.Megaparsec.Error
|
||||
import Text.Show(ShowS)
|
||||
import qualified Data.Set
|
||||
import qualified System.FilePath
|
||||
|
||||
import Backend.Dhall.DhallErrors(simpleTypeMessage)
|
||||
|
||||
import Language.Haskell.LSP.Types(
|
||||
Diagnostic(..)
|
||||
, Range(..)
|
||||
, DiagnosticSeverity(..)
|
||||
, DiagnosticSource(..)
|
||||
, DiagnosticRelatedInformation(..)
|
||||
, Position(..)
|
||||
)
|
||||
|
||||
|
||||
|
||||
defaultDiagnosticSource :: DiagnosticSource
|
||||
defaultDiagnosticSource = "dhall-lsp-server"
|
||||
|
||||
-- FIXME: type errors span across whitespace after the expression
|
||||
-- Dhall.Binary.DecodingFailure
|
||||
-- Dhall.Import(Cycle, ReferentiallyOpaque, MissingFile, MissingEnvironmentVariable, MissingImports,
|
||||
-- HashMismatch, CannotImportHTTPURL)
|
||||
-- !FIXME: (aside) VSCode multiselection expand selects first world only
|
||||
compilerDiagnostics :: FilePath -> Text -> Text -> IO [Diagnostic]
|
||||
compilerDiagnostics path filePath txt = handle ast
|
||||
where
|
||||
-- bufferName = T.unpack $ last $ fromList $ T.split (=='/') filePath
|
||||
-- rootDir = T.unpack $ T.intercalate "/" $ tail $ fromList $ T.split (=='/') filePath
|
||||
(rootDir, bufferName) = System.FilePath.splitFileName path
|
||||
settings = ( set rootDirectory rootDir
|
||||
. set sourceName bufferName) defaultInputSettings
|
||||
isEmpty = T.null $ T.strip txt -- FIXME: file consisting with only comments shouldn't produce an error? handle upstream?
|
||||
ast = if isEmpty
|
||||
then pure []
|
||||
else [] <$ inputExprWithSettings settings txt
|
||||
handle = Control.Exception.handle allErrors
|
||||
. Control.Exception.handle decodingFailure
|
||||
. handleImportErrors txt
|
||||
. Control.Exception.handle parseErrors
|
||||
. Control.Exception.handle importErrors
|
||||
. Control.Exception.handle moduleErrors
|
||||
|
||||
|
||||
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: " <> (show 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 " <> (show term)
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
parseErrors e = do
|
||||
let _ = e :: ParseError
|
||||
errors = errorBundleToDiagnostics $ unwrap e
|
||||
System.IO.hPrint System.IO.stderr errors
|
||||
pure $ errors
|
||||
importErrors (Imported ps e) = do
|
||||
let _ = e :: TypeError Src X
|
||||
numLines = length $ T.lines txt
|
||||
System.IO.hPrint System.IO.stderr (show ps)
|
||||
pure [ Diagnostic {
|
||||
_range = Range (Position 0 0) (Position numLines 0) -- getSourceRange e
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = ("import error: " <> (show e)) -- FIXME: simple show for import msgs
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
moduleErrors e = do
|
||||
let _ = e :: TypeError Src X
|
||||
(TypeError ctx expr msg) = e
|
||||
-- System.IO.hPrint System.IO.stderr txt
|
||||
-- System.IO.hPrint System.IO.stderr e
|
||||
pure [ Diagnostic {
|
||||
_range = getSourceRange e
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = (simpleTypeMessage msg) -- FIXME: using show for import msgs
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
|
||||
-- ! FIXME: provide import errors source position (should be handled in the dhall project)
|
||||
-- * Import Errors provide no source pos info, except import mode and ImportType (which contains actual url)
|
||||
handleImportErrors :: Text -> IO [Diagnostic] -> IO [Diagnostic]
|
||||
handleImportErrors txt = Control.Exception.handle (importHandler @Cycle)
|
||||
. Control.Exception.handle (importHandler @ReferentiallyOpaque)
|
||||
. Control.Exception.handle (importHandler @MissingFile)
|
||||
. Control.Exception.handle (importHandler @MissingEnvironmentVariable)
|
||||
. Control.Exception.handle (importHandler @MissingImports)
|
||||
|
||||
where
|
||||
numLines = length $ T.lines txt
|
||||
importHandler:: forall e a. Exception e => (e -> IO [Diagnostic])
|
||||
importHandler e =
|
||||
pure [Diagnostic {
|
||||
_range = Range (Position 0 0) (Position numLines 0)
|
||||
, _severity = Just DsError
|
||||
, _source = Just defaultDiagnosticSource
|
||||
, _code = Nothing
|
||||
, _message = removeAsciiColors $ show e
|
||||
, _relatedInformation = Nothing
|
||||
}]
|
||||
|
||||
removeAsciiColors :: Text -> Text
|
||||
removeAsciiColors = T.replace "\ESC[1;31m" "" . T.replace "\ESC[0m" ""
|
||||
-- Dhall.Import(Cycle, ReferentiallyOpaque, MissingFile, MissingEnvironmentVariable, MissingImports,
|
||||
-- HashMismatch, CannotImportHTTPURL)
|
||||
|
||||
getSourceRange :: TypeError Src X -> Range
|
||||
getSourceRange (TypeError ctx expr msg) = case expr of
|
||||
Dhall.Core.Note (Src (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))
|
||||
_ -> error "expected note" -- $ Range (Position 0 0) (Position (negate 1) 0) -- FIXME: default case
|
||||
where
|
||||
unPos = Text.Megaparsec.unPos
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------- Megaparsec utils: ----------------------------------------
|
||||
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
-- | Get length of the “pointer” to display under a given 'ErrorItem'.
|
||||
|
||||
errorItemLength :: Text.Megaparsec.ErrorItem t -> Int
|
||||
errorItemLength = \case
|
||||
Text.Megaparsec.Tokens ts -> length ts
|
||||
_ -> 1
|
||||
|
||||
errorFancyLength :: Text.Megaparsec.ShowErrorComponent e => Text.Megaparsec.ErrorFancy e -> Int
|
||||
errorFancyLength = \case
|
||||
Text.Megaparsec.ErrorCustom a -> Text.Megaparsec.errorComponentLen a
|
||||
_ -> 1
|
||||
-- errorBundlePretty
|
||||
-- :: forall s e. ( Text.Megaparsec.Stream s
|
||||
-- , Text.Megaparsec.Error.ShowErrorComponent e
|
||||
-- )
|
||||
-- => Text.Megaparsec.ParseErrorBundle s e -- ^ Parse error bundle to display
|
||||
-- -> String -- ^ Textual rendition of the bundle
|
||||
-- errorBundlePretty Text.Megaparsec.Error.ParseErrorBundle {..} =
|
||||
-- let (r, _) = foldl' f (id, bundlePosState) bundleErrors
|
||||
-- in drop 1 (r "")
|
||||
-- where
|
||||
-- f :: (ShowS, Text.Megaparsec.PosState s)
|
||||
-- -> Text.Megaparsec.ParseError s e
|
||||
-- -> (ShowS, Text.Megaparsec.PosState s)
|
||||
-- f (o, !pst) e = (o . (outChunk ++), pst')
|
||||
-- where
|
||||
-- (epos, sline, pst') = reachOffset (errorOffset e) pst
|
||||
-- outChunk =
|
||||
-- "\n" <> sourcePosPretty epos <> ":\n" <>
|
||||
-- padding <> "|\n" <>
|
||||
-- lineNumber <> " | " <> sline <> "\n" <>
|
||||
-- padding <> "| " <> rpadding <> pointer <> "\n" <>
|
||||
-- Text.Megaparsec.Error.parseErrorTextPretty e
|
||||
-- lineNumber = (show . unPos . sourceLine) epos
|
||||
-- padding = replicate (length lineNumber + 1) ' '
|
||||
-- rpadding =
|
||||
-- if pointerLen > 0
|
||||
-- then replicate rpshift ' '
|
||||
-- else ""
|
||||
-- rpshift = unPos (sourceColumn epos) - 1
|
||||
-- pointer = replicate pointerLen '^'
|
||||
-- pointerLen =
|
||||
-- if rpshift + elen > slineLen
|
||||
-- then slineLen - rpshift + 1
|
||||
-- else elen
|
||||
-- slineLen = length sline
|
||||
-- elen =
|
||||
-- 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
|
||||
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
{-| Common utilities / types for the LSP part -}
|
||||
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
|
||||
|
||||
|
||||
sendToClient :: FromServerMessage -> ReaderT (LSP.Core.LspFuncs ()) IO ()
|
||||
sendToClient msg = do
|
||||
lf <- ask
|
||||
liftIO $ LSP.Core.sendFunc lf msg
|
||||
|
||||
nextLspReqId :: ReaderT (LSP.Core.LspFuncs ()) IO J.LspId
|
||||
nextLspReqId = asks LSP.Core.getNextReqId >>= liftIO
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
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 Control.Lens
|
||||
|
||||
-- ! 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
|
||||
dispatcher :: LSP.Core.LspFuncs () -> TChan FromClientMessage -> IO ()
|
||||
dispatcher lf inp = do
|
||||
liftIO $ LSP.Utility.logs "inside dispatcher"
|
||||
flip runReaderT lf $ forever $ do
|
||||
inval <- liftIO $ atomically $ readTChan inp
|
||||
case inval of
|
||||
|
||||
(RspFromClient rm) ->
|
||||
liftIO $ LSP.Utility.logs $ "reactor:got RspFromClient:" ++ show rm
|
||||
|
||||
-- -------------------------------
|
||||
|
||||
(NotInitialized _notification) -> do
|
||||
liftIO $ LSP.Utility.logm "****** reactor: processing Initialized Notification"
|
||||
|
||||
let
|
||||
registration = J.Registration "dhall-lsp-server-registered" J.WorkspaceExecuteCommand Nothing
|
||||
let registrations = J.RegistrationParams (J.List [registration])
|
||||
rid <- nextLspReqId
|
||||
|
||||
-- client/registerCapability
|
||||
sendToClient $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest rid registrations
|
||||
|
||||
-- example of showMessageRequest
|
||||
-- let
|
||||
-- params = J.ShowMessageRequestParams J.MtWarning "choose an option for XXX"
|
||||
-- (Just [J.MessageActionItem "option a", J.MessageActionItem "option b"])
|
||||
-- rid1 <- nextLspReqId
|
||||
|
||||
-- reactorSend $ ReqShowMessage $ fmServerShowMessageRequest rid1 params
|
||||
|
||||
-- -------------------------------
|
||||
|
||||
(NotDidOpenTextDocument notification) -> do
|
||||
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidOpenTextDocument"
|
||||
let
|
||||
doc = notification ^. J.params
|
||||
. J.textDocument
|
||||
. J.uri
|
||||
v = notification ^. J.params
|
||||
. J.textDocument
|
||||
. J.version
|
||||
fileName = J.uriToFilePath doc
|
||||
liftIO $ LSP.Utility.logs $ "********* fileName=" <> show fileName <> "version: " <> show v
|
||||
sendDiagnostics doc (Just v)
|
||||
|
||||
|
||||
|
||||
(NotDidSaveTextDocument notification) -> do
|
||||
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidSaveTextDocument"
|
||||
let
|
||||
doc = notification ^. J.params
|
||||
. J.textDocument
|
||||
. J.uri
|
||||
|
||||
fileName = J.uriToFilePath doc
|
||||
liftIO $ LSP.Utility.logs $ "********* fileName=" ++ show fileName
|
||||
sendDiagnostics doc Nothing
|
||||
|
||||
|
||||
(NotDidCloseTextDocument req) -> do
|
||||
liftIO $ LSP.Utility.logm "****** reactor: processing NotDidCloseTextDocument"
|
||||
let
|
||||
doc = req ^. J.params
|
||||
. J.textDocument
|
||||
. J.uri
|
||||
fileName = J.uriToFilePath doc
|
||||
liftIO $ LSP.Utility.logs $ "********* fileName=" ++ show fileName
|
||||
sendEmptyDiagnostics doc Nothing
|
||||
om -> do
|
||||
liftIO $ LSP.Utility.logs $ "\nIGNORING!!!\n HandlerRequest:" ++ show om
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
{-| This module contains everything related on how LSP server handles diagnostic messages. -}
|
||||
module LSP.Handlers.Diagnostics( sendEmptyDiagnostics
|
||||
, sendDiagnostics
|
||||
) where
|
||||
|
||||
import Language.Haskell.LSP.Messages
|
||||
import Language.Haskell.LSP.Diagnostics
|
||||
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 System.IO.Unsafe
|
||||
import qualified Data.Text.IO
|
||||
import qualified Data.SortedList
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
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 fileUri version =
|
||||
publishDiagnostics 10 fileUri version defaultDiagnosticBySource
|
||||
|
||||
defaultDiagnosticBySource :: DiagnosticsBySource
|
||||
defaultDiagnosticBySource = Map.singleton (Just defaultDiagnosticSource) (Data.SortedList.toSortedList [])
|
||||
|
||||
-- | 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 fileUri version = 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
|
||||
diags' <- lift $ compilerDiagnostics filePath (J.getUri fileUri) 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 maxToPublish uri v diags = do
|
||||
lf <- ask
|
||||
liftIO $ (LSP.Core.publishDiagnosticsFunc lf) maxToPublish uri v diags
|
||||
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
|
||||
{-| This is the entry point for the LSP server. All calls are delegated to the haskell-lsp library
|
||||
which does the heavy lifting.
|
||||
-}
|
||||
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
|
||||
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 LSP.Dispatcher(dispatcher)
|
||||
|
||||
run :: Maybe String -> IO () -> IO Int
|
||||
run maybeLog dispatcherProc = flip Control.Exception.catches handlers $ do
|
||||
|
||||
rin <- atomically newTChan :: IO (TChan FromClientMessage)
|
||||
|
||||
let
|
||||
dp lf = do
|
||||
_rpid <- forkIO $ dispatcher lf rin
|
||||
dispatcherProc
|
||||
pure Nothing
|
||||
|
||||
flip Control.Exception.finally finalProc $ do
|
||||
setupLogger maybeLog
|
||||
LSP.Control.run (pure (Right ()), dp) (lspHandlers rin) lspOptions Nothing
|
||||
-- TODO: CTRL.run takes logger as the last option, and should write LSP log into it
|
||||
-- TODO: 1. make upstream logger write in the format which lsp-inspector can read
|
||||
-- TODO: 2. it would be cool, if we start writing log on file creation, e.g.
|
||||
-- TODO: e.g. "touch file /var/log/dhall-lsp-server/log-2018-03-12-12-45-34-fe5dk3.log to enable LSP logging"
|
||||
|
||||
where
|
||||
handlers = [ Control.Exception.Handler ioExcept
|
||||
, Control.Exception.Handler someExcept
|
||||
]
|
||||
finalProc = System.Log.Logger.removeAllHandlers
|
||||
ioExcept (e :: Control.Exception.IOException) = error $ show $ e -- print e >> pure 1
|
||||
someExcept (e :: Control.Exception.SomeException) = error $ show $ e -- print e >> pure 1
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
|
||||
-- | sets the output logger.
|
||||
-- | if no filename is provided then logger is disabled, if input is string `[OUTPUT]` then log goes to stderr,
|
||||
-- | which then redirects inside VSCode to the output pane of the plugin.
|
||||
setupLogger :: Maybe FilePath -> IO () -- TODO: ADD verbosity
|
||||
setupLogger Nothing = pure ()
|
||||
setupLogger (Just "[OUTPUT]") = LSP.Core.setupLogger Nothing [] System.Log.Logger.DEBUG
|
||||
setupLogger file = LSP.Core.setupLogger file [] System.Log.Logger.DEBUG
|
||||
|
||||
|
||||
|
||||
syncOptions :: J.TextDocumentSyncOptions
|
||||
syncOptions = J.TextDocumentSyncOptions
|
||||
{ J._openClose = Just True
|
||||
, J._change = Just J.TdSyncNone--J.TdSyncIncremental
|
||||
, J._willSave = Just False
|
||||
, J._willSaveWaitUntil = Just False
|
||||
, J._save = Just $ J.SaveOptions $ Just False
|
||||
}
|
||||
|
||||
-- Capabilities entry point
|
||||
lspOptions :: LSP.Core.Options
|
||||
lspOptions = def { LSP.Core.textDocumentSync = Just syncOptions
|
||||
-- , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List ["lsp-hello-command"]))
|
||||
-- , Core.codeLensProvider = Just (J.CodeLensOptions (Just False))
|
||||
}
|
||||
|
||||
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.didOpenTextDocumentNotificationHandler = Just $ passHandler rin NotDidOpenTextDocument
|
||||
, LSP.Core.didSaveTextDocumentNotificationHandler = Just $ passHandler rin NotDidSaveTextDocument
|
||||
, LSP.Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
|
||||
, LSP.Core.didCloseTextDocumentNotificationHandler = Just $ passHandler rin NotDidCloseTextDocument
|
||||
, LSP.Core.cancelNotificationHandler = Just $ passHandler rin NotCancelRequestFromClient
|
||||
, LSP.Core.responseHandler = Just $ responseHandlerCb rin
|
||||
-- , Core.codeActionHandler = Just $ passHandler rin ReqCodeAction
|
||||
, LSP.Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand
|
||||
}
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> LSP.Core.Handler a
|
||||
passHandler rin convert notification =
|
||||
atomically $ writeTChan rin (convert notification)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
responseHandlerCb :: TChan FromClientMessage -> LSP.Core.Handler J.BareResponseMessage
|
||||
responseHandlerCb _rin resp =
|
||||
LSP.Utility.logs $ ">>> got ignoring ResponseMessage:" ++ show resp
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
module Prelude
|
||||
( module Relude
|
||||
) where
|
||||
|
||||
import Relude
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
resolver: nightly-2018-12-17
|
||||
packages:
|
||||
- dhall
|
||||
- dhall-bash
|
||||
- dhall-json
|
||||
- dhall-text
|
||||
- dhall-lsp-server
|
||||
nix:
|
||||
packages:
|
||||
- ncurses
|
||||
- zlib
|
||||
|
|
@ -4,6 +4,7 @@ packages:
|
|||
- dhall-bash
|
||||
- dhall-json
|
||||
- dhall-text
|
||||
- dhall-lsp-server
|
||||
nix:
|
||||
packages:
|
||||
- ncurses
|
||||
|
|
|
|||
Loading…
Reference in New Issue