hsdev 0.3.0.1 → 0.3.0.2

raw patch · 7 files changed

+64/−55 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• data/hsdev.sql +6/−5
• hsdev.cabal +1/−1
• src/HsDev/Client/Commands.hs +30/−37
• src/HsDev/Database/SQLite.hs +2/−0
• src/HsDev/Database/SQLite/Instances.hs +6/−0
• src/HsDev/Stack.hs +8/−1
• src/HsDev/Symbols/Types.hs +11/−11

@@ -197,9 +197,10 @@ create view completions (
 	module_id,
 	completion,
+	qualifier,
 	symbol_id
 ) as
-select id, (case when sc.qualifier is null then sc.name else sc.qualifier || '.' || sc.name end) as full_name, sc.symbol_id
+select id, (case when sc.qualifier is null then sc.name else sc.qualifier || '.' || sc.name end) as full_name, sc.qualifier, sc.symbol_id
 from modules as m, scopes as sc
 where (m.id == sc.module_id);
 
@@ -216,7 +217,8 @@ 	inferred_type text,
 	resolved_module text,
 	resolved_name text,
-	resolve_error text
+	resolve_error text,
+	symbol_id integer
 );
 
 create unique index names_position_index on names (module_id, line, column, line_to, column_to);
@@ -239,11 +241,10 @@ where def_line is not null and def_column is not null
 union
 select n.module_id, n.resolved_name, n.line, n.column, n.line_to, n.column_to, s.module_id, s.line, s.column, 0
-from names as n, modules as srcm, modules as m, projects_modules_scope as ps, symbols as s
+from names as n, modules as srcm, modules as m, symbols as s
 where
 	(n.module_id == srcm.id) and
-	(srcm.cabal == ps.cabal) and
-	(m.id == ps.module_id) and
+	(n.symbol_id == s.id) and
 	(m.name == n.resolved_module) and
 	(s.module_id == m.id) and
 	(s.name == n.resolved_name);

@@ -1,5 +1,5 @@ name:                hsdev
-version:             0.3.0.1
+version:             0.3.0.2
 synopsis:            Haskell development library
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.

@@ -168,19 +168,8 @@ runCommand InfoPackages = toValue $
 	query_ @ModulePackage "select package_name, package_version from package_dbs;"
 runCommand InfoProjects = toValue $ do
-	ps <- query_ @(Only Int :. Project) "select p.id, p.name, p.cabal, p.version from projects as p;"
-	forM ps $ \(Only pid :. proj) -> do
-		libs <- query @_ @Library "select l.modules, b.depends, b.language, b.extensions, b.ghc_options, b.source_dirs, b.other_modules from libraries as l, build_infos as b where (l.project_id == ?) and (l.build_info_id == b.id);"
-			(Only pid)
-		exes <- query @_ @Executable "select e.name, e.path, b.depends, b.language, b.extensions, b.ghc_options, b.source_dirs, b.other_modules from executables as e, build_infos as b where (e.project_id == ?) and (e.build_info_id == b.id);"
-			(Only pid)
-		tsts <- query @_ @Test "select t.name, t.enabled, t.main, b.depends, b.language, b.extensions, b.ghc_options, b.source_dirs, b.other_modules from tests as t, build_infos as b where (t.project_id == ?) and (t.build_info_id == b.id);"
-			(Only pid)
-		return $
-			set (projectDescription . _Just . projectLibrary) (listToMaybe libs) .
-			set (projectDescription . _Just . projectExecutables) exes .
-			set (projectDescription . _Just . projectTests) tsts $
-			proj
+	ps <- query_ @(Only Path) "select cabal from projects;"
+	mapM (SQLite.loadProject . fromOnly) ps
 runCommand InfoSandboxes = toValue $ do
 	rs <- query_ @(Only PackageDb) "select distinct package_db from package_dbs;"
 	return [pdb | Only pdb <- rs]
@@ -246,7 +235,7 @@ 			"srcm.id == n.module_id",
 			"m.name == n.resolved_module",
 			"s.name == n.resolved_name",
-			"m.id in (select srcm.id union select module_id from projects_modules_scope where (((cabal is null) and (srcm.cabal is null)) or (cabal == srcm.cabal)))",
+			"s.id == n.symbol_id",
 			"srcm.file == ?",
 			"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)"])
 		(fpath ^. path, l, c)
@@ -282,8 +271,8 @@ 				"mu.name like ? escape '\\'"])
 			(proj, likePattern sq)
 		_ -> fail "Impossible happened: several projects for one module"
