diff --git a/waspc/data/lsp/templates/ts/action.fn.ts b/waspc/data/lsp/templates/ts/action.fn.ts new file mode 100644 index 000000000..ae6813ff8 --- /dev/null +++ b/waspc/data/lsp/templates/ts/action.fn.ts @@ -0,0 +1,9 @@ +import { {{upperDeclName}} } from '@wasp/actions/types' + +{{#named?}}export {{/named?}}const {{name}}: {{upperDeclName}} = async (args, context) => { + // Implementation goes here +} + +{{#default?}} +export default {{name}} +{{/default?}} diff --git a/waspc/data/lsp/templates/ts/operation.fn.js b/waspc/data/lsp/templates/ts/operation.fn.js new file mode 100644 index 000000000..99287782d --- /dev/null +++ b/waspc/data/lsp/templates/ts/operation.fn.js @@ -0,0 +1,7 @@ +{{#named?}}export {{/named?}}const {{name}} = async (args, context) => { + // Implementation goes here +} + +{{#default?}} +export default {{name}} +{{/default?}} diff --git a/waspc/data/lsp/templates/ts/page.component.jsx b/waspc/data/lsp/templates/ts/page.component.jsx new file mode 100644 index 000000000..c41f509e6 --- /dev/null +++ b/waspc/data/lsp/templates/ts/page.component.jsx @@ -0,0 +1,9 @@ +{{#named?}}export {{/named?}}function {{name}}() { + return ( +
Hello world!
+ ) +} + +{{#default?}} +export default {{name}} +{{/default?}} diff --git a/waspc/data/lsp/templates/ts/query.fn.ts b/waspc/data/lsp/templates/ts/query.fn.ts new file mode 100644 index 000000000..e32f2df74 --- /dev/null +++ b/waspc/data/lsp/templates/ts/query.fn.ts @@ -0,0 +1,9 @@ +import { {{upperDeclName}} } from '@wasp/queries/types' + +{{#named?}}export {{/named?}}const {{name}}: {{upperDeclName}} = async (args, context) => { + // Implementation goes here +} + +{{#default?}} +export default {{name}} +{{/default?}} diff --git a/waspc/src/Wasp/Analyzer/Parser/SourceSpan.hs b/waspc/src/Wasp/Analyzer/Parser/SourceSpan.hs index 98b28ecc4..aabba0db1 100644 --- a/waspc/src/Wasp/Analyzer/Parser/SourceSpan.hs +++ b/waspc/src/Wasp/Analyzer/Parser/SourceSpan.hs @@ -2,6 +2,7 @@ module Wasp.Analyzer.Parser.SourceSpan ( SourceSpan (..), + spansOverlap, ) where @@ -18,3 +19,6 @@ data SourceSpan = SourceSpan !SourceOffset !SourceOffset deriving (Eq, Ord, Show, Generic) instance NFData SourceSpan + +spansOverlap :: SourceSpan -> SourceSpan -> Bool +spansOverlap (SourceSpan s0 e0) (SourceSpan s1 e1) = not ((s1 >= e0) || (s0 >= e1)) diff --git a/waspc/src/Wasp/AppSpec/ExtImport.hs b/waspc/src/Wasp/AppSpec/ExtImport.hs index 0f9ec1719..4680d75e3 100644 --- a/waspc/src/Wasp/AppSpec/ExtImport.hs +++ b/waspc/src/Wasp/AppSpec/ExtImport.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Wasp.AppSpec.ExtImport ( ExtImport (..), @@ -7,7 +9,9 @@ module Wasp.AppSpec.ExtImport ) where +import Data.Aeson (FromJSON, ToJSON) import Data.Data (Data) +import GHC.Generics (Generic) import StrongPath (File', Path, Posix, Rel) import Wasp.AppSpec.ExternalCode (SourceExternalCodeDir) @@ -28,7 +32,7 @@ data ExtImportName ExtImportModule Identifier | -- | Represents external imports like @import { Identifier } from "file.js"@ ExtImportField Identifier - deriving (Show, Eq, Data) + deriving (Show, Eq, Data, Generic, FromJSON, ToJSON) importIdentifier :: ExtImport -> Identifier importIdentifier (ExtImport importName _) = case importName of diff --git a/waspc/src/Wasp/Util/HashMap.hs b/waspc/src/Wasp/Util/HashMap.hs new file mode 100644 index 000000000..7ff96ab6c --- /dev/null +++ b/waspc/src/Wasp/Util/HashMap.hs @@ -0,0 +1,22 @@ +module Wasp.Util.HashMap + ( lookupKey, + ) +where + +import Data.Foldable (find) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as M + +-- | Lookup a key, returning the key stored in the map. Useful when the 'Eq' +-- instance on the key type isn't structural equality. +-- +-- === __Example__ +-- >>> {-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- >>> import Data.Hashable (Hashable) +-- >>> newtype ApproxDouble = ApproxDouble Double deriving (Show, Hashable) +-- >>> instance Eq ApproxDouble where +-- >>> ApproxDouble x == ApproxDouble y = abs (x - y) < 0.01 +-- >>> lookupKey (ApproxDouble 0.502) $ M.fromList [(ApproxDouble 0.5, "a"), (ApproxDouble 0.6, "b")] +-- 0.5 +lookupKey :: (Eq k) => k -> HashMap k v -> Maybe k +lookupKey k = find (== k) . M.keys diff --git a/waspc/src/Wasp/Util/StrongPath.hs b/waspc/src/Wasp/Util/StrongPath.hs new file mode 100644 index 000000000..419abb1f3 --- /dev/null +++ b/waspc/src/Wasp/Util/StrongPath.hs @@ -0,0 +1,19 @@ +module Wasp.Util.StrongPath + ( replaceExtension, + stripProperPrefix, + ) +where + +import Control.Monad.Catch (MonadThrow) +import qualified Path as P +import qualified StrongPath as SP +import qualified StrongPath.Path as SP + +stripProperPrefix :: SP.Path' SP.Abs (SP.Dir a) -> SP.Path' SP.Abs (SP.File b) -> Maybe (SP.Path' (SP.Rel a) (SP.File b)) +stripProperPrefix base file = + SP.fromPathRelFile + <$> P.stripProperPrefix (SP.toPathAbsDir base) (SP.toPathAbsFile file) + +replaceExtension :: MonadThrow m => SP.Path' SP.Abs (SP.File a) -> String -> m (SP.Path' SP.Abs (SP.File a)) +replaceExtension path ext = + SP.fromPathAbsFile <$> P.replaceExtension ext (SP.toPathAbsFile path) diff --git a/waspc/test/Analyzer/Parser/SourceSpanTest.hs b/waspc/test/Analyzer/Parser/SourceSpanTest.hs new file mode 100644 index 000000000..b12292cb2 --- /dev/null +++ b/waspc/test/Analyzer/Parser/SourceSpanTest.hs @@ -0,0 +1,27 @@ +module Analyzer.Parser.SourceSpanTest where + +import Test.QuickCheck +import Test.Tasty.Hspec +import Wasp.Analyzer.Parser.SourceSpan (SourceSpan (SourceSpan), spansOverlap) + +spec_SourceSpanTest :: Spec +spec_SourceSpanTest = do + describe "Analyzer.Parser.SourceSpan" $ do + describe "spansOverlap works" $ do + it "when first is before second" $ do + spansOverlap (SourceSpan 0 5) (SourceSpan 10 15) `shouldBe` False + it "when first ends right before second starts" $ do + spansOverlap (SourceSpan 0 5) (SourceSpan 5 10) `shouldBe` False + it "when first overlaps second on its left edge" $ do + spansOverlap (SourceSpan 0 5) (SourceSpan 4 10) `shouldBe` True + it "when first is second" $ do + spansOverlap (SourceSpan 0 5) (SourceSpan 0 5) `shouldBe` True + it "when first overlaps second on its right edge" $ do + spansOverlap (SourceSpan 4 10) (SourceSpan 0 5) `shouldBe` True + it "when second is zero-width" $ do + spansOverlap (SourceSpan 0 5) (SourceSpan 2 2) `shouldBe` True + it "is commutative" $ do + property $ \s0 e0 s1 e1 -> + let first = SourceSpan s0 e0 + second = SourceSpan s1 e1 + in spansOverlap first second == spansOverlap second first diff --git a/waspc/waspc.cabal b/waspc/waspc.cabal index 99730d19a..88fa364e9 100644 --- a/waspc/waspc.cabal +++ b/waspc/waspc.cabal @@ -53,6 +53,9 @@ data-files: Cli/templates/basic/.wasproot Cli/templates/basic/src/.waspignore Cli/templates/basic/main.wasp + lsp/templates/**/*.js + lsp/templates/**/*.ts + lsp/templates/**/*.jsx packages/deploy/dist/**/*.js packages/deploy/package.json packages/deploy/package-lock.json @@ -331,6 +334,8 @@ library Wasp.Util.IO Wasp.Util.Terminal Wasp.Util.FilePath + Wasp.Util.StrongPath + Wasp.Util.HashMap Wasp.WaspignoreFile Wasp.Generator.NpmDependencies Wasp.Generator.NpmInstall @@ -344,6 +349,10 @@ library waspls Control.Monad.Log Control.Monad.Log.Class Wasp.LSP.Analysis + Wasp.LSP.CodeActions + Wasp.LSP.Commands + Wasp.LSP.Commands.Command + Wasp.LSP.Commands.ScaffoldTsSymbol Wasp.LSP.Completion Wasp.LSP.Completions.Common Wasp.LSP.Completions.DictKeyCompletion @@ -383,6 +392,7 @@ library waspls , strong-path , path , async ^>=2.2.4 + , mustache ^>=2.3.2 , unliftio-core , mtl , text @@ -516,6 +526,7 @@ test-suite waspc-test Analyzer.Parser.CST.TraverseTest Analyzer.Parser.ParseErrorTest Analyzer.Parser.SourcePositionTest + Analyzer.Parser.SourceSpanTest Analyzer.ParserTest Analyzer.TestUtil Analyzer.TypeChecker.InternalTest @@ -577,6 +588,7 @@ test-suite waspls-test other-modules: Wasp.LSP.CompletionTest Wasp.LSP.DebouncerTest + Wasp.LSP.SyntaxTest test-suite cli-test import: common-all, common-exe diff --git a/waspc/waspls/src/Wasp/LSP/CodeActions.hs b/waspc/waspls/src/Wasp/LSP/CodeActions.hs new file mode 100644 index 000000000..103f6c879 --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/CodeActions.hs @@ -0,0 +1,153 @@ +module Wasp.LSP.CodeActions + ( getCodeActionsInRange, + ) +where + +import Control.Lens ((^.)) +import Control.Monad (filterM) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Reader.Class (asks) +import Data.Maybe (catMaybes, fromMaybe) +import qualified Data.Text as Text +import qualified Language.LSP.Types as LSP +import qualified StrongPath as SP +import Text.Printf (printf) +import Wasp.Analyzer.Parser.AST (ExtImportName (ExtImportField, ExtImportModule)) +import Wasp.Analyzer.Parser.CST (SyntaxNode) +import qualified Wasp.Analyzer.Parser.CST as S +import Wasp.Analyzer.Parser.CST.Traverse (Traversal) +import qualified Wasp.Analyzer.Parser.CST.Traverse as T +import Wasp.Analyzer.Parser.SourceSpan (SourceSpan, spansOverlap) +import qualified Wasp.LSP.Commands.ScaffoldTsSymbol as ScaffoldTS +import Wasp.LSP.ExtImport.ExportsCache (ExtImportLookupResult (..), lookupExtImport) +import Wasp.LSP.ExtImport.Path (WaspStyleExtFilePath) +import qualified Wasp.LSP.ExtImport.Path as ExtImport +import Wasp.LSP.ExtImport.Syntax (ExtImportNode (einLocation, einName), extImportAtLocation) +import Wasp.LSP.ServerMonads (HandlerM) +import qualified Wasp.LSP.ServerState as State +import Wasp.LSP.Syntax (lspRangeToSpan) +import qualified Wasp.LSP.TypeInference as Inference +import Wasp.LSP.Util (getPathRelativeToProjectDir) +import qualified Wasp.Util.HashMap as M +import Wasp.Util.IO (doesFileExist) +import Wasp.Util.StrongPath (replaceExtension) + +-- | Runs all 'codeActionProviders' and concatenates their results. +getCodeActionsInRange :: LSP.Range -> HandlerM [LSP.CodeAction] +getCodeActionsInRange range = do + src <- asks (^. State.currentWaspSource) + maybeCst <- asks (^. State.cst) + let sourceSpan = lspRangeToSpan src range + case maybeCst of + Nothing -> pure [] + Just syntax -> do + concat <$> mapM (\provider -> provider src syntax sourceSpan) codeActionProviders + +codeActionProviders :: [String -> [SyntaxNode] -> SourceSpan -> HandlerM [LSP.CodeAction]] +codeActionProviders = + [ extImportScaffoldActionProvider + ] + +-- | Provide 'LSP.CodeAction's that define missing JS/TS functions that do not +-- already exist but are needed by external imports that are found within the +-- given 'SourceSpan'. +extImportScaffoldActionProvider :: String -> [SyntaxNode] -> SourceSpan -> HandlerM [LSP.CodeAction] +extImportScaffoldActionProvider src syntax sourceSpan = do + let extImports = map (extImportAtLocation src) $ collectExtImportNodesInSpan (T.fromSyntaxForest syntax) + concat <$> mapM (getScaffoldActionsForExtImport src) extImports + where + -- Post-condition: all 'Traversal's returned have @kindAt t == ExtImport@. + collectExtImportNodesInSpan :: Traversal -> [Traversal] + collectExtImportNodesInSpan t = + -- Only consider the given traversal if it is within the span. + if spansOverlap (T.spanAt t) sourceSpan + then case T.kindAt t of + S.ExtImport -> [t] + _ -> concatMap collectExtImportNodesInSpan $ T.children t + else [] + +-- | Finds code actions to create a JS/TS function for an external import. Returns +-- one code action for each JS/TS/JSX/TSX file a function can be created in. +-- +-- This function also checks to make sure each code action, which runs the +-- @wasp.scaffold.ts-symbol@ command, has a scaffolding template that can be +-- used. +getScaffoldActionsForExtImport :: String -> ExtImportNode -> HandlerM [LSP.CodeAction] +getScaffoldActionsForExtImport src extImport = do + lookupExtImport extImport >>= \case + ImportSyntaxError -> return [] + ImportCacheMiss -> return [] -- Not in cache, so we assume it's valid. + ImportsSymbol _ _ -> return [] -- Valid import, no code action needed. + ImportedFileDoesNotExist waspStylePath -> case einName extImport of + Nothing -> return [] -- Syntax error in import, can't know if it's valid. + Just symbolName -> makeCodeActions True symbolName waspStylePath + ImportedSymbolDoesNotExist symbolName waspStylePath -> makeCodeActions False symbolName waspStylePath + where + makeCodeActions :: Bool -> ExtImportName -> WaspStyleExtFilePath -> HandlerM [LSP.CodeAction] + makeCodeActions createNewFile symbolName waspStylePath = do + let pathToExtImport = fromMaybe [] $ Inference.findExprPathToLocation src $ einLocation extImport + referencedPaths <- getPathsReferencedByExtImport createNewFile waspStylePath + catMaybes <$> mapM (makeCodeAction symbolName pathToExtImport) referencedPaths + + -- Get the list of paths the client might want to define the function in. If + -- a file with the right name already exists, it returns that one. + -- + -- If no file exists, returns a list of files with each allowed extension, + -- based on JS module resolution. For example, @import x from "@server/y.js"@ + -- results in both @y.ts@ and @y.js@. + -- + -- See "Wasp.LSP.ExtImport.Path" for how allowed extensions are decided based + -- on the path written in the Wasp source code. + getPathsReferencedByExtImport :: Bool -> WaspStyleExtFilePath -> HandlerM [SP.Path' SP.Abs SP.File'] + getPathsReferencedByExtImport createNewFile waspStylePath = do + let cachePathFromSrc = + fromMaybe (error "[createCodeActions] unreachable: invalid wasp style path") $ + ExtImport.waspStylePathToCachePath waspStylePath + -- The allowed extensions stored in the cache are based on what files exist + -- on disk. Usually, paths in the cache will allow only one extension, which + -- will be exactly the extension that is used on the file system. + allowedExts <- + ExtImport.allowedExts . ExtImport.cachePathExtType . fromMaybe cachePathFromSrc + <$> asks (M.lookupKey cachePathFromSrc . (^. State.tsExports)) + absPath <- + fromMaybe (error "[createCodeActions] unreachable: can't get abs path") + <$> ExtImport.cachePathToAbsPathWithoutExt cachePathFromSrc + let possiblePaths = + map (SP.castFile . fromMaybe (error "unreachable") . replaceExtension absPath) allowedExts + + -- If not creating a new file, the external import could only be referencing an + -- existing file, so nonexistant files are filtered. + if createNewFile + then return possiblePaths + else filterM (liftIO . doesFileExist) possiblePaths + + -- Checks if the "ScaffoldTS" command has a template for this request; if it + -- does not, returns 'Nothing'. + makeCodeAction :: ExtImportName -> Inference.ExprPath -> SP.Path' SP.Abs (SP.File a) -> HandlerM (Maybe LSP.CodeAction) + makeCodeAction symbolName pathToExtImport targetFile = do + -- The code action is nicer to use when we display just the relative path to the file. + targetFileForDisplay <- maybe (SP.fromAbsFile targetFile) SP.fromRelFile <$> getPathRelativeToProjectDir targetFile + let args = + ScaffoldTS.Args + { ScaffoldTS.symbolName = symbolName, + ScaffoldTS.pathToExtImport = pathToExtImport, + ScaffoldTS.filepath = SP.castFile targetFile + } + command = ScaffoldTS.makeLspCommand args + let title = case symbolName of + ExtImportModule _ -> printf "Add default export to %s" targetFileForDisplay + ExtImportField name -> printf "Create function `%s` in %s" name targetFileForDisplay + if ScaffoldTS.hasTemplateForArgs args + then + return . Just $ + LSP.CodeAction + { _title = Text.pack title, + _kind = Just LSP.CodeActionQuickFix, + _diagnostics = Nothing, + _isPreferred = Nothing, + _disabled = Nothing, + _edit = Nothing, + _command = Just command, + _xdata = Nothing + } + else return Nothing diff --git a/waspc/waspls/src/Wasp/LSP/Commands.hs b/waspc/waspls/src/Wasp/LSP/Commands.hs new file mode 100644 index 000000000..aef15426e --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/Commands.hs @@ -0,0 +1,58 @@ +module Wasp.LSP.Commands + ( -- * waspls Commands + + -- Defines 'handleExecuteCommand', which dispatches a LSP workspace/executeCommand + -- request to the appropriate 'Command'. + -- + -- To define a new command, create a "Wasp.LSP.Commands.Command" for + -- it and add it to 'commands' list in this module. + -- + -- When defining a new command, it is recommended to, in addition to the + -- 'Command', define an @Args@ type that the command expects to be + -- passed to it and a @makeLspCommand@ function that takes an @Args@ value and + -- returns an 'LSP.Command'. Following this pattern will ensure a simple + -- and consistent interface to interacting with each command. + availableCommands, + handleExecuteCommand, + ) +where + +import Control.Lens ((^.)) +import qualified Data.HashMap.Strict as M +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Lens as LSP +import Text.Printf (printf) +import Wasp.LSP.Commands.Command (Command (commandHandler, commandName)) +import qualified Wasp.LSP.Commands.ScaffoldTsSymbol as ScaffoldTsSymbol +import Wasp.LSP.ServerMonads (ServerM) + +commands :: M.HashMap Text Command +commands = + M.fromList $ + map + (\command -> (commandName command, command)) + [ ScaffoldTsSymbol.command + ] + +-- | List of the names of commands that 'handler' can execute. +availableCommands :: [Text] +availableCommands = M.keys commands + +-- | Find the relevant 'Command' in 'commands' for the request, or respond +-- with an error if there is no handler listed for it. +handleExecuteCommand :: LSP.Handlers ServerM +handleExecuteCommand = LSP.requestHandler LSP.SWorkspaceExecuteCommand $ \request respond -> + let requestedCommand = request ^. LSP.params . LSP.command + in case commands M.!? requestedCommand of + Nothing -> do + respond $ + Left $ + LSP.ResponseError + { _code = LSP.MethodNotFound, + _message = Text.pack $ printf "No handler for command '%s'" requestedCommand, + _xdata = Nothing + } + Just command -> commandHandler command request respond diff --git a/waspc/waspls/src/Wasp/LSP/Commands/Command.hs b/waspc/waspls/src/Wasp/LSP/Commands/Command.hs new file mode 100644 index 000000000..9c7dbe176 --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/Commands/Command.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE DataKinds #-} + +module Wasp.LSP.Commands.Command + ( Command (Command, commandName, commandHandler), + withParsedArgs, + makeInvalidParamsError, + ) +where + +import Control.Lens ((^.)) +import Data.Aeson (FromJSON, Result (Error, Success), Value, fromJSON) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Lens as LSP +import Wasp.LSP.ServerMonads (ServerM) + +-- | Command name and handler. When a 'LSP.WorkspaceExecuteCommand' request is +-- received with the command name matching the one listed in a 'Command', the +-- corresponding handler is executed. +data Command = Command + { commandName :: Text, + commandHandler :: LSP.Handler ServerM 'LSP.WorkspaceExecuteCommand + } + +-- | @withParsedArgs request respond handleUsingArgs@ parses the arguments list +-- of a 'LSP.WorkspaceExecuteCommand' request according to the following rules +-- and passes the parsed arguments to @handleUsingArgs@. +-- +-- Parsing rules: +-- - The request contains exactly one JSON argument value. +-- - The single JSON argument can be parsed into the type that @handleUsingArgs@ +-- expects to be passed. +-- +-- When a request does not meet these requirements, a 'LSP.ResponseError' is +-- sent to the client and @handleUsingArgs@ is not run. +-- +-- == Usage +-- This function is inteneded to be wrapped around the top-level of a command +-- handler: +-- +-- @ +-- data Args = Args { message :: String } deriving (Generic, FromJSON) +-- +-- handle request response = withParsedArgs request response $ \args -> do +-- logM $ "received message " <> message args +-- -- ... +-- @ +withParsedArgs :: + (FromJSON args, LSP.MonadLsp c m) => + -- | LSP 'request'. + LSP.RequestMessage 'LSP.WorkspaceExecuteCommand -> + -- | LSP 'respond'. + (Either LSP.ResponseError Value -> m ()) -> + -- | Handler that need arguments. + (args -> m ()) -> + m () +withParsedArgs request respond handleCmdUsingArgs = case request ^. LSP.params . LSP.arguments of + Just (LSP.List [jsonArgument]) -> case fromJSON jsonArgument of + Error err -> respond $ Left $ makeInvalidParamsError $ Text.pack err + Success parsedArgs -> handleCmdUsingArgs parsedArgs + _ -> respond $ Left $ makeInvalidParamsError "Expected exactly one argument" + +makeInvalidParamsError :: Text -> LSP.ResponseError +makeInvalidParamsError msg = + LSP.ResponseError + { _code = LSP.InvalidParams, + _message = msg, + _xdata = Nothing + } diff --git a/waspc/waspls/src/Wasp/LSP/Commands/ScaffoldTsSymbol.hs b/waspc/waspls/src/Wasp/LSP/Commands/ScaffoldTsSymbol.hs new file mode 100644 index 000000000..d6192004d --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/Commands/ScaffoldTsSymbol.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} + +module Wasp.LSP.Commands.ScaffoldTsSymbol + ( -- * Scaffold TS Symbol Command + + -- Command @wasp.scaffold.ts-symbol@ appends a new function with the given + -- name to end of a particular file. + -- + -- Mustache templates are used to write the code for the new function. + -- @templateForRequest@ chooses a template in @data/lsp/template/ts@ based + -- on the location of the external import and the extension of the file that + -- the function will be appended to. + -- + -- To add a new template, add the template to the template directory. Then, + -- add a new equation to @templateForRequest@ that matches when you want the + -- template to be used. + -- + -- The templates have several variables available to them: + -- + -- [@name@]: String, the name imported by a the external import. For example, + -- @getAll@ in @import { getAll } from "@server/queries.js"@. + -- + -- [@default?@]: Boolean, true if the external import is importing the default + -- export. + -- + -- [@named?@]: Boolean, true if the external import is importing a named export. + -- + -- [@upperDeclName@]: String, the name of the declaration the external import + -- is within, with the first letter capitalized. + + -- ** Current Limitations + + -- Due to the current way waspls works, we are not able to send a + -- 'LSP.WorkspaceApplyEdit' request to add the scaffolded code. Instead, we + -- modify the file on disk. This isn't the exact proper way to modify the + -- code, but it works. + -- + -- The reason is that waspls only receives document synchronization events + -- for @.wasp@ files (didChange, didOpen, didClose, etc.), so we only know + -- the versioned URI for the @.wasp@ file, not the TS files. But we need the + -- versioned URI for sending edits. The LSP spec is not clear on what files + -- get the sync events, but in VSCode's case it is determined by the client + -- (the VSCode Wasp extension). + -- + -- The extension can easily be configured to send sync events for JS/TS + -- files, but waspls makes a lot of assumptions about what files it receives + -- events for and would require a lot of refactoring to work properly. It + -- would be best to handle this at the same time as we add support for multiple + -- wasp files to the language and to waspls. + Args (Args, symbolName, pathToExtImport, filepath), + hasTemplateForArgs, + command, + makeLspCommand, + ) +where + +import Control.Monad (void) +import Control.Monad.Except (MonadError (throwError), runExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Log.Class (logM) +import Data.Aeson (FromJSON, ToJSON (toJSON), object, parseJSON, withObject, (.:), (.=)) +import qualified Data.Aeson as Aeson +import Data.Either (isRight) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP +import qualified Path as P +import qualified StrongPath as SP +import qualified StrongPath.Path as SP +import qualified Text.Mustache as Mustache +import Text.Printf (printf) +import Wasp.Analyzer.Parser.AST (ExtImportName (ExtImportField, ExtImportModule)) +import qualified Wasp.Data +import Wasp.LSP.Commands.Command (Command (Command, commandHandler, commandName), makeInvalidParamsError, withParsedArgs) +import Wasp.LSP.ServerMonads (ServerM) +import Wasp.LSP.TypeInference (ExprPath, ExprPathStep (Decl, DictKey)) +import qualified Wasp.LSP.TypeInference as Inference +import Wasp.Util (toUpperFirst) +import Wasp.Util.IO (doesFileExist) + +command :: Command +command = + Command + { commandName = "wasp.scaffold.ts-symbol", + commandHandler = handler + } + +makeLspCommand :: Args -> LSP.Command +makeLspCommand args = + LSP.Command + { _title = "Scaffold TS Code", + _command = commandName command, + _arguments = Just $ LSP.List [toJSON args] + } + +data Args = Args + { -- | Name of the symbol to define. If this is 'ExtImportModule', it will + -- create a function with the specified name and export it as default. + symbolName :: ExtImportName, + -- | Description of where the external import occurs in the wasp source code, + -- used, along with the extension of 'filepath', to determine what template + -- to use. + pathToExtImport :: ExprPath, + -- | Path to the file to add the scaffolded code to the end of. + filepath :: SP.Path' SP.Abs SP.File' + } + deriving (Show, Eq) + +instance ToJSON Args where + toJSON args = + object + [ "symbolName" .= symbolName args, + "pathToExtImport" .= pathToExtImport args, + "filepath" .= SP.toFilePath (filepath args) + ] + +instance FromJSON Args where + parseJSON = withObject "Args" $ \v -> + Args + <$> v .: "symbolName" + <*> v .: "pathToExtImport" + <*> ((maybe (fail "Could not parse filepath") pure . SP.parseAbsFile) =<< v .: "filepath") + +handler :: LSP.Handler ServerM 'LSP.WorkspaceExecuteCommand +handler request respond = withParsedArgs request respond scaffold + where + scaffold :: Args -> ServerM () + scaffold args@Args {..} = case P.fileExtension $ SP.toPathAbsFile filepath of + Nothing -> respond $ Left $ makeInvalidParamsError "Invalid filepath: no extension" + Just ext -> + getTemplateFor pathToExtImport ext >>= \case + Left err -> + respond $ Left $ makeInvalidParamsError $ Text.pack err + Right template -> renderAndWriteScaffoldTemplate args template + + renderAndWriteScaffoldTemplate :: Args -> Mustache.Template -> ServerM () + renderAndWriteScaffoldTemplate args@Args {..} template = case pathToExtImport of + Inference.Decl _ declName : _ -> do + let symbolData = case symbolName of + ExtImportModule name -> ["default?" .= True, "named?" .= False, "name" .= name] + ExtImportField name -> ["default?" .= False, "named?" .= True, "name" .= name] + let templateData = object $ symbolData ++ ["upperDeclName" .= toUpperFirst declName] + + let rendered = renderTemplate template templateData + logM $ printf "[wasp.scaffold.ts-symbol]: rendered=%s" (show rendered) + + -- NOTE: we modify the file on disk instead of applying an edit through + -- the LSP client. See "Current Limitations" above. + liftIO $ Text.appendFile (SP.fromAbsFile filepath) rendered + + notifyClientOfFileChanges args + respond $ Right Aeson.Null + _ -> respond $ Left $ makeInvalidParamsError $ Text.pack $ "Top-level step in path to ext import is not a decl: " ++ show pathToExtImport + + -- Displays a message to the client that a file changed, with a button to + -- open the changed file. + notifyClientOfFileChanges :: Args -> ServerM () + notifyClientOfFileChanges Args {..} = do + let symbol = case symbolName of + ExtImportModule _ -> "default export" + ExtImportField name -> "export " <> name + let message = + LSP.ShowMessageRequestParams + { _xtype = LSP.MtInfo, + _message = Text.pack $ printf "Created %s in %s." symbol (SP.fromAbsFile filepath), + _actions = Just [LSP.MessageActionItem "Open"] + } + void $ + LSP.sendRequest LSP.SWindowShowMessageRequest message $ \case + Left err -> logM $ "Error showing message for file created: " <> show err + Right (Just (LSP.MessageActionItem "Open")) -> do + -- Client selected the "Open" button, ask it to display the file. + let showDocument = + LSP.ShowDocumentParams + { _uri = LSP.filePathToUri $ SP.fromAbsFile filepath, + _external = Nothing, + _takeFocus = Just True, + _selection = Nothing + } + void $ LSP.sendRequest LSP.SWindowShowDocument showDocument (const (pure ())) + Right _ -> return () + +-- | Check if the scaffold command has a template available for the given args. +-- If this is false, running the command with these args will __definitely__ +-- fail. +hasTemplateForArgs :: Args -> Bool +hasTemplateForArgs Args {..} = case P.fileExtension $ SP.toPathAbsFile filepath of + Nothing -> False + Just ext -> isRight $ templateFileFor pathToExtImport ext + +-- | @getTemplateFor pathToExtImport extension@ finds the mustache template in +-- @data/lsp/templates/ts@ and compiles it. +getTemplateFor :: MonadIO m => ExprPath -> String -> m (Either String Mustache.Template) +getTemplateFor exprPath ext = runExceptT $ do + templatesDir <- liftIO getTemplatesDir + templateFile <- (templatesDir SP.) <$> templateFileFor exprPath ext + templateExists <- liftIO $ doesFileExist templateFile + if templateExists + then do + compileResult <- liftIO $ Mustache.automaticCompile [SP.fromAbsDir templatesDir] (SP.fromAbsFile templateFile) + case compileResult of + -- Note: 'error' is used here because all templates should compile succesfully. + Left err -> error $ printf "Compilation of template %s failed: %s" (SP.fromAbsFile templateFile) (show err) + Right template -> return template + else throwError $ printf "No scaffolding template for request: %s does not exist" (SP.fromAbsFile templateFile) + +-- | Renders a mustache template to text. +-- +-- This function is partial: if errors are encountered rendering the template, +-- @error@ is returned. +renderTemplate :: Mustache.Template -> Aeson.Value -> Text +renderTemplate template templateData = + let (errs, text) = Mustache.checkedSubstituteValue template $ Mustache.toMustache templateData + in if null errs + then text + else error $ printf "Unexpected errors rendering template: " ++ show errs + +data TemplatesDir + +data Template + +type TemplateFile = SP.Path' (SP.Rel TemplatesDir) (SP.File Template) + +templatesDirInDataDir :: SP.Path' (SP.Rel Wasp.Data.DataDir) (SP.Dir TemplatesDir) +templatesDirInDataDir = [SP.reldir|lsp/templates/ts|] + +getTemplatesDir :: IO (SP.Path' SP.Abs (SP.Dir TemplatesDir)) +getTemplatesDir = (SP. templatesDirInDataDir) <$> Wasp.Data.getAbsDataDirPath + +templateFileFor :: + MonadError String m => + -- | Path to the external import that the scaffold request came from. + ExprPath -> + -- | Extension of the file that the request is scaffolding code in. + String -> + m TemplateFile +templateFileFor [Decl "query" _, DictKey "fn"] ".ts" = pure [SP.relfile|query.fn.ts|] +templateFileFor [Decl "action" _, DictKey "fn"] ".ts" = pure [SP.relfile|action.fn.ts|] +templateFileFor [Decl declType _, DictKey "fn"] ".js" + | declType `elem` ["query", "action"] = pure [SP.relfile|operation.fn.js|] +templateFileFor [Decl "page" _, DictKey "component"] ext + | ext `elem` [".jsx", ".tsx"] = pure [SP.relfile|page.component.jsx|] +templateFileFor exprPath ext = throwError $ printf "No template defined for %s with extension %s" (show exprPath) ext diff --git a/waspc/waspls/src/Wasp/LSP/ExtImport/Path.hs b/waspc/waspls/src/Wasp/LSP/ExtImport/Path.hs index 8cc6bd21b..7b400b966 100644 --- a/waspc/waspls/src/Wasp/LSP/ExtImport/Path.hs +++ b/waspc/waspls/src/Wasp/LSP/ExtImport/Path.hs @@ -3,11 +3,16 @@ module Wasp.LSP.ExtImport.Path ( ExtFileCachePath, + cachePathFile, + cachePathExtType, WaspStyleExtFilePath (WaspStyleExtFilePath), waspStylePathToCachePath, absPathToCachePath, + cachePathToAbsPathWithoutExt, cachePathToAbsPath, tryGetTsconfigForAbsPath, + ExtensionType, + allowedExts, ) where @@ -23,6 +28,7 @@ import qualified StrongPath.Path as SP import Wasp.AppSpec.ExternalCode (SourceExternalCodeDir) import Wasp.Project.Common (WaspProjectDir) import Wasp.Util.IO (doesFileExist) +import Wasp.Util.StrongPath (stripProperPrefix) data ExtensionlessExtFile @@ -30,8 +36,10 @@ data ExtensionlessExtFile -- -- It is stored relative to @src/@ and without an extension so that cache lookups -- (starting with a 'WaspStyleExtFilePath') are more efficient. -data ExtFileCachePath - = ExtFileCachePath !(SP.Path' (SP.Rel SourceExternalCodeDir) (SP.File ExtensionlessExtFile)) !ExtensionType +data ExtFileCachePath = ExtFileCachePath + { cachePathFile :: !(SP.Path' (SP.Rel SourceExternalCodeDir) (SP.File ExtensionlessExtFile)), + cachePathExtType :: !ExtensionType + } deriving (Show, Eq, Generic) -- | Hashes only the path portion (ignoring the extension type). This is so that @@ -54,7 +62,7 @@ waspStylePathToCachePath (WaspStyleExtFilePath waspStylePath) = do let (extensionLessFile, extType) = splitExtensionType relFile return $ ExtFileCachePath (SP.fromPathRelFile extensionLessFile) extType -absPathToCachePath :: LSP.MonadLsp c m => SP.Path' SP.Abs SP.File' -> m (Maybe ExtFileCachePath) +absPathToCachePath :: LSP.MonadLsp c m => SP.Path' SP.Abs (SP.File a) -> m (Maybe ExtFileCachePath) absPathToCachePath absFile = do -- Makes the path relative to src/ and deletes the extension. maybeProjectDir <- (>>= SP.parseAbsDir) <$> LSP.getRootPath @@ -62,23 +70,28 @@ absPathToCachePath absFile = do Nothing -> pure Nothing Just (projectRootDir :: SP.Path' SP.Abs (SP.Dir WaspProjectDir)) -> let srcDir = projectRootDir SP. srcDirInProjectRootDir - in case P.stripProperPrefix (SP.toPathAbsDir srcDir) (SP.toPathAbsFile absFile) of + in case stripProperPrefix srcDir absFile of Nothing -> pure Nothing Just relFile -> do - let (extensionLessFile, extType) = splitExtensionType relFile + let (extensionLessFile, extType) = splitExtensionType $ SP.toPathRelFile relFile pure $ Just $ ExtFileCachePath (SP.fromPathRelFile extensionLessFile) extType -cachePathToAbsPath :: forall m c. LSP.MonadLsp c m => ExtFileCachePath -> m (Maybe (SP.Path' SP.Abs SP.File')) -cachePathToAbsPath (ExtFileCachePath cachePath extType) = do - -- Converts to an absolute path and finds the appropriate extension. +cachePathToAbsPathWithoutExt :: LSP.MonadLsp c m => ExtFileCachePath -> m (Maybe (SP.Path' SP.Abs (SP.File ExtensionlessExtFile))) +cachePathToAbsPathWithoutExt (ExtFileCachePath cachePath _) = do + -- Converts to an absolute path, but does not add any extension. maybeProjectDir <- (>>= SP.parseAbsDir) <$> LSP.getRootPath case maybeProjectDir of - Nothing -> pure Nothing + Nothing -> return Nothing Just (projectRootDir :: SP.Path' SP.Abs (SP.Dir WaspProjectDir)) -> do - let fileWithNoExtension = projectRootDir SP. srcDirInProjectRootDir SP. cachePath - useFirstExtensionThatExists fileWithNoExtension $ allowedExts extType + return $ Just $ projectRootDir SP. srcDirInProjectRootDir SP. cachePath + +cachePathToAbsPath :: forall m c a. LSP.MonadLsp c m => ExtFileCachePath -> m (Maybe (SP.Path' SP.Abs (SP.File a))) +cachePathToAbsPath cp@(ExtFileCachePath _ extType) = + cachePathToAbsPathWithoutExt cp >>= \case + Nothing -> return Nothing + Just absPathWithoutExt -> useFirstExtensionThatExists absPathWithoutExt $ allowedExts extType where - useFirstExtensionThatExists :: SP.Path' SP.Abs (SP.File ExtensionlessExtFile) -> [String] -> m (Maybe (SP.Path' SP.Abs SP.File')) + useFirstExtensionThatExists :: SP.Path' SP.Abs (SP.File ExtensionlessExtFile) -> [String] -> m (Maybe (SP.Path' SP.Abs (SP.File a))) useFirstExtensionThatExists _ [] = pure Nothing useFirstExtensionThatExists file (ext : exts) = case P.addExtension ext (SP.toPathAbsFile file) of @@ -97,10 +110,10 @@ cachePathToAbsPath (ExtFileCachePath cachePath extType) = do -- config files exist. -- -- IF the given path is not in either @src/@ subdirectory, returns nothing. -tryGetTsconfigForAbsPath :: SP.Path' SP.Abs (SP.Dir WaspProjectDir) -> SP.Path' SP.Abs SP.File' -> Maybe (SP.Path' SP.Abs SP.File') +tryGetTsconfigForAbsPath :: SP.Path' SP.Abs (SP.Dir WaspProjectDir) -> SP.Path' SP.Abs (SP.File a) -> Maybe (SP.Path' SP.Abs (SP.File a)) tryGetTsconfigForAbsPath projectRootDir file = tsconfigPath [SP.reldir|src/client|] <|> tsconfigPath [SP.reldir|src/server|] where - tsconfigPath :: SP.Path' (SP.Rel WaspProjectDir) SP.Dir' -> Maybe (SP.Path' SP.Abs SP.File') + tsconfigPath :: SP.Path' (SP.Rel WaspProjectDir) SP.Dir' -> Maybe (SP.Path' SP.Abs (SP.File a)) tsconfigPath folder = let absFolder = projectRootDir SP. folder in if SP.toPathAbsDir absFolder `P.isProperPrefixOf` SP.toPathAbsFile file diff --git a/waspc/waspls/src/Wasp/LSP/ExtImport/Syntax.hs b/waspc/waspls/src/Wasp/LSP/ExtImport/Syntax.hs index 4f7d791f3..0ffaaeee8 100644 --- a/waspc/waspls/src/Wasp/LSP/ExtImport/Syntax.hs +++ b/waspc/waspls/src/Wasp/LSP/ExtImport/Syntax.hs @@ -1,5 +1,6 @@ module Wasp.LSP.ExtImport.Syntax ( ExtImportNode (..), + extImportAtLocation, findExtImportAroundLocation, getAllExtImports, ) diff --git a/waspc/waspls/src/Wasp/LSP/Handlers.hs b/waspc/waspls/src/Wasp/LSP/Handlers.hs index 96c369a61..588c11637 100644 --- a/waspc/waspls/src/Wasp/LSP/Handlers.hs +++ b/waspc/waspls/src/Wasp/LSP/Handlers.hs @@ -6,9 +6,11 @@ module Wasp.LSP.Handlers didOpenHandler, didChangeHandler, didSaveHandler, + executeCommandHandler, completionHandler, signatureHelpHandler, gotoDefinitionHandler, + codeActionHandler, ) where @@ -20,6 +22,8 @@ import qualified Language.LSP.Server as LSP import qualified Language.LSP.Types as LSP import qualified Language.LSP.Types.Lens as LSP import Wasp.LSP.Analysis (diagnoseWaspFile) +import Wasp.LSP.CodeActions (getCodeActionsInRange) +import qualified Wasp.LSP.Commands as Commands import Wasp.LSP.Completion (getCompletionsAtPosition) import Wasp.LSP.DynamicHandlers (registerDynamicCapabilities) import Wasp.LSP.GotoDefinition (gotoDefinitionOfSymbolAtPosition) @@ -69,6 +73,9 @@ didSaveHandler :: Handlers ServerM didSaveHandler = LSP.notificationHandler LSP.STextDocumentDidSave $ diagnoseWaspFile . extractUri +executeCommandHandler :: Handlers ServerM +executeCommandHandler = Commands.handleExecuteCommand + completionHandler :: Handlers ServerM completionHandler = LSP.requestHandler LSP.STextDocumentCompletion $ \request respond -> do @@ -90,6 +97,13 @@ signatureHelpHandler = signatureHelp <- handler $ getSignatureHelpAtPosition position respond $ Right signatureHelp +codeActionHandler :: Handlers ServerM +codeActionHandler = + LSP.requestHandler LSP.STextDocumentCodeAction $ \request respond -> do + let range = request ^. LSP.params . LSP.range + codeActions <- handler $ getCodeActionsInRange range + respond $ Right $ LSP.List $ map LSP.InR codeActions + -- | 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/waspc/waspls/src/Wasp/LSP/Server.hs b/waspc/waspls/src/Wasp/LSP/Server.hs index ff8eb970c..2f4465d93 100644 --- a/waspc/waspls/src/Wasp/LSP/Server.hs +++ b/waspc/waspls/src/Wasp/LSP/Server.hs @@ -19,6 +19,7 @@ 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 qualified Wasp.LSP.Commands as Commands import Wasp.LSP.Debouncer (newDebouncerIO) import Wasp.LSP.Handlers import Wasp.LSP.Reactor (startReactorThread) @@ -38,9 +39,11 @@ lspServerHandlers stopReactor = didOpenHandler, didSaveHandler, didChangeHandler, + executeCommandHandler, completionHandler, signatureHelpHandler, - gotoDefinitionHandler + gotoDefinitionHandler, + codeActionHandler ] serve :: Maybe FilePath -> IO () @@ -76,8 +79,7 @@ serve maybeLogFile = do where runHandler :: ServerM a -> IO a runHandler handler = - LSP.runLspT env $ do - runRLspM stateTVar handler + LSP.runLspT env $ runRLspM stateTVar handler exitCode <- LSP.runServer @@ -128,7 +130,8 @@ lspServerOptions = { LSP.textDocumentSync = Just syncOptions, LSP.completionTriggerCharacters = Just [':', ' '], LSP.signatureHelpTriggerCharacters = signatureHelpTriggerCharacters, - LSP.signatureHelpRetriggerCharacters = signatureHelpRetriggerCharacters + LSP.signatureHelpRetriggerCharacters = signatureHelpRetriggerCharacters, + LSP.executeCommandCommands = Just Commands.availableCommands } -- | Options to tell the client how to update the server about the state of text diff --git a/waspc/waspls/src/Wasp/LSP/Syntax.hs b/waspc/waspls/src/Wasp/LSP/Syntax.hs index 38e4e9134..dc4835aee 100644 --- a/waspc/waspls/src/Wasp/LSP/Syntax.hs +++ b/waspc/waspls/src/Wasp/LSP/Syntax.hs @@ -3,12 +3,14 @@ module Wasp.LSP.Syntax -- | Module with utilities for working with/looking for patterns in CSTs lspPositionToOffset, + lspRangeToSpan, locationAtOffset, parentIs, hasLeft, isAtExprPlace, lexemeAt, findChild, + findAncestor, -- | Printing showNeighborhood, ) @@ -18,16 +20,30 @@ import Data.List (find, intercalate) import qualified Language.LSP.Types as J import qualified Wasp.Analyzer.Parser.CST as S import Wasp.Analyzer.Parser.CST.Traverse +import Wasp.Analyzer.Parser.SourceSpan (SourceSpan (SourceSpan)) import Wasp.LSP.Util (allP, anyP) --- | @lspPositionToOffset srcString position@ returns 0-based offset from the --- start of @srcString@ to the specified line and column. +-- | @lspPositionToOffset srcString position@ converts @position@ into a 0-based +-- offset from the start of @srcString@. +-- +-- @position@ is a line/column offset into @srcString@. lspPositionToOffset :: String -> J.Position -> Int lspPositionToOffset srcString (J.Position l c) = let linesBefore = take (fromIntegral l) (lines srcString) in -- We add 1 to the length of each line to make sure to count the newline sum (map ((+ 1) . length) linesBefore) + fromIntegral c +-- | @lspRangeToSpan srcString range@ converts the @range@ into a 'SourceSpan'. +-- +-- The start and end positions in @range@ are line/column offsets into @srcString@, +-- and the returned 'SourceSpan' contains a start and end 0-based offset from the +-- start of @srcString@. +lspRangeToSpan :: String -> J.Range -> SourceSpan +lspRangeToSpan srcString (J.Range start end) = + let startOffset = lspPositionToOffset srcString start + endOffset = lspPositionToOffset srcString end + in SourceSpan startOffset endOffset + -- | Move to the node containing the offset. -- -- If the offset falls on the border between two nodes, it tries to first choose @@ -96,6 +112,12 @@ showNeighborhood t = findChild :: S.SyntaxKind -> Traversal -> Maybe Traversal findChild skind t = find ((== skind) . kindAt) $ children t +findAncestor :: S.SyntaxKind -> Traversal -> Maybe Traversal +findAncestor skind t = + if kindAt t == skind + then Just t + else findAncestor skind =<< up t + -- | @lexeme src traversal@ lexemeAt :: String -> Traversal -> String lexemeAt src t = take (widthAt t) $ drop (offsetAt t) src diff --git a/waspc/waspls/src/Wasp/LSP/TypeInference.hs b/waspc/waspls/src/Wasp/LSP/TypeInference.hs index ad5ec5f25..0c41856aa 100644 --- a/waspc/waspls/src/Wasp/LSP/TypeInference.hs +++ b/waspc/waspls/src/Wasp/LSP/TypeInference.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + module Wasp.LSP.TypeInference ( -- * Inferred types for CST locations inferTypeAtLocation, @@ -11,8 +13,11 @@ module Wasp.LSP.TypeInference where import Control.Monad (guard) +import Data.Aeson (ToJSON) +import Data.Aeson.Types (FromJSON) import Data.Foldable (find) import qualified Data.HashMap.Strict as M +import GHC.Generics (Generic) import qualified Wasp.Analyzer.Parser.CST as S import Wasp.Analyzer.Parser.CST.Traverse (Traversal) import qualified Wasp.Analyzer.Parser.CST.Traverse as T @@ -39,19 +44,23 @@ inferTypeAtLocation src location = findExprPathToLocation src location >>= findT -- } -- @ -- --- The path to the cursor would be @[Decl "app", DictKey "auth", DictKey "usernameAndPassword"]@. +-- The path to the cursor would be @[Decl "app" "todoApp", DictKey "auth", DictKey "usernameAndPassword"]@. type ExprPath = [ExprPathStep] data ExprPathStep - = -- | @Decl declType@. Enter a declaration of type @declType@. - Decl !String + = -- | @Decl declType declName@. Enter a declaration of type @declType@ named @declName@. + Decl !String !String | -- | @DictKey key@. Enter a dictionary *and* its key @key@. DictKey !String | -- | Enter a value inside a list. List | -- | @Tuple idx@. Enter the @idx@-th value inside of a tuple. Tuple !Int - deriving (Eq, Show) + deriving (Eq, Show, Generic) + +instance ToJSON ExprPathStep + +instance FromJSON ExprPathStep -- | This function only depends on the syntax to the left of the location, and -- tries to be as lenient as possible in finding paths. @@ -68,8 +77,10 @@ findExprPathToLocation src location = reverse <$> go location S.Decl -> do typLoc <- find ((== S.DeclType) . T.kindAt) $ T.leftSiblings t let typ = lexemeAt src typLoc + nameLoc <- find ((== S.DeclName) . T.kindAt) $ T.leftSiblings t + let name = lexemeAt src nameLoc -- Stop recursion after finding a Decl - return [Decl typ] + return [Decl typ name] S.DictEntry -> case find ((== S.DictKey) . T.kindAt) $ T.leftSiblings t of Just keyLoc -> do -- There is a key to the left, so @t@ is the value for that key. @@ -94,7 +105,7 @@ findExprPathToLocation src location = reverse <$> go location -- >>> findTypeForPath [Dict "app", Key "auth", Key "methods", Key "usernameAndPassword"] -- Just (Type.DictType { fields = M.fromList [("configFn", Type.DictOptional { dictEntryType = Type.ExtImportType })] }) findTypeForPath :: ExprPath -> Maybe Type -findTypeForPath (Decl declType : originalPath) = do +findTypeForPath (Decl declType _ : originalPath) = do topType <- getDeclType declType stdTypes go (dtBodyType topType) originalPath where @@ -102,7 +113,7 @@ findTypeForPath (Decl declType : originalPath) = do -- @parentType@. go :: Type -> ExprPath -> Maybe Type go typ [] = Just typ - go _ (Decl _ : _) = Nothing -- Can't follow a decl in the middle of a path. + go _ (Decl _ _ : _) = Nothing -- Can't follow a decl in the middle of a path. go typ (DictKey key : path) = case typ of Type.DictType fields -> do diff --git a/waspc/waspls/src/Wasp/LSP/Util.hs b/waspc/waspls/src/Wasp/LSP/Util.hs index 3ec6d7e56..ca2e4cb5d 100644 --- a/waspc/waspls/src/Wasp/LSP/Util.hs +++ b/waspc/waspls/src/Wasp/LSP/Util.hs @@ -4,16 +4,21 @@ module Wasp.LSP.Util hoistMaybe, waspSourceRegionToLspRange, waspPositionToLspPosition, + getPathRelativeToProjectDir, ) where import Control.Lens ((+~)) import Control.Monad.Trans.Maybe (MaybeT (MaybeT)) import Data.Function ((&)) -import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP hiding (line) import qualified Language.LSP.Types.Lens as LSP +import qualified StrongPath as SP import qualified Wasp.Analyzer.Parser as W import qualified Wasp.Analyzer.Parser.SourceRegion as W +import Wasp.Project (WaspProjectDir) +import Wasp.Util.StrongPath (stripProperPrefix) waspSourceRegionToLspRange :: W.SourceRegion -> LSP.Range waspSourceRegionToLspRange rgn = @@ -40,3 +45,12 @@ anyP preds x = any ($ x) preds -- | Lift a 'Maybe' into a 'MaybeT' monad transformer. hoistMaybe :: Applicative m => Maybe a -> MaybeT m a hoistMaybe = MaybeT . pure + +-- | @absFileInProjectRootDir file@ finds the path to @file@ if it is inside the +-- project root directory. +getPathRelativeToProjectDir :: LSP.MonadLsp c m => SP.Path' SP.Abs (SP.File a) -> m (Maybe (SP.Path' (SP.Rel WaspProjectDir) (SP.File a))) +getPathRelativeToProjectDir file = do + maybeProjectRootDir <- (>>= SP.parseAbsDir) <$> LSP.getRootPath + case maybeProjectRootDir of + Nothing -> pure Nothing + Just projectRootDir -> pure $ stripProperPrefix projectRootDir file diff --git a/waspc/waspls/test/Wasp/LSP/SyntaxTest.hs b/waspc/waspls/test/Wasp/LSP/SyntaxTest.hs new file mode 100644 index 000000000..db61f0459 --- /dev/null +++ b/waspc/waspls/test/Wasp/LSP/SyntaxTest.hs @@ -0,0 +1,40 @@ +module Wasp.LSP.SyntaxTest where + +import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Lens as LSP +import Test.QuickCheck +import Test.Tasty.Hspec +import Wasp.Analyzer.Parser.SourceSpan (SourceSpan (SourceSpan)) +import Wasp.LSP.Syntax + +spec_lspPositionToOffset :: Spec +spec_lspPositionToOffset = describe "Wasp.LSP.Syntax.lspPositionToOffset" $ do + it "works for 1-line strings" $ do + let src = "hello world" + let pos = LSP.Position 0 5 + lspPositionToOffset src pos `shouldBe` 5 + + it "works for a multiline string and counts \\n in the offset" $ do + let src = "hello\nworld" + let pos = LSP.Position 1 2 + lspPositionToOffset src pos `shouldBe` 8 + + it "works for a string with many lines" $ do + let srcLines = ["abc", "xyz", "ijk", "lmno", "wasp is the best", "123"] + let src = unlines srcLines + let pos = LSP.Position 4 3 + lspPositionToOffset src pos `shouldBe` 20 + +spec_lspRangeToSpan :: Spec +spec_lspRangeToSpan = describe "Wasp.LSP.Syntax.lspRangeToSpan" $ do + it "is the same as running lspPositionToOffset on each endpoint of the range" $ do + property $ + \src + (lineStart :: Int) + (colStart :: Int) + (lineEnd :: Int) + (colEnd :: Int) -> + let start = LSP.Position (fromIntegral lineStart) (fromIntegral colStart) + end = LSP.Position (fromIntegral lineEnd) (fromIntegral colEnd) + range = LSP.Range start end + in lspRangeToSpan src range == SourceSpan (lspPositionToOffset src start) (lspPositionToOffset src end)