Make basic Wasp LSP server (#611)

* Setup waspls project

* Basic LSP functionality implemented

Reports one diagnostic per file, updated on open, save, and change.

* Changes from code review

waspls/.gitignore

@@ -0,0 +1,8 @@
+dist-newstyle
+.hie
+
+*.orig
+*~
+.dir-locals.el
+.projectile
+.vscode

waspls/.hlint.yaml

@@ -0,0 +1,12 @@
+- arguments:
+  # NOTE: List of extensions below should reflect the list
+  #   of default extensions from package.yaml.
+  - -XOverloadedStrings
+  - -XScopedTypeVariables
+
+- ignore: {name: Use camelCase} # We can decide this on our own.
+- ignore: {name: Eta reduce} # We can decide this on our own.
+- ignore: {name: Use newtype instead of data} # We can decide this on our own.
+- ignore: {name: Use $>} # I find it makes code harder to read if enforced.
+- ignore: {name: Use list comprehension} # We can decide this on our own.
+- ignore: {name: Use ++} # I sometimes prefer concat over ++ due to the nicer formatting / extensibility.

waspls/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for waspls
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

waspls/LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2022 Wasp Team
+
+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.

waspls/README.md

@@ -0,0 +1,16 @@
+# Waspls
+
+This directory contains source code of the `wasp` language server (aka `waspls`)
+and this README is aimed at the contributors to the project.
+
+## Overview
+
+`waspls` is implemented in Haskell. It depends on `waspc` for parsing and
+analyzing wasp source code. Cabal is currently configured to look in `../waspc`
+for the `waspc` package, so do not move `waspls` out of the `wasp` repo without
+adjusting this line in `cabal.project`.
+
+## Usage
+
+Use in any place an LSP server can be used. Run `waspls --help` for usage
+information.

waspls/cabal.project

@@ -0,0 +1,23 @@
+with-compiler: ghc-8.10.7
+
+packages: . ../waspc/
+
+package waspls
+  -- This causes cabal to build modules on all cores, instead of just one,
+  -- therefore reducing our build times.
+  -- NOTE: If this is enabled at the same time as cabal's parallelization on package-level,
+  --   it can have counter-effect of increasing compilation time due to cabal and ghc fighting
+  --   for common resource: cpu threads.
+  --   This is not a problem for us for now since we have only one package in our project.
+  ghc-options: -j
+
+-- This causes cabal to build packages on all cores, instead of just one.
+-- This doesn't help when developing a single local package, but instead helps when
+-- building multiple packages at once, for example external dependencies.
+jobs: $ncpus
+
+-- Ensures that tests print their output to stdout as they execute.
+test-show-details: direct
+
+-- WARNING: Run cabal update if your local package index is older than this date.
+index-state: 2022-03-22T14:16:26Z

waspls/exe/Main.hs

@@ -0,0 +1,65 @@
+module Main where
+
+import Data.Version (showVersion)
+import qualified Options.Applicative as O
+import qualified Paths_waspls
+import qualified Wasp.LSP.Server as LSP
+
+main :: IO ()
+main = do
+  args <- parseArgsOrPrintUsageAndExit
+  case command args of
+    PrintVersion -> printVersion
+    Serve -> LSP.serve $ optionsLogFile $ options args
+  where
+    printVersion = putStrLn $ showVersion Paths_waspls.version
+
+parseArgsOrPrintUsageAndExit :: IO Args
+parseArgsOrPrintUsageAndExit =
+  O.execParser $
+    O.info
+      (O.helper <*> parseArgs)
+      (O.progDesc "LSP Server for the Wasp language" <> O.fullDesc)
+
+data Args = Args
+  { command :: Command,
+    options :: Options
+  }
+
+data Command = PrintVersion | Serve
+
+data Options = Options
+  { optionsLogFile :: Maybe FilePath,
+    optionsUseStdio :: Bool
+  }
+
+parseArgs :: O.Parser Args
+parseArgs = Args <$> parseCommand <*> parseOptions
+
+parseCommand :: O.Parser Command
+parseCommand = O.hsubparser versionCommand O.<|> pure Serve
+  where
+    versionCommand =
+      O.command
+        "version"
+        (O.info (pure PrintVersion) (O.fullDesc <> O.progDesc "Display version and exit"))
+        <> O.metavar "version"
+
+parseOptions :: O.Parser Options
+parseOptions = Options <$> O.optional parseLogFile <*> parseStdio
+  where
+    parseLogFile =
+      O.strOption
+        ( O.long "log"
+            <> O.help "Write log output to this file, if present. If not present, no logs are written. If set to `[OUTPUT]`, log output is sent to the LSP client."
+            <> O.action "file"
+            <> O.metavar "LOG_FILE"
+        )
+
+    -- vscode passes this option to the language server. waspls always uses stdio,
+    -- so this switch is ignored.
+    parseStdio =
+      O.switch
+        ( O.long "stdio"
+            <> O.help "Use stdio for communicating with LSP client. This is the only communication method we support for now, so this is the default anyway and this flag has no effect."
+        )

waspls/hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  cabal:

waspls/src/Wasp/LSP/Core.hs

@@ -0,0 +1,52 @@
+module Wasp.LSP.Core
+  ( ServerM,
+    ServerError (..),
+    Severity (..),
+    ServerState,
+    ServerConfig,
+  )
+where
+
+import Control.Monad.Trans.Except (ExceptT)
+import Control.Monad.Trans.State.Strict (StateT)
+import Data.Aeson
+import Data.Aeson.Types (prependFailure, typeMismatch)
+import Data.Default (Default (def))
+import Data.Text (Text)
+import Language.LSP.Server (LspT)
+
+type ServerM =
+  ExceptT ServerError (StateT ServerState (LspT ServerConfig IO))
+
+-- | The type for a language server error. These are separate from diagnostics
+-- and should be reported when the server fails to process a request/notification
+-- for some reason.
+data ServerError = ServerError Severity Text
+
+-- | Error severity levels
+data Severity
+  = -- | Displayed to user as an error
+    Error
+  | -- | Displayed to user as a warning
+    Warning
+  | -- | Displayed to user
+    Info
+  | -- | Not displayed to the user
+    Log
+
+data ServerConfig = ServerConfig {}
+
+instance Default ServerConfig where
+  def = ServerConfig {}
+
+instance FromJSON ServerConfig where
+  parseJSON (Object _) = pure ServerConfig
+  parseJSON invalid =
+    prependFailure
+      "parsing ServerConfig failed, "
+      (typeMismatch "Object" invalid)
+
+data ServerState = ServerState {}
+
+instance Default ServerState where
+  def = ServerState {}

waspls/src/Wasp/LSP/Handlers.hs

@@ -0,0 +1,130 @@
+module Wasp.LSP.Handlers
+  ( initializedHandler,
+    didOpenHandler,
+    didChangeHandler,
+    didSaveHandler,
+  )
+where
+
+import Control.Lens ((+~), (^.))
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Except (throwE)
+import Data.Function ((&))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Language.LSP.Server (Handlers, LspT)
+import qualified Language.LSP.Server as LSP
+import qualified Language.LSP.Types as LSP
+import qualified Language.LSP.Types.Lens as LSP
+import Language.LSP.VFS (virtualFileText)
+import qualified Wasp.Analyzer
+import qualified Wasp.Analyzer.AnalyzeError as WE
+import Wasp.Analyzer.Parser (Ctx (Ctx))
+import Wasp.Analyzer.Parser.SourceRegion (getRgnEnd, getRgnStart)
+import Wasp.LSP.Core (ServerConfig, ServerError (ServerError), ServerM, Severity (..))
+
+-- LSP notification and request handlers
+
+-- | "Initialized" notification is sent when the client is started. We don't
+-- have anything we need to do at initialization, but this is required to be
+-- implemented.
+--
+-- The client starts the LSP at its own discretion, but commonly this is done
+-- either when:
+--
+-- - A file of the associated language is opened (in this case `.wasp`)
+-- - A workspace is opened that has a project structure associated with the
+--   language (in this case, a `main.wasp` file in the root folder of the
+--   workspace)
+initializedHandler :: Handlers ServerM
+initializedHandler =
+  LSP.notificationHandler LSP.SInitialized $ const (return ())
+
+-- | "TextDocumentDidOpen" is sent by the client when a new document is opened.
+-- `diagnoseWaspFile` is run to analyze the newly opened document.
+didOpenHandler :: Handlers ServerM
+didOpenHandler =
+  LSP.notificationHandler LSP.STextDocumentDidOpen $ diagnoseWaspFile . extractUri
+
+-- | "TextDocumentDidChange" is sent by the client when a document is changed
+-- (i.e. when the user types/deletes text). `diagnoseWaspFile` is run to
+-- analyze the changed document.
+didChangeHandler :: Handlers ServerM
+didChangeHandler =
+  LSP.notificationHandler LSP.STextDocumentDidChange $ diagnoseWaspFile . extractUri
+
+-- | "TextDocumentDidSave" is sent by the client when a document is saved.
+-- `diagnoseWaspFile` is run to analyze the new contents of the document.
+didSaveHandler :: Handlers ServerM
+didSaveHandler =
+  LSP.notificationHandler LSP.STextDocumentDidSave $ diagnoseWaspFile . extractUri
+
+-- | Does not directly handle a notification or event, but should be run when
+-- text document content changes.
+--
+-- It analyzes the document contents and sends any error messages back to the
+-- LSP client. In the future, it will also store information about the analyzed
+-- file in "Wasp.LSP.State.State".
+diagnoseWaspFile :: LSP.Uri -> ServerM ()
+diagnoseWaspFile uri = do
+  src <- readVFSFile uri
+  let appSpecOrError = Wasp.Analyzer.analyze $ T.unpack src
+  diagnostics <- case appSpecOrError of
+    -- Valid wasp file, send no diagnostics
+    Right _ -> return $ LSP.List []
+    -- Report the error (for now, just one error per analyze is possible)
+    Left err ->
+      return $
+        LSP.List
+          [ waspErrorToLspDiagnostic err
+          ]
+  liftLSP $
+    LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
+      LSP.PublishDiagnosticsParams uri Nothing diagnostics
+  where
+    waspErrorToLspDiagnostic :: WE.AnalyzeError -> LSP.Diagnostic
+    waspErrorToLspDiagnostic err =
+      let errSrc = case err of
+            WE.ParseError _ -> "parse"
+            WE.TypeError _ -> "typecheck"
+            WE.EvaluationError _ -> "evaluate"
+          (errMsg, errCtx) = WE.getErrorMessageAndCtx err
+       in LSP.Diagnostic
+            { _range = waspCtxToLspRange errCtx,
+              _severity = Nothing,
+              _code = Nothing,
+              _source = Just errSrc,
+              _message = T.pack errMsg,
+              _tags = Nothing,
+              _relatedInformation = Nothing
+            }
+
+    waspCtxToLspRange :: Ctx -> LSP.Range
+    waspCtxToLspRange (Ctx region) =
+      LSP.Range
+        { _start = waspSourcePositionToLspPosition (getRgnStart region),
+          -- Increment end character by 1: Wasp uses an inclusive convention for
+          -- the end position, but LSP considers end position to not be part of
+          -- the range.
+          _end = waspSourcePositionToLspPosition (getRgnEnd region) & LSP.character +~ (1 :: LSP.UInt)
+        }
+
+    waspSourcePositionToLspPosition (WE.SourcePosition l c) =
+      LSP.Position (fromIntegral $ l - 1) (fromIntegral $ c - 1)
+
+-- | Run a LSP function in the "ServerM" monad.
+liftLSP :: LspT ServerConfig IO a -> ServerM a
+liftLSP m = lift (lift m)
+
+-- | Read the contents of a "Uri" in the virtual file system maintained by the
+-- LSP library.
+readVFSFile :: LSP.Uri -> ServerM Text
+readVFSFile uri = do
+  mVirtualFile <- liftLSP $ LSP.getVirtualFile $ LSP.toNormalizedUri uri
+  case mVirtualFile of
+    Just virtualFile -> return $ virtualFileText virtualFile
+    Nothing -> throwE $ ServerError Error $ "Could not find " <> T.pack (show uri) <> " in VFS."
+
+-- | Get the "Uri" from an object that has a "TextDocument".
+extractUri :: (LSP.HasParams a b, LSP.HasTextDocument b c, LSP.HasUri c LSP.Uri) => a -> LSP.Uri
+extractUri = (^. (LSP.params . LSP.textDocument . LSP.uri))

waspls/src/Wasp/LSP/Server.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+
+module Wasp.LSP.Server
+  ( serve,
+  )
+where
+
+import qualified Control.Concurrent.MVar as MVar
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import qualified Control.Monad.Trans.Except as Except
+import qualified Control.Monad.Trans.State.Strict as State
+import qualified Data.Aeson as Aeson
+import Data.Default (Default (def))
+import qualified Data.Text as Text
+import qualified Language.LSP.Server as LSP
+import qualified Language.LSP.Types as LSP
+import System.Exit (ExitCode (ExitFailure), exitWith)
+import qualified System.Log.Logger
+import Wasp.LSP.Core (ServerConfig, ServerError (ServerError), ServerM, ServerState, Severity (..))
+import Wasp.LSP.Handlers
+
+serve :: Maybe FilePath -> IO ()
+serve maybeLogFile = do
+  setupLspLogger maybeLogFile
+
+  let defaultServerState = def :: ServerState
+  state <- MVar.newMVar defaultServerState
+
+  let lspServerInterpretHandler env =
+        LSP.Iso {forward = runHandler, backward = liftIO}
+        where
+          runHandler :: ServerM a -> IO a
+          runHandler handler =
+            -- Get the state from the "MVar", run the handler in IO and update
+            -- the "MVar" state with the end state of the handler.
+            MVar.modifyMVar state \oldState -> do
+              LSP.runLspT env do
+                (e, newState) <- State.runStateT (Except.runExceptT handler) oldState
+                result <- case e of
+                  Left (ServerError severity errMessage) -> sendErrorMessage severity errMessage
+                  Right a -> return a
+
+                return (newState, result)
+
+  exitCode <-
+    LSP.runServer
+      LSP.ServerDefinition
+        { defaultConfig = def :: ServerConfig,
+          onConfigurationChange = lspServerUpdateConfig,
+          doInitialize = lspServerDoInitialize,
+          staticHandlers = lspServerHandlers,
+          interpretHandler = lspServerInterpretHandler,
+          options = lspServerOptions
+        }
+
+  case exitCode of
+    0 -> return ()
+    n -> exitWith (ExitFailure n)
+
+-- | Setup global DEBUG logger. Logs at other levels are ignored.
+--
+-- Use 'System.Log.Logger.logM' at "DEBUG" level to write to this log.
+--
+-- @setupLspLogger Nothing@ doesn't set up any logger, so logs are not output
+-- anywhere.
+--
+-- @setupLspLogger (Just "[OUTPUT]")@ sends log messages to the LSP client
+--
+-- @setupLspLogger (Just filepath)@ writes log messages to the path given
+setupLspLogger :: Maybe FilePath -> IO ()
+setupLspLogger Nothing = pure ()
+setupLspLogger (Just "[OUTPUT]") = LSP.setupLogger Nothing [] System.Log.Logger.DEBUG
+setupLspLogger file = LSP.setupLogger file [] System.Log.Logger.DEBUG
+
+-- | Returns either a JSON parsing error message or the updated "ServerConfig".
+lspServerUpdateConfig :: ServerConfig -> Aeson.Value -> Either Text.Text ServerConfig
+lspServerUpdateConfig _oldConfig json =
+  case Aeson.fromJSON json of
+    Aeson.Success config -> Right config
+    Aeson.Error string -> Left (Text.pack string)
+
+lspServerDoInitialize ::
+  LSP.LanguageContextEnv ServerConfig ->
+  LSP.Message 'LSP.Initialize ->
+  IO (Either LSP.ResponseError (LSP.LanguageContextEnv ServerConfig))
+lspServerDoInitialize env _req = return (Right env)
+
+lspServerOptions :: LSP.Options
+lspServerOptions =
+  (def :: LSP.Options)
+    { LSP.textDocumentSync = Just syncOptions,
+      LSP.completionTriggerCharacters = Just [':']
+    }
+
+lspServerHandlers :: LSP.Handlers ServerM
+lspServerHandlers =
+  mconcat
+    [ initializedHandler,
+      didOpenHandler,
+      didSaveHandler,
+      didChangeHandler
+    ]
+
+-- | Options to tell the client how to update the server about the state of text
+-- documents in the workspace.
+syncOptions :: LSP.TextDocumentSyncOptions
+syncOptions =
+  LSP.TextDocumentSyncOptions
+    { -- Send open/close notifications be sent to the server.
+      _openClose = Just True,
+      -- Keep a copy of text documents contents in the VFS. When the document is
+      -- changed, only send the updates instead of the entire contents.
+      _change = Just LSP.TdSyncIncremental,
+      -- Don't send will-save notifications to the server.
+      _willSave = Just False,
+      -- Don't send will-save-wait-until notifications to the server.
+      _willSaveWaitUntil = Just False,
+      -- Send save notifications to the server.
+      _save = Just (LSP.InR (LSP.SaveOptions (Just True)))
+    }
+
+-- | Send an error message to the LSP client.
+--
+-- Sends "Severity.Log" level errors to the output panel. Higher severity errors
+-- are displayed in the window (i.e. in VSCode as a toast notification in the
+-- bottom right).
+sendErrorMessage :: Severity -> Text.Text -> LSP.LspT ServerConfig IO a
+sendErrorMessage Log errMessage = do
+  let messageType = LSP.MtLog
+
+  LSP.sendNotification LSP.SWindowLogMessage $
+    LSP.LogMessageParams {_xtype = messageType, _message = errMessage}
+  liftIO (fail (Text.unpack errMessage))
+sendErrorMessage severity errMessage = do
+  let messageType = case severity of
+        Error -> LSP.MtError
+        Warning -> LSP.MtWarning
+        Info -> LSP.MtInfo
+        Log -> LSP.MtLog
+
+  LSP.sendNotification LSP.SWindowShowMessage $
+    LSP.ShowMessageParams {_xtype = messageType, _message = errMessage}
+  liftIO (fail (Text.unpack errMessage))

waspls/waspls.cabal

@@ -0,0 +1,76 @@
+cabal-version:      2.4
+
+-- TODO: It make sense in the future to move this into "waspc" project as a
+-- separate project, but for now it is separated.
+
+name:               waspls
+version:            0.1.0.0
+description:        Please see the README on GitHub at <https://github.com/wasp-lang/wasp/waspls#readme>
+homepage:           https://github.com/wasp-lang/wasp/waspls#readme
+bug-reports:        https://github.com/wasp-lang/wasp/issues
+author:             Wasp Team
+maintainer:         team@wasp-lang.dev
+copyright:          Wasp, Inc.
+license:            MIT
+license-file:       LICENSE
+extra-source-files:
+  README.md
+  CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/wasp-lang/wasp
+
+common common-all
+  default-language: Haskell2010
+  ghc-options:
+    -Wall
+    -optP-Wno-nonportable-include-path
+    -fwrite-ide-info -hiedir=.hie
+  default-extensions:
+    OverloadedStrings
+    ScopedTypeVariables
+    FlexibleContexts
+    MultiParamTypeClasses
+    DisambiguateRecordFields
+
+common common-exe
+  ghc-options:
+    -threaded -rtsopts -with-rtsopts=-N
+
+library
+  import:           common-all
+  exposed-modules:
+    Wasp.LSP.Server
+    Wasp.LSP.Core
+    Wasp.LSP.Handlers
+  other-modules:
+    Paths_waspls
+  hs-source-dirs:
+    src
+  build-depends:
+    , base ^>=4.14.3.0
+    , lsp ^>=1.4.0.0
+    , lsp-types ^>=1.4.0.1
+    , containers ^>=0.6.5.1
+    , mtl ^>=2.2.2
+    , transformers ^>=0.5.6.2
+    , text ^>=1.2.4.1
+    , data-default ^>=0.7.1.1
+    , hslogger ^>=1.3.1.0
+    , aeson ^>=1.5.6
+    , lens ^>=5.1
+    , waspc
+
+executable waspls
+  import:           common-all, common-exe
+  main-is:          Main.hs
+  other-modules:
+    Paths_waspls
+  hs-source-dirs:
+    exe
+  build-depends:
+    , base ^>=4.14.3.0
+    , optparse-applicative ^>=0.17.0.0
+    , waspls
+  default-language: Haskell2010