-runCommand (ResolveScope sq fpath) = toValue $ do
-	rs <- query @_ @(SymbolId :. Only (Maybe Text)) (toQuery $ qSymbolId `mappend` select_ ["sc.qualifier"]
+runCommand (ResolveScope sq fpath) = toValue $
+	query @_ @(Scoped SymbolId) (toQuery $ qSymbolId `mappend` select_ ["sc.qualifier"]
 		["scopes as sc", "modules as srcm"]
 		[
 			"srcm.id == sc.module_id",
@@ -291,25 +280,27 @@ 			"srcm.file == ?",
 			"s.name like ? escape '\\'"])
 		(fpath ^. path, likePattern sq)
-	return [ScopeSymbol q s | (s :. Only q) <- rs]
 runCommand (FindUsages l c fpath) = toValue $ do
-	us <- query @_ @SymbolUsage (toQuery $ qSymbol `mappend` qModuleId `mappend` select_
-		["n.line", "n.column"]
-		["names as n", "projects_modules_scope as ps", "names as defn", "modules as srcm"]
-		[
-			"n.module_id = mu.id",
-			"n.resolved_module = defn.resolved_module",
-			"n.resolved_name = defn.resolved_name",
-			"s.name = defn.resolved_name",
-			-- "s.module_id = m.id",
-			"m.name = defn.resolved_module",
-			"(m.id = srcm.id or m.id = ps.module_id)",
-			"(((ps.cabal is null) and (srcm.cabal is null)) or (ps.cabal = srcm.cabal))",
-			"defn.module_id = srcm.id",
-			"(?, ?) between (defn.line, defn.column) and (defn.line_to, defn.column_to)",
-			"(mu.cabal = srcm.cabal or mu.id = srcm.cabal)",
-			"srcm.file = ?"])
-		(l, c, fpath ^. path)
+	us <- do
+		sids <- query @_ @(Only (Maybe Int)) (toQuery $ select_
+			["n.symbol_id"]
+			["names as n", "modules as srcm"]
+			[
+				"n.module_id == srcm.id",
+				"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)",
+				"srcm.file = ?"])
+			(l, c, fpath)
+		when (length sids > 1) $ Log.sendLog Log.Warning $ "multiple symbols found at location {0}:{1}:{2}" ~~ fpath ~~ l ~~ c
+		let
+			msid = join $ fmap fromOnly $ listToMaybe sids
+		query @_ @SymbolUsage (toQuery $ qSymbol `mappend` qModuleId `mappend` select_
+			["n.line", "n.column"]
+			["names as n"]
+			[
+				"n.symbol_id == ?",
+				"s.id == n.symbol_id",
+				"mu.id == n.module_id"])
+			(Only msid)
 	locals <- do
 		defs <- query @_ @(ModuleId :. Only Text :. Position :. Only (Maybe Text) :. Position) (toQuery $ qModuleId `mappend` select_
 			["n.name", "n.def_line", "n.def_column", "n.inferred_type", "n.line", "n.column"]
@@ -334,14 +325,16 @@ 	return $ us ++ locals
 runCommand (Complete input True fpath) = toValue $
 	query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
-		["modules as srcm"]
+		["modules as srcm", "exports as e"]
 		[
-			"m.id in (select srcm.id union select module_id from projects_modules_scope where (((cabal is null) and (srcm.cabal is null)) or (cabal == srcm.cabal)))",
+			"e.module_id in (select srcm.id union select module_id from projects_modules_scope where (((cabal is null) and (srcm.cabal is null)) or (cabal == srcm.cabal)))",
+			"s.id == e.symbol_id",
 			"msrc.file == ?",
 			"s.name like ? escape '\\'"])
 		(fpath ^. path, likePattern (SearchQuery input SearchPrefix))
 runCommand (Complete input False fpath) = toValue $
-	query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
+	query @_ @(Scoped Symbol) (toQuery $ qSymbol `mappend` select_
+		["c.qualifier"]
 		["completions as c", "modules as srcm"]
 		[
 			"c.module_id == srcm.id",

@@ -347,9 +347,11 @@ 		insertResolvedNames mid p = scope "insert-resolved-names" $ do
 			insertNames
 			replaceQNames
+			setResolvedSymbolIds
 			where
 				insertNames = executeMany insertQuery namesData
 				replaceQNames = executeMany insertQuery qnamesData
+				setResolvedSymbolIds = execute "update names set symbol_id = (select symbol_id from scopes as sc where names.module_id == sc.module_id and ((names.qualifier is null and sc.qualifier is null) or (names.qualifier == sc.qualifier)) and names.name == sc.name) where module_id == ? and resolved_module is not null and resolved_name is not null;" (Only mid)
 				insertQuery = "insert or replace into names (module_id, qualifier, name, line, column, line_to, column_to, def_line, def_column, resolved_module, resolved_name, resolve_error) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
 				namesData = map toData $ p ^.. P.names
 				qnamesData = map toQData $ p ^.. P.qnames

@@ -152,6 +152,12 @@ 				toField $ sym ^? symbolInfo . patternType . _Just,
 				toField $ sym ^? symbolInfo . patternConstructor]
 
+instance FromRow a => FromRow (Scoped a) where
+	fromRow = flip Scoped <$> fromRow <*> field
+
+instance ToRow a => ToRow (Scoped a) where
+	toRow (Scoped q s) = toRow s ++ [toField q]
+
 instance FromRow Project where
 	fromRow = do
 		name <- field

@@ -28,6 +28,8 @@ import System.Directory
 import System.Environment
 import System.FilePath
+import qualified System.Log.Simple as Log
+import Text.Format (formats, (~%))
 
 import qualified GHC
 import qualified Packages as GHC
@@ -66,7 +68,12 @@ 	stackExe <- Util.withCurrentDirectory (takeDirectory curExe) $
 		liftIO (findExecutable "stack") >>= maybe (hsdevError $ ToolNotFound "stack") return
 	comp <- stackCompiler
-	liftIO $ runTool_ stackExe (["--compiler", comp, "--arch", stackArch] ++ cmd')
+	let
+		args' = ["--compiler", comp, "--arch", stackArch] ++ cmd'
+	Log.sendLog Log.Trace $ formats "invoking stack: {exe} {args}" [
+		"exe" ~% stackExe,
+		"args" ~% unwords args']
+	liftIO $ runTool_ stackExe args'
 
 -- | Make yaml opts
 yaml :: Maybe FilePath -> [String]

@@ -5,7 +5,7 @@ 	Module(..), moduleSymbols, exportedSymbols, scopeSymbols, fixitiesMap, moduleFixities, moduleId, moduleDocs, moduleImports, moduleExports, moduleScope, moduleSource,
 	Symbol(..), symbolId, symbolDocs, symbolPosition, symbolInfo,
 	SymbolInfo(..), functionType, parentClass, parentType, selectorConstructors, typeArgs, typeContext, familyAssociate, symbolType, patternType, patternConstructor,
-	ScopeSymbol(..), scopeQualifier, scopeSymbol,
+	Scoped(..), scopeQualifier, scoped,
 	SymbolUsage(..), symbolUsed, symbolUsedIn, symbolUsedPosition,
 	infoOf, nullifyInfo,
 	Inspection(..), inspectionAt, inspectionOpts, fresh, Inspected(..), inspection, inspectedKey, inspectionTags, inspectionResult, inspected,
@@ -297,20 +297,20 @@ 	s <- v .:: "what"
 	guard (s == n)
 
--- | Symbol in scope with qualifier
-data ScopeSymbol = ScopeSymbol {
+-- | Scoped entity with qualifier
+data Scoped a = Scoped {
 	_scopeQualifier :: Maybe Text,
-	_scopeSymbol :: SymbolId }
+	_scoped :: a }
 		deriving (Eq, Ord)
 
-instance Show ScopeSymbol where
-	show (ScopeSymbol q s) = maybe "" (\q' -> T.unpack q' ++ ".") q ++ show s
+instance Show a => Show (Scoped a) where
+	show (Scoped q s) = maybe "" (\q' -> T.unpack q' ++ ".") q ++ show s
 
-instance ToJSON ScopeSymbol where
-	toJSON (ScopeSymbol q s) = toJSON s `objectUnion` object (noNulls ["qualifier" .= q])
+instance ToJSON a => ToJSON (Scoped a) where
+	toJSON (Scoped q s) = toJSON s `objectUnion` object (noNulls ["qualifier" .= q])
 
-instance FromJSON ScopeSymbol where
-	parseJSON = withObject "scope-symbol" $ \v -> ScopeSymbol <$>
+instance FromJSON a => FromJSON (Scoped a) where
+	parseJSON = withObject "scope-symbol" $ \v -> Scoped <$>
 		(v .::? "qualifier") <*>
 		parseJSON (Object v)
 
@@ -504,7 +504,7 @@ makeLenses ''Module
 makeLenses ''Symbol
 makeLenses ''SymbolInfo
-makeLenses ''ScopeSymbol
+makeLenses ''Scoped
 makeLenses ''SymbolUsage
 makeLenses ''Inspection
 makeLenses ''Inspected