packages feed

dhall-lsp-server 1.0.1 → 1.0.2

raw patch · 20 files changed

+272/−24 lines, 20 filesdep +haskell-lsp-typesdep +lsp-testdep +tastydep ~basedep ~dhalldep ~dhall-json

Dependencies added: haskell-lsp-types, lsp-test, tasty, tasty-hspec

Dependency ranges changed: base, dhall, dhall-json, haskell-lsp, text

Files

app/Main.hs view
@@ -15,11 +15,13 @@ import qualified Data.Version import qualified Dhall.LSP.Server import qualified Paths_dhall_lsp_server+import qualified GHC.IO.Encoding  -- | Top-level program options data Options = Options {     command :: Mode   , logFile :: Maybe FilePath+  , version :: Bool }  -- | The mode in which to run @dhall-lsp-server@@@ -27,14 +29,19 @@  parseOptions :: Parser Options parseOptions =-  Options <$> parseMode <*> Options.Applicative.optional parseLogFile+  Options <$> parseMode <*> Options.Applicative.optional parseLogFile <*> parseVersion   where     parseLogFile = Options.Applicative.strOption       (Options.Applicative.long "log" <> Options.Applicative.help         "If present writes debug output to the specified file"       ) +    parseVersion = Options.Applicative.switch+      (  Options.Applicative.long "version"+      <> Options.Applicative.help "Display version"+      ) + subcommand :: String -> String -> Parser a -> Parser a subcommand name description parser = Options.Applicative.hsubparser   (Options.Applicative.command name parserInfo@@ -57,11 +64,20 @@   )  runCommand :: Options -> IO ()-runCommand Options {..} = case command of-  Version -> putStrLn (Data.Version.showVersion Paths_dhall_lsp_server.version)-  LSPServer -> Dhall.LSP.Server.run logFile+runCommand Options {..} = do+  if version+    then printVersion+    else case command of+      Version -> printVersion+      LSPServer -> Dhall.LSP.Server.run logFile+  where+    printVersion = putStrLn (Data.Version.showVersion Paths_dhall_lsp_server.version)  -- | Entry point for the @dhall-lsp-server@ executable main :: IO ()-main = do options <- Options.Applicative.execParser parserInfoOptions-          runCommand options+main = do+    GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8++    options <- Options.Applicative.execParser parserInfoOptions++    runCommand options
dhall-lsp-server.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name:           dhall-lsp-server-Version: 1.0.1+Version: 1.0.2 synopsis:       Language Server Protocol (LSP) server for Dhall homepage:       https://github.com/dhall-lang/dhall-haskell/dhall-lsp-server#readme bug-reports:    https://github.com/dhall-lang/dhall-haskell/issues@@ -13,6 +13,10 @@ extra-source-files:     README.md     ChangeLog.md+    tests/fixtures/completion/*.dhall+    tests/fixtures/diagnostics/*.dhall+    tests/fixtures/linting/*.dhall+    tests/fixtures/hovering/*.dhall  source-repository head   type: git@@ -46,10 +50,10 @@     , containers           >= 0.5.11.0 && < 0.7     , data-default         >= 0.7.1.1  && < 0.8     , directory            >= 1.2.2.0  && < 1.4-    , dhall                >= 1.26.0   && < 1.27-    , dhall-json           >= 1.4      && < 1.5+    , dhall                >= 1.26.0   && < 1.28+    , dhall-json           >= 1.4      && < 1.6     , filepath             >= 1.4.2    && < 1.5-    , haskell-lsp          >= 0.15.0.0 && < 0.16+    , haskell-lsp          >= 0.15.0.0 && < 0.17     , rope-utf16-splay     >= 0.3.1.0  && < 0.4     , hslogger             >= 1.2.10   && < 1.4     , lens                 >= 4.16.1   && < 4.19@@ -102,3 +106,17 @@     --  See: https://ghc.haskell.org/trac/ghc/ticket/10970     if impl(ghc < 8.0)       Buildable: False++Test-Suite tests+    Type: exitcode-stdio-1.0+    Hs-Source-Dirs: tests+    Main-Is: Main.hs+    GHC-Options: -Wall+    Build-Depends:+        base                                   ,+        haskell-lsp-types >= 0.15.0  && < 0.16 ,+        lsp-test          >= 0.6     && < 0.7  ,+        tasty             >= 0.11.2  && < 1.3  ,+        tasty-hspec       >= 1.1     && < 1.2  ,+        text              >= 0.11    && < 1.3+    Default-Language: Haskell2010
src/Dhall/LSP/Backend/Dhall.hs view
@@ -19,7 +19,6 @@  ) where  import Dhall.Parser (Src)-import Dhall.TypeCheck (X) import Dhall.Core (Expr)  import qualified Dhall.Core as Dhall@@ -36,6 +35,7 @@  import Data.List.NonEmpty (NonEmpty((:|))) import Data.Text (Text)+import Data.Void (Void) import System.FilePath (splitDirectories, takeFileName, takeDirectory) import Lens.Family (view, set) import Control.Exception (SomeException, catch)@@ -65,10 +65,10 @@ fileIdentifierFromURI _ = Nothing  -- | A well-typed expression.-newtype WellTyped = WellTyped {fromWellTyped :: Expr Src X}+newtype WellTyped = WellTyped {fromWellTyped :: Expr Src Void}  -- | A fully normalised expression.-newtype Normal = Normal {fromNormal :: Expr Src X}+newtype Normal = Normal {fromNormal :: Expr Src Void}  -- An import graph, represented by list of import dependencies. type ImportGraph = [Dhall.Depends]@@ -119,7 +119,7 @@ --   normalisation. data DhallError = ErrorInternal SomeException                 | ErrorImportSourced (Dhall.SourcedException Dhall.MissingImports)-                | ErrorTypecheck (Dhall.TypeError Src X)+                | ErrorTypecheck (Dhall.TypeError Src Void)                 | ErrorParse Dhall.ParseError  -- | Parse a Dhall expression.@@ -133,7 +133,7 @@  -- | Resolve all imports in an expression. load :: FileIdentifier -> Expr Src Dhall.Import -> Cache ->-  IO (Either DhallError (Cache, Expr Src X))+  IO (Either DhallError (Cache, Expr Src Void)) load (FileIdentifier chained) expr (Cache graph cache) = do   let emptyStatus = Dhall.emptyStatus ""       status = -- reuse cache and import graph@@ -151,7 +151,7 @@  -- | Typecheck a fully resolved expression. Returns a certification that the --   input was well-typed along with its (well-typed) type.-typecheck :: Expr Src X -> Either DhallError (WellTyped, WellTyped)+typecheck :: Expr Src Void -> Either DhallError (WellTyped, WellTyped) typecheck expr = case Dhall.typeOf expr of   Left err -> Left $ ErrorTypecheck err   Right typ -> Right (WellTyped expr, WellTyped typ)
src/Dhall/LSP/Backend/Parsing.hs view
@@ -137,7 +137,7 @@     setSourcePos left     begin <- getSourcePos     (tokens, _) <--      Megaparsec.match $ (localRaw *> return ()) <|> (httpRaw *> return ())+      Megaparsec.match $ (localOnly *> return ()) <|> (httpRaw *> return ())     end <- getSourcePos     _ <- Megaparsec.takeRest     return (Src begin end tokens)
src/Dhall/LSP/Backend/Typing.hs view
@@ -2,7 +2,7 @@  import Dhall.Context (Context, insert, empty) import Dhall.Core (Binding(..), Expr(..), subExpressions, normalize, shift, subst, Var(..), pretty)-import Dhall.TypeCheck (typeWithA, X, TypeError(..))+import Dhall.TypeCheck (typeWithA, TypeError(..)) import Dhall.Parser (Src(..))  import Data.Monoid ((<>))@@ -10,7 +10,7 @@ import Data.Text (Text) import Control.Applicative ((<|>)) import Data.Bifunctor (first)-import Data.Void (absurd)+import Data.Void (absurd, Void)  import Dhall.LSP.Backend.Parsing (getLetAnnot, getLetIdentifier,   getLamIdentifier, getForallIdentifier)@@ -20,7 +20,7 @@ -- | Find the type of the subexpression at the given position. Assumes that the --   input expression is well-typed. Also returns the Src descriptor containing --   that subexpression if possible.-typeAt :: Position -> WellTyped -> Either String (Maybe Src, Expr Src X)+typeAt :: Position -> WellTyped -> Either String (Maybe Src, Expr Src Void) typeAt pos expr = do   let expr' = fromWellTyped expr   (mSrc, typ) <- first show $ typeAt' pos empty expr'@@ -28,7 +28,7 @@     Just src -> return (Just src, normalize typ)     Nothing -> return (srcAt pos expr', normalize typ) -typeAt' :: Position -> Context (Expr Src X) -> Expr Src X -> Either (TypeError Src X) (Maybe Src, Expr Src X)+typeAt' :: Position -> Context (Expr Src Void) -> Expr Src Void -> Either (TypeError Src Void) (Maybe Src, Expr Src Void) -- the user hovered over the bound name in a let expression typeAt' pos ctx (Note src (Let (Binding { value = a }) _)) | pos `inside` getLetIdentifier src = do   typ <- typeWithA absurd ctx a@@ -96,7 +96,7 @@ annotateLet pos expr = do   annotateLet' pos empty (fromWellTyped expr) -annotateLet' :: Position -> Context (Expr Src X) -> Expr Src X -> Either String (Src, Text)+annotateLet' :: Position -> Context (Expr Src Void) -> Expr Src Void -> Either String (Src, Text) -- the input only contains singleton lets annotateLet' pos ctx (Note src e@(Let (Binding { value = a }) _))   | not $ any (pos `inside`) [ src' | Note src' _ <- toListOf subExpressions e ]
src/Dhall/LSP/Handlers.hs view
@@ -8,10 +8,10 @@ import qualified Data.Aeson as J import qualified Data.Rope.UTF16 as Rope +import Data.Void (Void) import Dhall.Core (Expr(Note, Embed), pretty, Import(..), ImportHashed(..), ImportType(..), headers) import Dhall.Import (localToPath) import Dhall.Parser (Src(..))-import Dhall.TypeCheck (X)  import Dhall.LSP.Backend.Completion (Completion(..), completionQueryAt,   completeEnvironmentImport, completeLocalImport, buildCompletionContext, completeProjections, completeFromContext)@@ -104,7 +104,7 @@     Just (LSP.VirtualFile _ rope _) -> return (Rope.toText rope)     Nothing -> fail $ "Could not find " <> show uri <> " in VFS." -loadFile :: J.Uri -> HandlerM (Expr Src X)+loadFile :: J.Uri -> HandlerM (Expr Src Void) loadFile uri = do   txt <- readUri uri   fileIdentifier <- fileIdentifierFromUri uri
+ tests/Main.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad.IO.Class (liftIO)+import Data.Maybe (fromJust)+import qualified Data.Text as T+import qualified GHC.IO.Encoding+import Language.Haskell.LSP.Test+import Language.Haskell.LSP.Types+  ( CompletionItem (..),+    Diagnostic (..),+    DiagnosticSeverity (..),+    Hover (..),+    HoverContents (..),+    MarkupContent (..),+    Position (..),+  )+import Test.Tasty+import Test.Tasty.Hspec++baseDir :: FilePath -> FilePath+baseDir d = "tests/fixtures/" <> d++hoveringSpec :: FilePath -> Spec+hoveringSpec dir =+  describe "Dhall.Hover"+    $ it "reports types on hover"+    $ runSession "dhall-lsp-server" fullCaps dir+    $ do+      docId <- openDoc "Types.dhall" "dhall"+      let typePos = Position 0 5+          functionPos = Position 2 7+          extractContents = _contents . fromJust+          getValue = T.unpack . _value+      typeHover <- getHover docId typePos+      funcHover <- getHover docId functionPos+      liftIO $ do+        case (extractContents typeHover, extractContents funcHover) of+          (HoverContents typeContent, HoverContents functionContent) -> do+            getValue typeContent `shouldBe` "Type"+            getValue functionContent `shouldBe` "{ home : Text, name : Text }"+          _ -> error "test failed"+        pure ()++lintingSpec :: FilePath -> Spec+lintingSpec fixtureDir =+  describe "Dhall.Lint" $ do+    it "reports unused bindings"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        _ <- openDoc "UnusedBindings.dhall" "dhall"+        diags <- waitForDiagnosticsSource "Dhall.Lint"+        _ <-+          liftIO $+            mapM+              ( \diag -> do+                  _severity diag `shouldBe` Just DsHint+                  T.unpack (_message diag) `shouldContain` "Unused let binding"+              )+              diags+        pure ()+    it "reports multiple hints"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        _ <- openDoc "SuperfluousIn.dhall" "dhall"+        diags <- waitForDiagnosticsSource "Dhall.Lint"+        liftIO $ length diags `shouldBe` 2+        let diag1 = head diags+            diag2 = diags !! 1+        liftIO $ do+          _severity diag1 `shouldBe` Just DsHint+          T.unpack (_message diag1) `shouldContain` "Superfluous 'in'"+          _severity diag2 `shouldBe` Just DsHint+          T.unpack (_message diag2) `shouldContain` "Unused let binding"++codeCompletionSpec :: FilePath -> Spec+codeCompletionSpec fixtureDir =+  describe "Dhall.Completion" $ do+    it "suggests user defined types"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        docId <- openDoc "CustomTypes.dhall" "dhall"+        cs <- getCompletions docId (Position {_line = 2, _character = 35})+        liftIO $ do+          let firstItem = head cs+          _label firstItem `shouldBe` "Config"+          _detail firstItem `shouldBe` Just "Type"+    it "suggests user defined functions"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        docId <- openDoc "CustomFunctions.dhall" "dhall"+        cs <- getCompletions docId (Position {_line = 6, _character = 7})+        liftIO $ do+          let firstItem = head cs+          _label firstItem `shouldBe` "makeUser"+          _detail firstItem `shouldBe` Just "\8704(user : Text) \8594 { home : Text }"+    it "suggests user defined bindings"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        docId <- openDoc "Bindings.dhall" "dhall"+        cs <- getCompletions docId (Position {_line = 0, _character = 59})+        liftIO $ do+          let firstItem = head cs+          _label firstItem `shouldBe` "bob"+          _detail firstItem `shouldBe` Just "Text"+    it "suggests functions from imports"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        docId <- openDoc "ImportedFunctions.dhall" "dhall"+        cs <- getCompletions docId (Position {_line = 0, _character = 33})+        liftIO $ do+          let firstItem = head cs+          _label firstItem `shouldBe` "makeUser"+          _detail firstItem `shouldBe` Just "\8704(user : Text) \8594 { home : Text }"++diagnosticsSpec :: FilePath -> Spec+diagnosticsSpec fixtureDir = do+  describe "Dhall.TypeCheck" $ do+    it "reports unbound variables"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        _ <- openDoc "UnboundVar.dhall" "dhall"+        [diag] <- waitForDiagnosticsSource "Dhall.TypeCheck"+        liftIO $ do+          _severity diag `shouldBe` Just DsError+          T.unpack (_message diag) `shouldContain` "Unbound variable"+    it "reports wrong type"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        _ <- openDoc "WrongType.dhall" "dhall"+        [diag] <- waitForDiagnosticsSource "Dhall.TypeCheck"+        liftIO $ do+          _severity diag `shouldBe` Just DsError+          T.unpack (_message diag) `shouldContain` "Expression doesn't match annotation"+  describe "Dhall.Import" $ do+    it "reports invalid imports"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        _ <- openDoc "InvalidImport.dhall" "dhall"+        [diag] <- waitForDiagnosticsSource "Dhall.Import"+        liftIO $ do+          _severity diag `shouldBe` Just DsError+          T.unpack (_message diag) `shouldContain` "Invalid input"+    it "reports missing imports"+      $ runSession "dhall-lsp-server" fullCaps fixtureDir+      $ do+        _ <- openDoc "MissingImport.dhall" "dhall"+        [diag] <- waitForDiagnosticsSource "Dhall.Import"+        liftIO $ do+          _severity diag `shouldBe` Just DsError+          T.unpack (_message diag) `shouldContain` "Missing file"+  describe "Dhall.Parser"+    $ it "reports invalid syntax"+    $ runSession "dhall-lsp-server" fullCaps fixtureDir+    $ do+      _ <- openDoc "InvalidSyntax.dhall" "dhall"+      [diag] <- waitForDiagnosticsSource "Dhall.Parser"+      liftIO $ _severity diag `shouldBe` Just DsError++main :: IO ()+main = do+  GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8+  diagnostics <- testSpec "Diagnostics" (diagnosticsSpec (baseDir "diagnostics"))+  linting <- testSpec "Linting" (lintingSpec (baseDir "linting"))+  completion <- testSpec "Completion" (codeCompletionSpec (baseDir "completion"))+  hovering <- testSpec "Hovering" (hoveringSpec (baseDir "hovering"))+  defaultMain+    ( testGroup "Tests"+        [ diagnostics,+          linting,+          completion,+          hovering+        ]+    )
+ tests/fixtures/completion/Bindings.dhall view
@@ -0,0 +1,1 @@+let alice = "Alice" let bob = "Bob" in { result = bob ++ al }
+ tests/fixtures/completion/CustomFunctions.dhall view
@@ -0,0 +1,7 @@+let makeUser =+        λ(user : Text)+      → let home = "/home/${user}"++        in  { home = home }++in  [ m
+ tests/fixtures/completion/CustomTypes.dhall view
@@ -0,0 +1,3 @@+let Config = { name : Text, age : Natural }++in { name = "alice", age = 20 } : C
+ tests/fixtures/completion/ImportedFunctions.dhall view
@@ -0,0 +1,1 @@+let Lib = ./Library.dhall in Lib.
+ tests/fixtures/completion/Library.dhall view
@@ -0,0 +1,3 @@+let makeUser = λ(user : Text) → let home = "/home/${user}" in { home = home }++in  { makeUser = makeUser }
+ tests/fixtures/diagnostics/InvalidImport.dhall view
@@ -0,0 +1,1 @@+./InvalidSyntax.dhall
+ tests/fixtures/diagnostics/InvalidSyntax.dhall view
@@ -0,0 +1,1 @@+let a = 2 + 2/
+ tests/fixtures/diagnostics/MissingImport.dhall view
@@ -0,0 +1,1 @@+./NonExistent.dhall
+ tests/fixtures/diagnostics/UnboundVar.dhall view
@@ -0,0 +1,1 @@+unboundVar
+ tests/fixtures/diagnostics/WrongType.dhall view
@@ -0,0 +1,1 @@+let a = "dhall" : List Text in a
+ tests/fixtures/hovering/Types.dhall view
@@ -0,0 +1,11 @@+let User = { name : Text, home : Text }++let mkUser =+        λ(_isAdmin : Bool)+      →       if _isAdmin++        then  { name = "admin", home = "/home/admin" }++        else  { name = "default", home = "/home/user" }++in  mkUser True : User
+ tests/fixtures/linting/SuperfluousIn.dhall view
@@ -0,0 +1,3 @@+let alice = { name = "Alice", age = 20 }++in  let carl = { name = "Carl", age = 22 } in alice
+ tests/fixtures/linting/UnusedBindings.dhall view
@@ -0,0 +1,7 @@+let alice = { name = "Alice", age = 20 }++let bob = { name = "Bob", age = 21 }++let carl = { name = "Carl", age = 22 }++in  alice