diff --git a/waspls/.gitignore b/waspls/.gitignore new file mode 100644 index 000000000..1a6ccf447 --- /dev/null +++ b/waspls/.gitignore @@ -0,0 +1,8 @@ +dist-newstyle +.hie + +*.orig +*~ +.dir-locals.el +.projectile +.vscode diff --git a/waspls/.hlint.yaml b/waspls/.hlint.yaml new file mode 100644 index 000000000..b1dc41cb4 --- /dev/null +++ b/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. diff --git a/waspls/CHANGELOG.md b/waspls/CHANGELOG.md new file mode 100644 index 000000000..1dee62bc5 --- /dev/null +++ b/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. diff --git a/waspls/LICENSE b/waspls/LICENSE new file mode 100644 index 000000000..ecbb42fec --- /dev/null +++ b/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. diff --git a/waspls/README.md b/waspls/README.md new file mode 100644 index 000000000..8d19a8bbe --- /dev/null +++ b/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. diff --git a/waspls/cabal.project b/waspls/cabal.project new file mode 100644 index 000000000..274bb7605 --- /dev/null +++ b/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 diff --git a/waspls/exe/Main.hs b/waspls/exe/Main.hs new file mode 100644 index 000000000..f7959c450 --- /dev/null +++ b/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." + ) diff --git a/waspls/hie.yaml b/waspls/hie.yaml new file mode 100644 index 000000000..04cd24395 --- /dev/null +++ b/waspls/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/waspls/src/Wasp/LSP/Core.hs b/waspls/src/Wasp/LSP/Core.hs new file mode 100644 index 000000000..3b748fea1 --- /dev/null +++ b/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 {} diff --git a/waspls/src/Wasp/LSP/Handlers.hs b/waspls/src/Wasp/LSP/Handlers.hs new file mode 100644 index 000000000..c970023e9 --- /dev/null +++ b/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)) diff --git a/waspls/src/Wasp/LSP/Server.hs b/waspls/src/Wasp/LSP/Server.hs new file mode 100644 index 000000000..1e475f5ed --- /dev/null +++ b/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)) diff --git a/waspls/waspls.cabal b/waspls/waspls.cabal new file mode 100644 index 000000000..e4bc5839f --- /dev/null +++ b/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 +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