hovering works

app/Command/Lsp.hs

@@ -28,21 +28,21 @@ command = Opts.helper <*> subcommands
             "server"
             ( Opts.info
                 (fmap server serverOptions <**> Opts.helper)
-                (Opts.progDesc "Start a server process")
+                (Opts.progDesc "Start a server LSP process")
             )
         ]
 
     server :: ServerOptions -> IO ()
     server opts'@(ServerOptions dir globs _globsFromFile _globsExcluded outputPath logLevel) = do
       when
         (logLevel == LogDebug || logLevel == LogAll)
-        (putText "Parsed Options:" *> print opts')
+        (hPutStrLn stderr ("Parsed Options:" :: Text) *> hPutStrLn stderr (show opts' :: Text))
       maybe (pure ()) setCurrentDirectory dir
       let conf =
             LspConfig
               { confOutputPath = outputPath,
-                confGlobs = globs,
-                confLogLevel = logLevel
+                confGlobs = globs
+                -- confLogLevel = logLevel
               }
       env <- mkEnv conf
       startServer env

purescript.cabal

@@ -342,7 +342,9 @@ library
     Language.PureScript.Lsp
     Language.PureScript.Lsp.DB
     Language.PureScript.Lsp.Cache
+    Language.PureScript.Lsp.Cache.IO
     Language.PureScript.Lsp.Cache.Query
+    Language.PureScript.Lsp.Print
     Language.PureScript.Lsp.Rebuild
     Language.PureScript.Lsp.State
     Language.PureScript.Lsp.Types

src/Language/PureScript/Lsp/Cache.hs

@@ -8,17 +8,20 @@ import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as T
 import Database.SQLite.Simple
-import Language.PureScript qualified as P
+import Language.PureScript.AST qualified as P
 import Language.PureScript.AST.Declarations (declName, declRefName, declSourceAnn)
-import Language.PureScript.Externs (ExternsFile (efModuleName), externsFileName)
+import Language.PureScript.AST.SourcePos (SourceSpan (spanName))
+import Language.PureScript.Externs (ExternsFile (efModuleName, efSourceSpan))
+import Language.PureScript.Externs qualified as P
 import Language.PureScript.Ide.Error (IdeError (GeneralError))
 import Language.PureScript.Ide.Externs (readExternFile)
-import Language.PureScript.Ide.Types (ModuleMap)
 import Language.PureScript.Lsp.DB qualified as DB
+import Language.PureScript.Lsp.Print (printEfDeclName, printName)
 import Language.PureScript.Lsp.Types (LspConfig (..), LspEnvironment (lspConfig))
-import Language.PureScript.Lsp.Util (efDeclCategory, efDeclName, efDeclSourceSpan, printDeclarationType, printName)
+import Language.PureScript.Lsp.Util (efDeclCategory, efDeclSourceSpan)
+import Language.PureScript.Names qualified as P
 import Protolude
-import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)
+import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents, makeAbsolute)
 import System.FilePath (normalise, (</>))
 import "monad-logger" Control.Monad.Logger (MonadLogger)
 
@@ -34,20 +37,32 @@ dropTables = do
 initDb :: (MonadReader LspEnvironment m, MonadIO m) => m ()
 initDb = do
   DB.execute_ "CREATE TABLE IF NOT EXISTS modules (module_name TEXT PRIMARY KEY, path TEXT, UNIQUE(module_name), UNIQUE(path))"
-  DB.execute_ "CREATE TABLE IF NOT EXISTS declarations (module_name TEXT, name TEXT, type_printed TEXT, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER, comments TEXT, exported BOOLEAN, value BLOB, PRIMARY KEY (module_name, name))"
-  DB.execute_ "CREATE TABLE IF NOT EXISTS externs (path TEXT PRIMARY KEY, ef_version TEXT, value BLOB, module_name TEXT, UNIQUE(path), UNIQUE(module_name))"
-  DB.execute_ "CREATE TABLE IF NOT EXISTS ef_imports (module_name TEXT, import_name TEXT, imported_module TEXT, import_type TEXT, imported_as TEXT, value BLOB)"
-  DB.execute_ "CREATE TABLE IF NOT EXISTS ef_exports (module_name TEXT, export_name TEXT, value BLOB, name TEXT, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER)"
-  DB.execute_ "CREATE TABLE IF NOT EXISTS ef_declarations (module_name TEXT, name TEXT, value BLOB, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER, category TEXT)"
+  DB.execute_ "CREATE TABLE IF NOT EXISTS declarations (module_name TEXT, name BLOB, printed_name TEXT, type_printed TEXT, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER, comments TEXT, exported BOOLEAN, value BLOB, shown TEXT, PRIMARY KEY (module_name, name))"
+  DB.execute_ "CREATE TABLE IF NOT EXISTS externs (path TEXT PRIMARY KEY, ef_version TEXT, value BLOB, module_name TEXT, shown TEXT, UNIQUE(path), UNIQUE(module_name))"
+  DB.execute_ "CREATE TABLE IF NOT EXISTS ef_imports (module_name TEXT, imported_module TEXT, import_type TEXT, imported_as TEXT, value BLOB)"
+  DB.execute_ "CREATE TABLE IF NOT EXISTS ef_exports (module_name TEXT, export_name TEXT, value BLOB, name BLOB, printed_name TEXT, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER)"
+  DB.execute_ "CREATE TABLE IF NOT EXISTS ef_declarations (module_name TEXT, name TEXT, value BLOB, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER, category TEXT, shown TEXT)"
 
-selectAllExternsMap :: (MonadIO m, MonadReader LspEnvironment m) => m (ModuleMap ExternsFile)
+selectAllExternsMap :: (MonadIO m, MonadReader LspEnvironment m) => m (Map P.ModuleName ExternsFile)
 selectAllExternsMap = do
   Map.fromList . fmap (\ef -> (efModuleName ef, ef)) <$> selectAllExterns
 
 selectAllExterns :: (MonadIO m, MonadReader LspEnvironment m) => m [ExternsFile]
 selectAllExterns = do
   DB.query_ (Query "SELECT value FROM externs") <&> fmap (deserialise . fromOnly)
 
+selectExternFromFilePath :: (MonadIO m, MonadReader LspEnvironment m) => FilePath -> m (Maybe ExternsFile)
+selectExternFromFilePath path = do
+  absPath <- liftIO $ makeAbsolute path
+  res <- DB.queryNamed (Query "SELECT value FROM externs WHERE path = :path") [":path" := absPath]
+  pure $ deserialise . fromOnly <$> listToMaybe res
+
+selectExternModuleNameFromFilePath :: (MonadIO m, MonadReader LspEnvironment m) => FilePath -> m (Maybe P.ModuleName)
+selectExternModuleNameFromFilePath path = do
+  absPath <- liftIO $ makeAbsolute path
+  res <- DB.queryNamed (Query "SELECT module_name FROM externs WHERE path = :path") [":path" := absPath]
+  pure $ P.ModuleName . fromOnly <$> listToMaybe res
+
 insertAllExterns ::
   ( MonadIO m,
     MonadReader LspEnvironment m,
@@ -59,9 +74,9 @@ insertAllExterns = do
   oDir <- asks (confOutputPath . lspConfig)
   externPaths <- findAvailableExterns
   forM_ externPaths $ \name -> do
-    extern <- readExternFile (oDir </> toS (P.runModuleName name) </> P.externsFileName)
-
-    insertExtern oDir extern
+    let externPath = oDir </> toS (P.runModuleName name) </> P.externsFileName
+    extern <- readExternFile externPath
+    insertExtern extern
 
 -- | Finds all the externs inside the output folder and returns the
 -- corresponding module names
@@ -87,17 +102,19 @@ findAvailableExterns = do
 
 insertExtern ::
   (MonadIO m, MonadReader LspEnvironment m) =>
-  FilePath ->
   ExternsFile ->
   m ()
-insertExtern outDir extern = do
+insertExtern extern = do
+  path <- liftIO $ makeAbsolute externPath
   DB.executeNamed
-    (Query "INSERT OR REPLACE INTO externs (path, ef_version, value, module_name) VALUES (:path, :ef_version, :value, :module_name)")
-    [ ":path" := externsPath,
+    (Query "INSERT OR REPLACE INTO externs (path, ef_version, value, module_name, shown) VALUES (:path, :ef_version, :value, :module_name, :shown)")
+    [ ":path" := path,
       ":ef_version" := P.efVersion extern,
       ":value" := serialise extern,
-      ":module_name" := P.runModuleName name
+      ":module_name" := P.runModuleName name,
+      ":shown" := (show extern :: Text)
     ]
+
   DB.executeNamed
     (Query "DELETE FROM ef_imports WHERE module_name = :module_name")
     [":module_name" := P.runModuleName name]
@@ -111,8 +128,8 @@ insertExtern outDir extern = do
     [":module_name" := P.runModuleName name]
   forM_ (P.efDeclarations extern) $ insertEfDeclaration name
   where
-    externsPath = outDir </> T.unpack (P.runModuleName name) <> externsFileName
     name = efModuleName extern
+    externPath = spanName (efSourceSpan extern)
 
 insertEfImport :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> P.ExternsImport -> m ()
 insertEfImport moduleName' ei = do
@@ -128,10 +145,11 @@ insertEfImport moduleName' ei = do
 insertEfDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> P.ExternsDeclaration -> m ()
 insertEfDeclaration moduleName' decl = do
   DB.executeNamed
-    (Query "INSERT OR REPLACE INTO ef_declarations (module_name, value, name, start_col, start_line, end_col, end_line, category) VALUES (:module_name, :value, :name, :start_col, :start_line, :end_col, :end_line, :category)")
+    (Query "INSERT OR REPLACE INTO ef_declarations (module_name, value, shown, name, start_col, start_line, end_col, end_line, category) VALUES (:module_name, :value, :shown, :name, :start_col, :start_line, :end_col, :end_line, :category)")
     [ ":module_name" := P.runModuleName moduleName',
-      ":name" := efDeclName decl,
+      ":name" := printEfDeclName decl,
       ":value" := serialise decl,
+      ":shown" := (show decl :: Text),
       ":start_col" := (P.sourcePosColumn . P.spanStart) span,
       ":start_line" := (P.sourcePosLine . P.spanStart) span,
       ":end_col" := (P.sourcePosColumn . P.spanEnd) span,
@@ -144,10 +162,11 @@ insertEfDeclaration moduleName' decl = do
 insertEfExport :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> P.DeclarationRef -> m ()
 insertEfExport moduleName' dr = do
   DB.executeNamed
-    (Query "INSERT OR REPLACE INTO ef_exports (module_name, value, name, start_col, start_line, end_col, end_line) VALUES (:module_name, :value, :name, :start_col, :start_line, :end_col, :end_line)")
+    (Query "INSERT OR REPLACE INTO ef_exports (module_name, value, name, printed_name, start_col, start_line, end_col, end_line) VALUES (:module_name, :value, :name, :printed_name, :start_col, :start_line, :end_col, :end_line)")
     [ ":module_name" := P.runModuleName moduleName',
       ":value" := serialise dr,
-      ":name" := printName (declRefName dr),
+      ":name" := serialise (declRefName dr),
+      ":printed_name" := printName (declRefName dr),
       ":start_col" := (P.sourcePosColumn . P.spanStart) span,
       ":start_line" := (P.sourcePosLine . P.spanStart) span,
       ":end_col" := (P.sourcePosColumn . P.spanEnd) span,
@@ -166,25 +185,31 @@ insertModule srcPath m = do
     ]
 
   let exported = Set.fromList $ P.exportedDeclarations m
+  DB.executeNamed "DELETE FROM declarations WHERE module_name = :module_name" [":module_name" := P.runModuleName moduleName']
   traverse_ (insertDeclaration moduleName' exported) (P.getModuleDeclarations m)
 
 insertDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Set P.Declaration -> P.Declaration -> m ()
 insertDeclaration moduleName' exportedDecls decl = do
-  DB.executeNamed
-    (Query "INSERT OR REPLACE INTO declarations (module_name, name, type_printed, start_col, start_line, end_col, end_line, comments, exported, value) VALUES (:module_name, :name, :type_printed, :start_col, :start_line, :end_col, :end_line, :comments, :exported, :value)")
-    [ ":module_name" := P.runModuleName moduleName',
-      ":name" := maybe (show decl) printName (declName decl),
-      ":type_printed" := typeName,
-      ":start_col" := (P.sourcePosColumn . P.spanStart) declLocation,
-      ":start_line" := (P.sourcePosLine . P.spanStart) declLocation,
-      ":end_col" := (P.sourcePosColumn . P.spanEnd) declLocation,
-      ":end_line" := (P.sourcePosLine . P.spanEnd) declLocation,
-      ":comments" := encode comments,
-      ":exported" := exported,
-      ":value" := serialise decl
-    ]
+  for_ (declName decl) $ \name -> do
+    DB.executeNamed
+      ( Query
+          "INSERT OR REPLACE INTO declarations \
+          \(module_name, name, printed_name, start_col, start_line, end_col, end_line, comments, exported, value, shown) \
+          \VALUES \
+          \(:module_name, :name, :printed_name, :start_col, :start_line, :end_col, :end_line, :comments, :exported, :value, :shown)"
+      )
+      [ ":module_name" := P.runModuleName moduleName',
+        ":name" := serialise name,
+        ":printed_name" := printName name,
+        ":start_col" := (P.sourcePosColumn . P.spanStart) declLocation,
+        ":start_line" := (P.sourcePosLine . P.spanStart) declLocation,
+        ":end_col" := (P.sourcePosColumn . P.spanEnd) declLocation,
+        ":end_line" := (P.sourcePosLine . P.spanEnd) declLocation,
+        ":comments" := encode comments,
+        ":exported" := exported,
+        ":value" := serialise decl,
+        ":shown" := (show decl :: Text)
+      ]
   where
-    typeName = printDeclarationType decl
-
     exported = Set.member decl exportedDecls
     (declLocation, comments) = declSourceAnn decl

src/Language/PureScript/Lsp/Cache/IO.hs

@@ -0,0 +1,23 @@
+module Language.PureScript.Lsp.Cache.IO where
+
+import Protolude
+import Database.SQLite.Simple qualified as SQL
+
+
+dropTables :: SQL.Connection -> IO ()
+dropTables conn = do
+  SQL.execute_ conn "DROP TABLE IF EXISTS modules"
+  SQL.execute_ conn "DROP TABLE IF EXISTS declarations"
+  SQL.execute_ conn "DROP TABLE IF EXISTS externs"
+  SQL.execute_ conn "DROP TABLE IF EXISTS ef_imports"
+  SQL.execute_ conn "DROP TABLE IF EXISTS ef_exports"
+  SQL.execute_ conn "DROP TABLE IF EXISTS ef_declarations"
+
+initDb :: SQL.Connection -> IO ()
+initDb conn = do
+  SQL.execute_ conn "CREATE TABLE IF NOT EXISTS modules (module_name TEXT PRIMARY KEY, path TEXT, UNIQUE(module_name), UNIQUE(path))"
+  SQL.execute_ conn "CREATE TABLE IF NOT EXISTS declarations (module_name TEXT, name BLOB, printed_name TEXT, type_printed TEXT, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER, comments TEXT, exported BOOLEAN, value BLOB, shown TEXT, PRIMARY KEY (module_name, name))"
+  SQL.execute_ conn "CREATE TABLE IF NOT EXISTS externs (path TEXT PRIMARY KEY, ef_version TEXT, value BLOB, module_name TEXT, shown TEXT, UNIQUE(path), UNIQUE(module_name))"
+  SQL.execute_ conn "CREATE TABLE IF NOT EXISTS ef_imports (module_name TEXT, imported_module TEXT, import_type TEXT, imported_as TEXT, value BLOB)"
+  SQL.execute_ conn "CREATE TABLE IF NOT EXISTS ef_exports (module_name TEXT, export_name TEXT, value BLOB, name BLOB, printed_name TEXT, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER)"
+  SQL.execute_ conn "CREATE TABLE IF NOT EXISTS ef_declarations (module_name TEXT, name TEXT, value BLOB, start_col INTEGER, start_line INTEGER, end_col INTEGER, end_line INTEGER, category TEXT, shown TEXT)"

src/Language/PureScript/Lsp/Cache/Query.hs

@@ -1,4 +1,6 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
 module Language.PureScript.Lsp.Cache.Query where
 
@@ -12,7 +14,10 @@ import Data.Set qualified as Set
 import Data.Text qualified as T
 import Database.SQLite.Simple
 import Language.LSP.Protocol.Types (Position)
-import Language.PureScript qualified as P
+import Language.PureScript.AST qualified as P
+import Language.PureScript.Comments qualified as P
+import Language.PureScript.Externs qualified as P
+import Language.PureScript.Names qualified as P
 import Language.PureScript.AST.Declarations (declSourceAnn)
 import Language.PureScript.AST.Traversals (accumTypes)
 import Language.PureScript.Externs (ExternsFile (efModuleName), externsFileName)
@@ -21,25 +26,24 @@ import Language.PureScript.Ide.Externs (readExternFile)
 import Language.PureScript.Ide.Types (ModuleMap)
 import Language.PureScript.Lsp.DB qualified as DB
 import Language.PureScript.Lsp.Types (LspConfig (..), LspEnvironment (lspConfig))
-import Language.PureScript.Lsp.Util (printName)
 import Language.PureScript.Pretty.Types (prettyPrintType)
 import Protolude
 import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)
 import System.FilePath (normalise, (</>))
+import Control.Monad.Trans.Writer (execWriterT)
+import Language.PureScript.Lsp.Print (printName)
 
--- getDeclarationAt :: (MonadIO m, MonadReader LspEnvironment m) => Position -> m (Maybe P.Declaration)
--- getDeclarationAt pos = do
+-- getEfDeclarationAt :: (MonadIO m, MonadReader LspEnvironment m) => Position -> m (Maybe P.Declaration)
+-- getEfDeclarationAt pos = do
 --   decls <-
 --     DB.queryNamed
 --       "SELECT * FROM declarations WHERE startLine <= :line AND endLine >= :line AND startColumn <= :column AND endColumn >= :column"
 --       [":line" := line
 --       , ":column" := column
 --       ]
 --   pure $ listToMaybe decls
-
 -- getImportedModules
 
-
 getEfImports :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> m [P.ExternsImport]
 getEfImports moduleName' = do
   imports <-
@@ -54,24 +58,29 @@ importMightContainIdent ident import' = case P.eiImportType import' of
   P.Explicit refs -> any ((==) ident . printName . P.declRefName) refs
   P.Hiding refs -> not $ any ((==) ident . printName . P.declRefName) refs
 
-getDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Text -> m (Maybe P.ExternsDeclaration)
-getDeclaration moduleName' name = do 
+getEfDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Text -> m (Maybe (P.ModuleName, P.ExternsDeclaration))
+getEfDeclaration moduleName' name = do
   inModule <- getEfDeclarationOnlyInModule moduleName' name
   case inModule of
-    Just decl -> pure $ Just decl
-    Nothing -> getImportedDeclaration moduleName' name
+    Just decl -> pure $ Just (moduleName', decl)
+    Nothing -> getEFImportedDeclaration moduleName' name
 
-
-getImportedDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Text -> m (Maybe P.ExternsDeclaration)
-getImportedDeclaration moduleName' name = do
+getEFImportedDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Text -> m (Maybe (P.ModuleName, P.ExternsDeclaration))
+getEFImportedDeclaration moduleName' name = do
   imports <- filter (importMightContainIdent name) <$> getEfImports moduleName'
   foldM go Nothing imports
   where
-    go :: (MonadIO m, MonadReader LspEnvironment m) => Maybe P.ExternsDeclaration -> P.ExternsImport -> m (Maybe P.ExternsDeclaration)
+    go ::
+      (MonadIO m, MonadReader LspEnvironment m) =>
+      Maybe (P.ModuleName, P.ExternsDeclaration) ->
+      P.ExternsImport ->
+      m (Maybe (P.ModuleName, P.ExternsDeclaration))
     go acc import' = do
       case acc of
         Just _ -> pure acc
-        Nothing -> getEfDeclarationOnlyInModule (P.eiModule import') name
+        Nothing -> fmap (toTup $ P.eiModule import') <$> getEfDeclarationOnlyInModule (P.eiModule import') name
+
+    toTup a b = (a, b)
 
 getEfDeclarationOnlyInModule :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Text -> m (Maybe P.ExternsDeclaration)
 getEfDeclarationOnlyInModule moduleName' name = do
@@ -82,3 +91,21 @@ getEfDeclarationOnlyInModule moduleName' name = do
         ":name" := name
       ]
   pure $ deserialise . fromOnly <$> listToMaybe decls
+
+getDeclaration :: (MonadIO m, MonadReader LspEnvironment m) => P.ModuleName -> Text -> m (Maybe P.Declaration)
+getDeclaration moduleName' name = do
+  decls <-
+    DB.queryNamed
+      "SELECT value FROM declarations WHERE module_name = :module_name AND name = :name"
+      [ ":module_name" := P.runModuleName moduleName',
+        ":name" := name
+      ]
+  pure $ deserialise . fromOnly <$> listToMaybe decls
+
+
+getDeclarationDocumentation :: (MonadIO m, MonadReader LspEnvironment m) => P.Module -> P.Declaration -> m [P.Comment]
+getDeclarationDocumentation module' decl = 
+   execWriterT $ do 
+    P.everywhereOnValuesM handleDecl pure pure ^. _1 $ decl
+  where 
+    handleDecl = pure