hsdev 0.3.0.3 → 0.3.1.0

raw patch · 43 files changed

+2304/−947 lines, 43 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• data/hsdev.sql +157/−95
• hsdev.cabal +7/−1
• src/HsDev/Client/Commands.hs +140/−96
• src/HsDev/Database/SQLite.hs +142/−46
• src/HsDev/Database/SQLite/Instances.hs +162/−45
• src/HsDev/Database/SQLite/Schema.hs +11/−6
• src/HsDev/Database/SQLite/Select.hs +82/−50
• src/HsDev/Database/SQLite/Transaction.hs +1/−1
• src/HsDev/Database/Update.hs +148/−54
• src/HsDev/Database/Update/Types.hs +9/−12
• src/HsDev/Inspect.hs +69/−207
• src/HsDev/Inspect/Definitions.hs +126/−0
• src/HsDev/Inspect/Order.hs +11/−8
• src/HsDev/Inspect/Resolve.hs +490/−0
• src/HsDev/Inspect/Types.hs +100/−0
• src/HsDev/PackageDb.hs +9/−7
• src/HsDev/PackageDb/Types.hs +6/−1
• src/HsDev/Project/Types.hs +13/−9
• src/HsDev/Sandbox.hs +31/−29
• src/HsDev/Scan.hs +5/−1
• src/HsDev/Scan/Browse.hs +10/−34
• src/HsDev/Server/Base.hs +14/−4
• src/HsDev/Server/Commands.hs +1/−2
• src/HsDev/Server/Message.hs +2/−2
• src/HsDev/Server/Types.hs +14/−2
• src/HsDev/Stack.hs +1/−5
• src/HsDev/Symbols.hs +10/−0
• src/HsDev/Symbols/Name.hs +8/−0
• src/HsDev/Symbols/Types.hs +73/−22
• src/HsDev/Tools/Base.hs +0/−14
• src/HsDev/Tools/Ghc/Base.hs +196/−0
• src/HsDev/Tools/Ghc/Check.hs +1/−6
• src/HsDev/Tools/Ghc/Compat.hs +25/−6
• src/HsDev/Tools/Ghc/Repl.hs +57/−0
• src/HsDev/Tools/Ghc/System.hs +55/−0
• src/HsDev/Tools/Ghc/Types.hs +10/−10
• src/HsDev/Tools/Ghc/Worker.hs +5/−157
• src/HsDev/Types.hs +9/−0
• src/HsDev/Util.hs +13/−0
• tests/Test.hs +57/−14
• tests/test-package/ModuleOne.hs +8/−1
• tests/test-package/ModuleThree.hs +15/−0
• tests/test-package/test-package.cabal +1/−0

@@ -1,16 +1,19 @@-pragma case_sensitive_like = true;
-
+-- system table for various options, for now only version
 create table hsdev (
 	option text,
 	value json
 );
 
+-- packages per package-db
 create table package_dbs (
-	package_db text, -- global, user or path
-	package_name text,
-	package_version text
+	package_db text not null, -- global, user or path
+	package_name text not null,
+	package_version text not null
 );
 
+create index package_names_index on package_dbs (package_db, package_name);
+
+-- same as `package_dbs`, but only latest version of package left
 create view latest_packages (
 	package_db,
 	package_name,
@@ -20,37 +23,49 @@ from package_dbs
 group by package_db, package_name;
 
+-- source projects
 create table projects (
 	id integer primary key autoincrement,
-	name text,
-	cabal text,
+	name text not null,
+	cabal text not null, -- path to `.cabal` file
 	version text,
 	package_db_stack json -- list of package-db
 );
 
 create unique index projects_id_index on projects (id);
+create unique index projects_cabal_index on projects (cabal);
 
+-- project's library targets
 create table libraries (
-	project_id integer,
-	modules json, -- list of modules
-	build_info_id integer
+	project_id integer not null,
+	modules json not null, -- list of modules
+	build_info_id integer not null
 );
 
+create unique index libraries_ids_index on libraries (project_id, build_info_id);
+
+-- project's executables targets
 create table executables (
-	project_id integer,
-	name text,
-	path text,
-	build_info_id integer
+	project_id integer not null,
+	name text not null,
+	path text not null,
+	build_info_id integer not null
 );
 
+create unique index executables_ids_index on executables (project_id, build_info_id);
+
+-- project's tests targets
 create table tests (
-	project_id integer,
-	name text,
-	enabled integer,
+	project_id integer not null,
+	name text not null,
+	enabled integer not null,
 	main text,
-	build_info_id integer
+	build_info_id integer not null
 );
 
+create unique index tests_ids_index on tests (project_id, build_info_id);
+
+-- map from project to build-info for all targets
 create view targets (
 	project_id,
 	build_info_id
@@ -61,53 +76,69 @@ union
 select project_id, build_info_id from tests;
 
+-- target build-info
 create table build_infos(
 	id integer primary key autoincrement,
-	depends json, -- list of dependencies
+	depends json not null, -- list of dependencies
 	language text,
-	extensions json, -- list of extensions
-	ghc_options json, -- list of ghc-options
-	source_dirs json, -- list of source directories
-	other_modules json -- list of other modules
+	extensions json not null, -- list of extensions
+	ghc_options json not null, -- list of ghc-options
+	source_dirs json not null, -- list of source directories
+	other_modules json not null -- list of other modules
 );
 
+create unique index build_infos_id_index on build_infos (id);
+
+-- project dependent packages
 create view projects_deps (
 	cabal,
+	package_db,
 	package_name,
 	package_version
 ) as
-select distinct p.cabal, deps.value, ps.package_version
+select distinct p.cabal, ps.package_db, ps.package_name, ps.package_version
 from projects as p, json_each(p.package_db_stack) as pdb_stack, build_infos as b, json_each(b.depends) as deps, targets as t, latest_packages as ps
-where (p.id == t.project_id) and (b.id == t.build_info_id) and (deps.value <> p.name) and (ps.package_name == deps.value) and (ps.package_db == pdb_stack.value);
+where
+	(p.id == t.project_id) and
+	(b.id == t.build_info_id) and
+	(deps.value <> p.name) and
+	(ps.package_name == deps.value) and
+	(ps.package_db == pdb_stack.value);
 
+-- packages in scope of project
+-- `cabal` may be null for standalone files, in this case all 'user-db' is in scope
 create view projects_modules_scope (
 	cabal,
 	module_id
 ) as
 select pdbs.cabal, m.id
 from projects_deps as pdbs, modules as m
-where (m.package_name == pdbs.package_name) and (m.package_version == pdbs.package_version)
+where
+	(m.package_name == pdbs.package_name) and
+	(m.package_version == pdbs.package_version)
 union
 select p.cabal, m.id
 from projects as p, modules as m
 where (m.cabal == p.cabal)
 union
 select null, m.id
-from modules as m, package_dbs as ps
-where (m.package_name == ps.package_name) and (m.package_version == ps.package_version) and (ps.package_db in ('user-db', 'global-db'));
-
-create unique index build_infos_id_index on build_infos (id);
+from modules as m, latest_packages as ps
+where
+	(m.package_name == ps.package_name) and
+	(m.package_version == ps.package_version) and
+	(ps.package_db in ('user-db', 'global-db'));
 
+-- symbols
 create table symbols (
 	id integer primary key autoincrement,
-	name text,
-	module_id integer,
+	name text not null,
+	module_id integer not null, -- definition module
 	docs text,
-	line integer,
-	column integer,
-	what text, -- kind of symbol: function, method, ...
-	type text,
-	parent text,
+	line integer, -- line of definition
+	column integer, -- column of definition
+	what text not null, -- kind of symbol: function, method, ...
+	type text, -- type of function/method/...
+	parent text, -- parent of selector/method/...
 	constructors json, -- list of constructors for selector
 	args json, -- list of arguments for types
 	context json, -- list of contexts for types
@@ -117,24 +148,26 @@ );
 
 create unique index symbols_id_index on symbols (id);
-create index symbols_module_id_index on symbols (module_id);
-create index symbols_name_index on symbols (name);
+create unique index symbols_index on symbols (module_id, name, what);
 
+-- modules
 create table modules (
 	id integer primary key autoincrement,
-	file text,
-	cabal text,
-	-- project_id integer,
+	-- source module location
+	file text, -- source file
+	cabal text, -- related project's `.cabal`
+	-- installed module location
 	install_dirs json, -- list of paths
-	package_name text,
-	package_version text,
+	package_name text, -- package name of module
+	package_version text, -- package version
 	installed_name text, -- if not null, should be equal to name
-	other_location text,
+	-- some other location
+	other_location text, -- anything
 
 	name text,
 	docs text,
 	fixities json, -- list of fixities
-	tags json, -- dict of tags, value not used, tag is set if present
+	tags json, -- dict of tags, value not used, tag is set if present; used by hsdev to mark if types was inferred or docs scanned
 	inspection_error text,
 	inspection_time integer,
 	inspection_opts json -- list of flags
@@ -149,51 +182,48 @@ 	installed_name is not null;
 create unique index modules_other_locations_index on modules (other_location) where other_location is not null;
 
+-- module import statements
 create table imports (
-	module_id integer,
-	line integer,
-	module_name text,
-	qualified integer,
-	alias text,
-	hiding integer,
-	import_list json -- list of import specs
+	module_id integer not null,
+	line integer not null, -- line number of import
+	module_name text not null, -- import module name
+	qualified integer not null, -- is import qualified
+	alias text, -- imported with `as`
+	hiding integer, -- is list hiding
+	import_list json, -- list of import specs, null if not specified
+	import_module_id -- `id` of imported module
 );
 
-create index imports_module_id_index on imports (module_id);
-
-create view imported_modules as
-select i.*, im.id as imported_id
-from imports as i, projects_modules_scope as ps, modules as im, modules as m
-where
-	i.module_id == m.id and
-	((ps.cabal is null and m.cabal is null) or (ps.cabal == m.cabal)) and
-	ps.module_id == im.id and
-	im.name == i.module_name;
+create unique index imports_position_index on imports (module_id, line);
 
+-- symbols bringed into scope by import, with qualifier
 create view imported_scopes as
 select i.*, q.value as qualifier, s.name as name, s.id as symbol_id
-from imported_modules as i, json_each(case when i.qualified then json_array(ifnull(i.alias, i.module_name)) else json_array(ifnull(i.alias, i.module_name), null) end) as q, symbols as s, exports as e
+from imports as i, json_each(case when i.qualified then json_array(ifnull(i.alias, i.module_name)) else json_array(ifnull(i.alias, i.module_name), null) end) as q, symbols as s, exports as e
 where
-	e.module_id == i.imported_id and
+	e.module_id == i.import_module_id and
 	e.symbol_id == s.id and
 	(i.import_list is null or (s.name in (select json_extract(import_list_item.value, '$.name') from json_each(i.import_list) as import_list_item) == not i.hiding));
 
+-- module exports
 create table exports (
-	module_id integer,
-	symbol_id integer
+	module_id integer not null,
+	symbol_id integer not null
 );
 
 create index exports_module_id_index on exports (module_id);
 
+-- source file module's symbols in scope
 create table scopes (
-	module_id integer,
+	module_id integer not null,
 	qualifier text,
-	name text,
-	symbol_id integer
+	name text not null,
+	symbol_id integer not null
 );
 
-create index scopes_module_id_index on scopes (module_id);
+create index scopes_name_index on scopes (module_id, name);
 
+-- like `scopes`, but with column `completion` with fully qualified name
 create view completions (
 	module_id,
 	completion,
@@ -204,26 +234,29 @@ from modules as m, scopes as sc
 where (m.id == sc.module_id);
 
+-- resolved names in module
 create table names (
-	module_id integer,
-	qualifier text,
-	name text,
-	line integer,
-	column integer,
-	line_to integer,
-	column_to integer,
-	def_line integer,
-	def_column integer,
-	inferred_type text,
-	resolved_module text,
-	resolved_name text,
+	module_id integer not null,
+	qualifier text, -- name qualifier
+	name text not null, -- name
+	line integer not null, -- line of name
+	column integer not null, -- column of name
+	line_to integer not null, -- line of name end
+	column_to integer not null, -- column of name end
+	def_line integer, -- name definition line, for local names
+	def_column integer, -- name definition column, for local names
+	inferred_type text, -- inferred name type, set by hsdev
+	resolved_module text, -- resolved module name, for global and top-level names
+	resolved_name text, -- resolved name, for global and top-level names
+	resolved_what text, -- resolved symbol kind
 	resolve_error text,
-	symbol_id integer
+	symbol_id integer -- resolved symbol id
 );
 
 create unique index names_position_index on names (module_id, line, column, line_to, column_to);
-create index names_module_id_index on names (module_id);
+create index names_name_index on names (module_id, name);
 
+-- like `names`, but with definition position set for both local and global names
 create view definitions (
 	module_id,
 	name,
@@ -249,6 +282,7 @@ 	(s.module_id == m.id) and
 	(s.name == n.resolved_name);
 
+-- sources dependencies relations
 create view sources_depends (
 	module_id,
 	module_file,
@@ -265,20 +299,48 @@ 	(m.file is not null) and
 	(im.file is not null);
 
+-- expressions types
 create table types (
-	module_id integer,
-	line integer,
-	column integer,
-	line_to integer,
-	column_to integer,
-	expr text,
-	type text
+	module_id integer not null,
+	line integer not null, -- line of expression
+	column integer not null, -- column of expression
+	line_to integer not null, --  line of expression end
+	column_to integer not null, -- column of expression end
+	expr text not null, -- expression contents
+	type text not null -- expression type
 );
 
+create unique index types_position_index on types (module_id, line, column, line_to, column_to);
+
+-- modified file contents, hsdev will use it in commands whenever it is newer than file
 create table file_contents (
-	file text not null,
-	contents text,
-	mtime integer
+	file text not null, -- file path
+	contents text not null, -- file contents
+	mtime integer not null -- posix modification time
 );
 
 create unique index file_contents_index on file_contents (file);
+
+-- table with last time of loading module
+create table load_times (
+	module_id integer not null, -- module affected
+	load_time integer not null -- timestamp
+);
+
+create unique index load_times_module_id_index on load_times (module_id);
+
+-- table with ghc warnings on file
+-- sequential call to load module won't actually reload file and won't produce warnings
+-- but we want to see them again
+create table messages (
+	module_id integer not null,
+	line integer not null,
+	column integer not null,
+	line_to integer not null,
+	column_to integer not null,
+	severity text,
+	message text not null,
+	suggestion text
+);
+
+create index messages_module_id_index on messages (module_id);

@@ -1,5 +1,5 @@ name:                hsdev
-version:             0.3.0.3
+version:             0.3.1.0
 synopsis:            Haskell development library
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -57,7 +57,10 @@     HsDev.Display
     HsDev.Error
     HsDev.Inspect
+    HsDev.Inspect.Definitions
     HsDev.Inspect.Order
+    HsDev.Inspect.Resolve
+    HsDev.Inspect.Types
     HsDev.PackageDb
     HsDev.PackageDb.Types
     HsDev.Project
@@ -85,11 +88,14 @@     HsDev.Tools.Base
     HsDev.Tools.Cabal
     HsDev.Tools.ClearImports
+    HsDev.Tools.Ghc.Base
     HsDev.Tools.Ghc.Check
     HsDev.Tools.Ghc.Compat
     HsDev.Tools.Ghc.MGhc
     HsDev.Tools.Ghc.Prelude
+    HsDev.Tools.Ghc.Repl
     HsDev.Tools.Ghc.Session
+    HsDev.Tools.Ghc.System
     HsDev.Tools.Ghc.Types
     HsDev.Tools.Ghc.Worker
     HsDev.Tools.Hayoo

@@ -156,7 +156,12 @@ 			removePackageDbStack pdbs
 
 	forM_ files $ \file -> do
-		ms <- query @_ @(ModuleId :. Only Int) (toQuery $ qModuleId `mappend` select_ ["mu.id"] [] ["mu.file == ?"]) (Only file)
+		ms <- query @_ @(ModuleId :. Only Int)
+			(toQuery $ mconcat [
+				qModuleId,
+				select_ ["mu.id"],
+				where_ ["mu.file == ?"]])
+			(Only file)
 		forM_ ms $ \(m :. Only i) -> do
 			SQLite.removeModule i
 			liftIO . unwatchModule w $ (m ^. moduleLocation)
@@ -176,18 +181,31 @@ runCommand (InfoSymbol sq filters True _) = toValue $ do
 	let
 		(conds, params) = targetFilters "m" (Just "s") filters
-	rs <- queryNamed @SymbolId (toQuery $ qSymbolId `mappend` where_ ["s.name like :pattern escape '\\'"] `mappend` where_ conds)
+	rs <- queryNamed @SymbolId
+		(toQuery $ mconcat [
+			qSymbolId,
+			where_ ["s.name like :pattern escape '\\'"],
+			where_ conds])
 		([":pattern" := likePattern sq] ++ params)
 	return rs
 runCommand (InfoSymbol sq filters False _) = toValue $ do
 	let
 		(conds, params) = targetFilters "m" (Just "s") filters
-	queryNamed @Symbol (toQuery $ qSymbol `mappend` where_ ["s.name like :pattern escape '\\'"] `mappend` where_ conds)
+	queryNamed @Symbol
+		(toQuery $ mconcat [
+			qSymbol,
+			where_ ["s.name like :pattern escape '\\'"],
+			where_ conds])
 		([":pattern" := likePattern sq] ++ params)
 runCommand (InfoModule sq filters h _) = toValue $ do
 	let
 		(conds, params) = targetFilters "mu" Nothing filters
-	rs <- queryNamed @(Only Int :. ModuleId) (toQuery $ select_ ["mu.id"] [] [] `mappend` qModuleId `mappend` where_ ["mu.name like :pattern escape '\\'"] `mappend` where_ conds)
+	rs <- queryNamed @(Only Int :. ModuleId)
+		(toQuery $ mconcat [
+			select_ ["mu.id"],
+			qModuleId,
+			where_ ["mu.name like :pattern escape '\\'"],
+			where_ conds])
 		([":pattern" := likePattern sq] ++ params)
 	if h
 		then return (toJSON $ map (\(_ :. m) -> m) rs)
@@ -196,59 +214,65 @@ 				(Only mid)
 			let
 				fixities' = fromMaybe [] (fixities >>= fromJSON')
-			exports' <- query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
-				["exports as e"]
-				["e.module_id == ?", "e.symbol_id == s.id"])
+			exports' <- query @_ @Symbol (toQuery $ mconcat [
+				qSymbol,
+				from_ ["exports as e"],
+				where_ ["e.module_id == ?", "e.symbol_id == s.id"]])
 				(Only mid)
 			return $ Module mheader docs mempty exports' fixities' mempty Nothing
 runCommand (InfoProject (Left projName)) = toValue $ findProject projName
 runCommand (InfoProject (Right projPath)) = toValue $ liftIO $ searchProject (view path projPath)
 runCommand (InfoSandbox sandbox') = toValue $ liftIO $ searchSandbox sandbox'
 runCommand (Lookup nm fpath) = toValue $
-	query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
-		["projects_modules_scope as pms", "modules as srcm", "exports as e"]
-		[
+	query @_ @Symbol (toQuery $ mconcat [
+		qSymbol,
+		from_ ["projects_modules_scope as pms", "modules as srcm", "exports as e"],
+		where_ [
 			"pms.cabal is srcm.cabal",
 			"srcm.file == ?",
 			"pms.module_id == e.module_id",
 			"m.id == s.module_id",
 			"s.id == e.symbol_id",
-			"s.name == ?"])
+			"s.name == ?"]])
 		(fpath ^. path, nm)
 runCommand (Whois nm fpath) = toValue $ do
 	let
 		q = nameModule $ toName nm
 		ident = nameIdent $ toName nm
-	query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
-		["modules as srcm", "scopes as sc"]
-		[
+	query @_ @Symbol (toQuery $ mconcat [
+		qSymbol,
+		from_ ["modules as srcm", "scopes as sc"],
+		where_ [
 			"srcm.id == sc.module_id",
 			"s.id == sc.symbol_id",
 			"srcm.file == ?",
 			"sc.qualifier is ?",
-			"sc.name == ?"])
+			"sc.name == ?"]])
 		(fpath ^. path, q, ident)
 runCommand (Whoat l c fpath) = toValue $ do
-	rs <- query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
-		["names as n", "modules as srcm"]
-		[
+	rs <- query @_ @Symbol (toQuery $ mconcat [
+		qSymbol,
+		from_ ["names as n", "modules as srcm"],
+		where_ [
 			"srcm.id == n.module_id",
 			"m.name == n.resolved_module",
 			"s.name == n.resolved_name",
+			"s.what == n.resolved_what",
 			"s.id == n.symbol_id",
 			"srcm.file == ?",
-			"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)"])
+			"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)"]])
 		(fpath ^. path, l, c)
 	locals <- do
-		defs <- query @_ @(ModuleId :. (Text, Int, Int, Maybe Text)) (toQuery $ qModuleId `mappend` select_
-			["n.name", "n.def_line", "n.def_column", "n.inferred_type"]
-			["names as n"]
-			[
+		defs <- query @_ @(ModuleId :. (Text, Int, Int, Maybe Text)) (toQuery $ mconcat [
+			qModuleId,
+			select_ ["n.name", "n.def_line", "n.def_column", "n.inferred_type"],
+			from_ ["names as n"],
+			where_ [
 				"mu.id == n.module_id",
 				"n.def_line is not null",
 				"n.def_column is not null",
 				"mu.file == ?",
-				"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)"])
+				"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)"]])
 			(fpath ^. path, l, c)
 		return [
 			Symbol {
@@ -263,84 +287,93 @@ 		(Only $ fpath ^. path)
 	case pids of
 		[] -> hsdevError $ OtherError $ "module at {} not found" ~~ fpath
-		[Only proj] -> query @_ @ModuleId (toQuery $ qModuleId `mappend` select_ []
-			["projects_modules_scope as msc"]
-			[
+		[Only proj] -> query @_ @ModuleId (toQuery $ mconcat [
+			qModuleId,
+			from_ ["projects_modules_scope as msc"],
+			where_ [
 				"msc.module_id == mu.id",
 				"msc.cabal is ?",
-				"mu.name like ? escape '\\'"])
+				"mu.name like ? escape '\\'"]])
 			(proj, likePattern sq)
 		_ -> fail "Impossible happened: several projects for one module"
 runCommand (ResolveScope sq fpath) = toValue $
-	query @_ @(Scoped SymbolId) (toQuery $ qSymbolId `mappend` select_ ["sc.qualifier"]
-		["scopes as sc", "modules as srcm"]
-		[
+	query @_ @(Scoped SymbolId) (toQuery $ mconcat [
+		qSymbolId,
+		select_ ["sc.qualifier"],
+		from_ ["scopes as sc", "modules as srcm"],
+		where_ [
 			"srcm.id == sc.module_id",
 			"sc.symbol_id == s.id",
 			"srcm.file == ?",
-			"s.name like ? escape '\\'"])
+			"s.name like ? escape '\\'"]])
 		(fpath ^. path, likePattern sq)
 runCommand (FindUsages l c fpath) = toValue $ do
 	us <- do
-		sids <- query @_ @(Only (Maybe Int)) (toQuery $ select_
-			["n.symbol_id"]
-			["names as n", "modules as srcm"]
-			[
+		sids <- query @_ @(Only (Maybe Int)) (toQuery $ mconcat [
+			select_ ["n.symbol_id"],
+			from_ ["names as n", "modules as srcm"],
+			where_ [
 				"n.module_id == srcm.id",
 				"(?, ?) between (n.line, n.column) and (n.line_to, n.column_to)",
-				"srcm.file = ?"])
+				"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"]
-			[
+		query @_ @SymbolUsage (toQuery $ mconcat [
+			qSymbol,
+			select_ ["n.qualifier"],
+			qModuleId,
+			select_ ["n.line", "n.column", "n.line_to", "n.column_to"],
+			from_ ["names as n"],
+			where_ [
 				"n.symbol_id == ?",
 				"s.id == n.symbol_id",
-				"mu.id == n.module_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"]
-			["names as n", "names as defn"]
-			[
+		defs <- query @_ @(ModuleId :. Only Text :. Position :. Only (Maybe Text) :. Region) (toQuery $ mconcat [
+			qModuleId,
+			select_ ["n.name", "n.def_line", "n.def_column", "n.inferred_type", "n.line", "n.column", "n.line_to", "n.column_to"],
+			from_ ["names as n", "names as defn"],
+			where_ [
 				"n.module_id = mu.id",
 				"n.def_line = defn.def_line",
 				"n.def_column = defn.def_column",
 				"defn.module_id = mu.id",
 				"(?, ?) between (defn.line, defn.column) and (defn.line_to, defn.column_to)",
-				"mu.file = ?"])
+				"mu.file = ?"]])
 			(l, c, fpath ^. path)
 		return $ do
-			(mid :. Only nm :. defPos :. Only ftype :. usePos) <- defs
+			(mid :. Only nm :. defPos :. Only ftype :. useRgn) <- defs
 			let
 				sym = Symbol {
 					_symbolId = SymbolId nm mid,
 					_symbolDocs = Nothing,
 					_symbolPosition = Just defPos,
 					_symbolInfo = Function ftype }
-			return $ SymbolUsage sym mid usePos
+			return $ SymbolUsage sym Nothing mid useRgn
 	return $ us ++ locals
 runCommand (Complete input True fpath) = toValue $
-	query @_ @Symbol (toQuery $ qSymbol `mappend` select_ []
-		["modules as srcm", "exports as e"]
-		[
+	query @_ @Symbol (toQuery $ mconcat [
+		qSymbol,
+		from_ ["modules as srcm", "exports as e"],
+		where_ [
 			"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 '\\'"])
+			"s.name like ? escape '\\'"]])
 		(fpath ^. path, likePattern (SearchQuery input SearchPrefix))
 runCommand (Complete input False fpath) = toValue $
-	query @_ @(Scoped Symbol) (toQuery $ qSymbol `mappend` select_
-		["c.qualifier"]
-		["completions as c", "modules as srcm"]
-		[
+	query @_ @(Scoped Symbol) (toQuery $ mconcat [
+		qSymbol,
+		select_ ["c.qualifier"],
+		from_ ["completions as c", "modules as srcm"],
+		where_ [
 			"c.module_id == srcm.id",
 			"c.symbol_id == s.id",
 			"srcm.file == ?",
-			"c.completion like ? escape '\\'"])
+			"c.completion like ? escape '\\'"]])
 		(fpath ^. path, likePattern (SearchQuery input SearchPrefix))
 runCommand (Hayoo hq p ps) = toValue $ liftM concat $ forM [p .. p + pred ps] $ \i -> liftM
 	(mapMaybe Hayoo.hayooAsSymbol . Hayoo.resultResult) $
@@ -357,28 +390,11 @@ runCommand (Lint fs) = toValue $ liftM concat $ forM fs $ \fsrc -> do
 	FileSource f c <- actualFileContents fsrc
 	liftIO $ hsdevLift $ HLint.hlint (view path f) c
-runCommand (Check fs ghcs' clear) = toValue $ Log.scope "check" $ do
-	let
-		checkSome file fn = Log.scope "checkSome" $ do
-			Log.sendLog Log.Trace $ "setting file source session for {}" ~~ file
-			m <- setFileSourceSession ghcs' file
-			Log.sendLog Log.Trace $ "file source session set"
-			inSessionGhc $ do
-				when clear $ clearTargets
-				fn m
-	fs' <- mapM actualFileContents fs
-	liftM concat $ mapM (\(FileSource f c) -> checkSome f (\m -> Check.check m c)) fs'
+runCommand (Check fs ghcs' clear) = toValue $ Log.scope "check" $
+	liftM concat $ mapM (runCheck ghcs' clear) fs
 runCommand (CheckLint fs ghcs' clear) = toValue $ do
-	let
-		checkSome file fn = Log.scope "checkSome" $ do
-			Log.sendLog Log.Trace $ "setting file source session for {}" ~~ file
-			m <- setFileSourceSession ghcs' file
-			Log.sendLog Log.Trace $ "file source session set"
-			inSessionGhc $ do
-				when clear $ clearTargets
-				fn m
 	fs' <- mapM actualFileContents fs
-	checkMsgs <- liftM concat $ mapM (\(FileSource f c) -> checkSome f (\m -> Check.check m c)) fs'
+	checkMsgs <- liftM concat $ mapM (runCheck ghcs' clear) fs'
 	lintMsgs <- liftIO $ hsdevLift $ liftM concat $ mapM (\(FileSource f c) -> HLint.hlint (view path f) c) fs'
 	return $ checkMsgs ++ lintMsgs
 runCommand (Types fs ghcs' clear) = toValue $ do
@@ -391,7 +407,11 @@ 		getCached _ (Just _) = return Nothing
 		getCached file' Nothing = do
 			actual' <- sourceUpToDate file'
-			mid <- query @_ @((Bool, Int) :. ModuleId) (toQuery $ select_ ["json_extract(tags, '$.types') is 1", "mu.id"] [] [] `mappend` qModuleId `mappend` where_ ["mu.file = ?"])
+			mid <- query @_ @((Bool, Int) :. ModuleId)
+				(toQuery $ mconcat [
+					select_ ["json_extract(tags, '$.types') is 1", "mu.id"],
+					qModuleId,
+					where_ ["mu.file = ?"]])
 				(Only file')
 			when (length mid > 1) $ Log.sendLog Log.Warning $ "multiple modules with same file = {}" ~~ file'
 			when (null mid) $ hsdevError $ NotInspected $ FileModule file' Nothing
@@ -408,10 +428,12 @@ 				else return Nothing
 
 		updateTypes file msrc = do
+			sess <- getSession
 			m <- setFileSourceSession ghcs' file
 			types' <- inSessionGhc $ do
-				when clear $ clearTargets
-				Types.fileTypes m msrc
+				when clear clearTargets
+				Update.cacheGhcWarnings sess [m ^. moduleId . moduleLocation] $
+					Types.fileTypes m msrc
 			updateProcess def [Update.setModTypes (m ^. moduleId) types']
 			return $ set (each . Tools.note . Types.typedExpr) Nothing types'
 runCommand (AutoFix ns) = toValue $ return $ AutoFix.corrections ns
@@ -419,7 +441,7 @@ 	files <- liftM (ordNub . sort) $ mapM findPath $ mapMaybe (preview $ Tools.noteSource . moduleFile) ns
 	let
 		runFix file = do
-			when (not isPure) $ do
+			unless isPure $ do
 				liftIO $ readFileUtf8 (view path file) >>= writeFileUtf8 (view path file) . AutoFix.refact fixRefacts'
 			return newCorrs'
 			where
@@ -456,24 +478,22 @@ 
 	return $ defRenames ++ usageRenames
 runCommand (GhcEval exprs mfile) = toValue $ do
-	ghcw <- askSession sessionGhc
 	mfile' <- traverse actualFileContents mfile
 	case mfile' of
 		Nothing -> inSessionGhc ghciSession
 		Just (FileSource f mcts) -> do
 			m <- setFileSourceSession [] f
 			inSessionGhc $ interpretModule m mcts
-	async' <- liftIO $ sendTask ghcw $ do
-		mapM (try . evaluate) exprs
-	res <- waitAsync async'
-	return $ map toValue' res
-	where
-		waitAsync :: CommandMonad m => Async a -> m a
-		waitAsync a = liftIO (waitCatch a) >>= either (hsdevError . GhcError . displayException) return
-		toValue' :: ToJSON a => Either SomeException a -> Value
-		toValue' (Left (SomeException e)) = object ["fail" .= show e]
-		toValue' (Right s) = toJSON s
-runCommand Langs = toValue $ return $ Compat.languages
+	inSessionGhc $ mapM (tryRepl . evaluate) exprs
+runCommand (GhcType exprs mfile) = toValue $ do
+	mfile' <- traverse actualFileContents mfile
+	case mfile' of
+		Nothing -> inSessionGhc ghciSession
+		Just (FileSource f mcts) -> do
+			m <- setFileSourceSession [] f
+			inSessionGhc $ interpretModule m mcts
+	inSessionGhc $ mapM (tryRepl . expressionType) exprs
+runCommand Langs = toValue $ return Compat.languages
 runCommand Flags = toValue $ return ["-f" ++ prefix ++ f |
 	f <- Compat.flags,
 	prefix <- ["", "no-"]]
@@ -486,6 +506,7 @@ 			deleteSession $ view sessionKey s
 runCommand Exit = toValue serverExit
 
+
 targetFilter :: Text -> Maybe Text -> TargetFilter -> (Text, [NamedParam])
 targetFilter mtable _ (TargetProject proj) = (
 	"{t}.cabal in (select cabal from projects where name == :project or cabal == :project)" ~~ ("t" ~% mtable),
@@ -539,6 +560,27 @@ 		(read <$> (v .:: "scope")) <*>
 		(v .:: "text")
 
+
+-- | Run check
+runCheck :: CommandMonad m => [String] -> Bool -> FileSource -> m [Tools.Note Tools.OutputMessage]
+runCheck ghcs' clear = actualFileContents >=> check' where
+	check' (FileSource file mcts) = Log.scope "run-check" $ do
+		Log.sendLog Log.Trace $ "setting file source session for {}" ~~ file
+		sess <- getSession
+		m <- setFileSourceSession ghcs' file
+		Log.sendLog Log.Trace "file source session set"
+		ns <- inSessionGhc $ do
+			when clear clearTargets
+			Update.cacheGhcWarnings sess [m ^. moduleId . moduleLocation] $
+				Check.check m mcts
+		if null ns
+			then do
+				ns' <- Update.cachedWarnings [m ^. moduleId . moduleLocation]
+				when (not $ null ns') $
+					Log.sendLog Log.Trace $ "returning {} cached warnings for {}" ~~ length ns' ~~ file
+				return ns'
+			else return ns
+
 -- Helper functions
 
 -- | Canonicalize paths
@@ -597,8 +639,10 @@ 						else do
 							defs <- askSession sessionDefines
 							mcts <- fmap (fmap snd) $ getFileContents fpath'
-							p' <- liftIO $ preload (m ^. moduleId . moduleName) defs [] (m ^. moduleId . moduleLocation) mcts
-							return $ set moduleImports (p' ^. asModule . moduleImports) m
+							ip' <- runInspect (m ^. moduleId . moduleLocation) $ preload (m ^. moduleId . moduleName) defs [] mcts
+							case ip' ^? inspected of
+								Just p' -> return $ set moduleImports (p' ^. asModule . moduleImports) m
+								Nothing -> return m
 				Just cabal' -> do
 					proj' <- SQLite.loadProject cabal'
 					return $ set (moduleId . moduleLocation . moduleProject) (Just proj') m

@@ -18,7 +18,10 @@ 	loadModule, loadModules,
 	loadProject,
 
+	updateModules,
+
 	-- * Utils
+	lookupId,
 	escapeLike,
 
 	-- * Reexports
@@ -36,6 +39,7 @@ import Data.Generics.Uniplate.Operations
 import Data.List (intercalate)
 import Data.Maybe
+import qualified Data.Map as M
 import Data.String
 import qualified Data.Set as S
 import Data.Text (Text)
@@ -60,6 +64,7 @@ import HsDev.PackageDb.Types
 import HsDev.Project.Types
 import HsDev.Symbols.Name
+import qualified HsDev.Symbols.HaskellNames as HN
 import HsDev.Symbols.Parsed
 import HsDev.Symbols.Types hiding (loadProject)
 import qualified HsDev.Symbols.Parsed as P
@@ -67,11 +72,19 @@ import HsDev.Server.Types
 import HsDev.Util
 
+-- | Open new connection and set some pragmas
+new :: String -> IO Connection
+new p = do
+	conn <- open p
+	SQL.execute_ conn "pragma case_sensitive_like = true;"
+	SQL.execute_ conn "pragma synchronous = off;"
+	SQL.execute_ conn "pragma journal_mode = memory;"
+	return conn
+
 -- | Initialize database
 initialize :: String -> IO Connection
 initialize p = do
-	conn <- open p
-	SQL.execute_ conn "pragma case_sensitive_like = true;"
+	conn <- new p
 	[Only hasTables] <- SQL.query_ conn "select count(*) > 0 from sqlite_master where type == 'table';"
 	goodVersion <- if hasTables
 		then do
@@ -83,7 +96,7 @@ 			| not goodVersion = do
 					close conn
 					removeFile p
-					conn' <- open p
+					conn' <- new p
 					initDb conn'
 			| not hasTables = initDb conn
 			| otherwise = return conn
@@ -152,7 +165,7 @@ 	dropTable = execute_ $ fromString $ "drop table {};" ~~ tableName
 
 updatePackageDb :: SessionMonad m => PackageDb -> [ModulePackage] -> m ()
-updatePackageDb pdb pkgs = scope "update-package-db" $ do
+updatePackageDb pdb pkgs = scope "update-package-db" $ transaction_ Immediate $ do
 	sendLog Trace $ "update package-db: {}" ~~ Display.display pdb
 	removePackageDb pdb
 	insertPackageDb pdb pkgs
@@ -167,11 +180,11 @@ 		"insert into package_dbs (package_db, package_name, package_version) values (?, ?, ?);"
 		(pdb, pkg ^. packageName, pkg ^. packageVersion)
 
-updateProject :: SessionMonad m => Project -> Maybe PackageDbStack -> m ()
-updateProject proj pdbs = scope "update-project" $ do
+updateProject :: SessionMonad m => Project -> m ()
+updateProject proj = scope "update-project" $ transaction_ Immediate $ do
 	sendLog Trace $ "update project: {}" ~~ Display.display proj
 	removeProject proj
-	insertProject proj pdbs
+	insertProject proj
 
 removeProject :: SessionMonad m => Project -> m ()
 removeProject proj = scope "remove-project" $ do
@@ -189,13 +202,9 @@ 				execute "delete from tests where project_id == ?;" pid
 				forM_ bids $ \bid -> execute "delete from build_infos where id == ?;" bid
 
-insertProject :: SessionMonad m => Project -> Maybe PackageDbStack -> m ()
-insertProject proj pdbs = scope "insert-project" $ do
-	execute "insert into projects (name, cabal, version, package_db_stack) values (?, ?, ?, ?);" (
-		proj ^. projectName,
-		proj ^. projectCabal . path,
-		proj ^? projectDescription . _Just . projectVersion,
-		fmap (encode . packageDbs) pdbs)
+insertProject :: SessionMonad m => Project -> m ()
+insertProject proj = scope "insert-project" $ do
+	execute "insert into projects (name, cabal, version, package_db_stack) values (?, ?, ?, ?);" proj
 	projId <- lastRow
 
 	forM_ (proj ^? projectDescription . _Just . projectLibrary . _Just) $ \lib -> do
@@ -230,12 +239,13 @@ 	insertModuleSymbols im
 
 removeModuleContents :: SessionMonad m => Int -> m ()
-removeModuleContents mid = do
+removeModuleContents mid = scope "remove-module-contents" $ do
 	execute "delete from imports where module_id == ?;" (Only mid)
 	execute "delete from exports where module_id == ?;" (Only mid)
 	execute "delete from scopes where module_id == ?;" (Only mid)
 	execute "delete from names where module_id == ?;" (Only mid)
 	execute "delete from types where module_id == ?;" (Only mid)
+	execute "delete from symbols where module_id = ?;" (Only mid)
 
 removeModule :: SessionMonad m => Int -> m ()
 removeModule mid = scope "remove-module" $ do
@@ -285,7 +295,7 @@ 	removeModuleContents mid
 	insertModuleImports mid
 	insertExportSymbols mid (im ^.. inspected . moduleExports . each)
-	insertScopeSymbols mid (im ^.. inspected . scopeSymbols)
+	insertScopeSymbols mid (M.toList (im ^. inspected . moduleScope))
 	maybe (return ()) (insertResolvedNames mid) (im ^? inspected . moduleSource . _Just)
 	where
 		insertModuleImports :: SessionMonad m => Int -> m ()
@@ -305,6 +315,9 @@ 							fmap makeImportList specList)
 					executeMany "insert into imports (module_id, line, module_name, qualified, alias, hiding, import_list) values (?, ?, ?, ?, ?, ?, ?);"
 						(map importRow imps)
+					executeNamed "update imports set import_module_id = (select im.id from modules as im, projects_modules_scope as ps where ((ps.cabal is null and :cabal is null) or (ps.cabal == :cabal)) and ps.module_id == im.id and im.name == imports.module_name) where module_id == :module_id;" [
+					 ":cabal" := im ^? inspectedKey . moduleProject . _Just . projectCabal,
+					 ":module_id" := mid]
 			where
 				getModuleName (ModuleName _ s) = s
 				getHiding (ImportSpecList _ h _) = h
@@ -328,17 +341,15 @@ 		insertExportSymbols _ [] = return ()
 		insertExportSymbols mid syms = scope "insert-export-symbols" $ withTemporaryTable "export_symbols" (symbolsColumns ++ idColumns) $ do
 			dumpSymbols "export_symbols" symbolsColumns syms
-			updateExistingSymbols "export_symbols"
 			insertMissingModules "export_symbols"
 			insertMissingSymbols "export_symbols"
 			execute "insert into exports (module_id, symbol_id) select ?, symbol_id from export_symbols;" (Only mid)
 
-		insertScopeSymbols :: SessionMonad m => Int -> [(Symbol, [Name])] -> m ()
+		insertScopeSymbols :: SessionMonad m => Int -> [(Name, [Symbol])] -> m ()
 		insertScopeSymbols _ [] = return ()
 		insertScopeSymbols mid snames = scope "insert-scope-symbols" $ withTemporaryTable "scope_symbols" (symbolsColumns ++ scopeNameColumns ++ idColumns) $ do
 			dumpSymbols "scope_symbols" (symbolsColumns ++ scopeNameColumns)
-				[(s :. (Name.nameModule nm, Name.nameIdent nm)) | (s, nms) <- snames, nm <- nms]
-			updateExistingSymbols "scope_symbols"
+				[(s :. (Name.nameModule nm, Name.nameIdent nm)) | (nm, syms) <- snames, s <- syms]
 			insertMissingModules "scope_symbols"
 			insertMissingSymbols "scope_symbols"
 			execute "insert into scopes (module_id, qualifier, name, symbol_id) select ?, qualifier, ident, symbol_id from scope_symbols;" (Only mid)
@@ -351,8 +362,8 @@ 			where
 				insertNames = executeMany insertQuery namesData
 				replaceQNames = executeMany insertQuery qnamesData
-				setResolvedSymbolIds = execute "update names set symbol_id = (select sc.symbol_id from scopes as sc, symbols as s, modules as m 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 and s.id == sc.symbol_id and m.id == s.module_id and s.name == names.resolved_name and m.name == names.resolved_module) 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 (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
+				setResolvedSymbolIds = execute "update names set symbol_id = (select sc.symbol_id from scopes as sc, symbols as s, modules as m 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 and s.id == sc.symbol_id and m.id == s.module_id and s.name == names.resolved_name and s.what == names.resolved_what and m.name == names.resolved_module) where module_id == ? and resolved_module is not null and resolved_name is not null and resolved_what 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, resolved_what, resolve_error) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
 				namesData = map toData $ p ^.. P.names
 				qnamesData = map toQData $ p ^.. P.qnames
 				toData name = (
@@ -368,6 +379,7 @@ 					name ^? P.defPos . positionColumn,
 					(name ^? P.resolvedName) >>= Name.nameModule,
 					Name.nameIdent <$> (name ^? P.resolvedName),
+					fmap (symbolType . HN.fromSymbol) $ name ^? P.symbolL,
 					P.resolveError name)
 				toQData qname = (
 					mid,
@@ -382,6 +394,7 @@ 					qname ^? P.defPos . positionColumn,
 					(qname ^? P.resolvedName) >>= Name.nameModule,
 					Name.nameIdent <$> (qname ^? P.resolvedName),
+					fmap (symbolType . HN.fromSymbol) $ qname ^? P.symbolL,
 					P.resolveError qname)
 
 		symbolsColumns :: [String]
@@ -406,16 +419,12 @@ 			updateSymbolIds tableName
 
 		updateModuleIds :: SessionMonad m => String -> m ()
-		updateModuleIds tableName =
-			execute_ (fromString ("update {table} set module_id = (select m.id from modules as m where ((m.name is null and {table}.module_name is null) or m.name = {table}.module_name) and ((m.file is null and {table}.file is null) or m.file = {table}.file) and ((m.package_name is null and {table}.package_name is null) or m.package_name = {table}.package_name) and ((m.package_version is null and {table}.package_version is null) or m.package_version = {table}.package_version) and ((m.installed_name is null and {table}.installed_name is null) or m.installed_name = {table}.installed_name) and ((m.other_location is null and {table}.other_location is null) or m.other_location = {table}.other_location));" ~~ ("table" ~% tableName)))
+		updateModuleIds tableName = scope "update-module-ids" $
+			execute_ (fromString ("update {table} set module_id = (select m.id from modules as m where (m.file = {table}.file) or (m.package_name = {table}.package_name and m.package_version = {table}.package_version and m.installed_name = {table}.installed_name) or (m.other_location = {table}.other_location)) where module_id is null;" ~~ ("table" ~% tableName)))
 
 		updateSymbolIds :: SessionMonad m => String -> m ()
-		updateSymbolIds tableName =
-			execute_ (fromString ("update {table} set symbol_id = (select s.id from symbols as s where s.name = {table}.name and s.module_id = {table}.module_id);" ~~ ("table" ~% tableName)))
-
-		updateExistingSymbols :: SessionMonad m => String -> m ()
-		updateExistingSymbols tableName = scope "update-existing-symbols" $ do
-			execute_ (fromString ("replace into symbols (id, name, module_id, docs, line, column, what, type, parent, constructors, args, context, associate, pat_type, pat_constructor) select symbols.id, {table}.name, {table}.module_id, {table}.docs, {table}.line, {table}.column, {table}.what, {table}.type, {table}.parent, {table}.constructors, {table}.args, {table}.context, {table}.associate, {table}.pat_type, {table}.pat_constructor from {table} inner join symbols on (symbols.name == {table}.name) and (symbols.module_id == {table}.module_id);" ~~ ("table" ~% tableName)))
+		updateSymbolIds tableName = scope "update-symbol-ids" $
+			execute_ (fromString ("update {table} set symbol_id = (select s.id from symbols as s where s.name = {table}.name and s.what = {table}.what and s.module_id = {table}.module_id) where symbol_id is null;" ~~ ("table" ~% tableName)))
 
 		insertMissingModules :: SessionMonad m => String -> m ()
 		insertMissingModules tableName = scope "insert-missing-modules" $ do
@@ -429,7 +438,7 @@ 
 lookupModuleLocation :: SessionMonad m => ModuleLocation -> m (Maybe Int)
 lookupModuleLocation m = do
-	mids <- queryNamed "select id from modules where ((file is null and :file is null) or file = :file) and ((package_name is null and :package_name is null) or package_name = :package_name) and ((package_version is null and :package_version is null) or package_version = :package_version) and ((installed_name is null and :installed_name is null) or installed_name = :installed_name) and ((other_location is null and :other_location is null) or other_location = :other_location);" [
+	mids <- queryNamed "select id from modules where (file = :file) or (package_name = :package_name and package_version = :package_version and installed_name = :installed_name) or (other_location = :other_location);" [
 		":file" := m ^? moduleFile . path,
 		":package_name" := m ^? modulePackage . packageName,
 		":package_version" := m ^? modulePackage . packageVersion,
@@ -440,7 +449,7 @@ 
 lookupModule :: SessionMonad m => ModuleId -> m (Maybe Int)
 lookupModule m = do
-	mids <- queryNamed "select id from modules where ((name is null and :name is null) or name = :name) and ((file is null and :file is null) or file = :file) and ((package_name is null and :package_name is null) or package_name = :package_name) and ((package_version is null and :package_version is null) or package_version = :package_version) and ((installed_name is null and :installed_name is null) or installed_name = :installed_name) and ((other_location is null and :other_location is null) or other_location = :other_location);" [
+	mids <- queryNamed "select id from modules where ((name is null and :name is null) or name = :name) and ((file = :file) or (package_name = :package_name and package_version = :package_version and installed_name = :installed_name) or (other_location = :other_location));" [
 		":name" := m ^. moduleName,
 		":file" := m ^? moduleLocation . moduleFile . path,
 		":package_name" := m ^? moduleLocation . modulePackage . packageName,
@@ -465,12 +474,22 @@ 
 loadModule :: SessionMonad m => Int -> m Module
 loadModule mid = scope "load-module" $ do
-	ms <- query @_ @(ModuleId :. (Maybe Text, Maybe Value, Int)) (toQuery (qModuleId `mappend` select_ ["mu.docs", "mu.fixities", "mu.id"] [] [fromString "mu.id == ?"])) (Only mid)
+	ms <- query @_ @(ModuleId :. (Maybe Text, Maybe Value, Int))
+		(toQuery $ mconcat [
+			qModuleId,
+			select_ ["mu.docs", "mu.fixities", "mu.id"],
+			where_ [fromString "mu.id == ?"]])
+		(Only mid)
 	case ms of
 		[] -> sqlFailure $ "module with id {} not found" ~~ mid
 		mods@((mid' :. (mdocs, mfixities, _)):_) -> do
 			when (length mods > 1) $ sendLog Warning $ "multiple modules with same id = {} found" ~~ mid
-			syms <- query @_ @Symbol (toQuery (qSymbol `mappend` select_ [] ["exports as e"] ["e.module_id == ?", "e.symbol_id == s.id"])) (Only mid)
+			syms <- query @_ @Symbol
+				(toQuery $ mconcat [
+					qSymbol,
+					from_ ["exports as e"],
+					where_ ["e.module_id == ?", "e.symbol_id == s.id"]])
+				(Only mid)
 			inames <- query @_ @(Only Text) "select distinct module_name from imports where module_id == ?;" (Only mid)
 			return $ Module {
 				_moduleId = mid',
@@ -483,9 +502,19 @@ 
 loadModules :: (SessionMonad m, ToRow q) => String -> q -> m [Module]
 loadModules selectExpr args = scope "load-modules" $ do
-	ms <- query @_ @(ModuleId :. (Maybe Text, Maybe Value, Int)) (toQuery (qModuleId `mappend` select_ ["mu.docs", "mu.fixities", "mu.id"] [] [fromString $ "mu.id in (" ++ selectExpr ++ ")"])) args
+	ms <- query @_ @(ModuleId :. (Maybe Text, Maybe Value, Int))
+		(toQuery $ mconcat [
+			qModuleId,
+			select_ ["mu.docs", "mu.fixities", "mu.id"],
+			where_ [fromString $ "mu.id in (" ++ selectExpr ++ ")"]])
+		args
 	forM ms $ \(mid' :. (mdocs, mfixities, mid)) -> do
-		syms <- query @_ @Symbol (toQuery (qSymbol `mappend` select_ [] ["exports as e"] ["e.module_id == ?", "e.symbol_id == s.id"])) (Only mid)
+		syms <- query @_ @Symbol
+			(toQuery $ mconcat [
+				qSymbol,
+				from_ ["exports as e"],
+				where_ ["e.module_id == ?", "e.symbol_id == s.id"]])
+			(Only mid)
 		inames <- query @_ @(Only Text) "select distinct module_name from imports where module_id == ?;" (Only mid)
 		return $ Module {
 			_moduleId = mid',
@@ -498,26 +527,41 @@ 
 loadProject :: SessionMonad m => Path -> m Project
 loadProject cabal = scope "load-project" $ do
-	projs <- query @_ @(Only Int :. Project) "select id, name, cabal, version from projects where cabal == ?;" (Only $ view path cabal)
+	projs <- query @_ @(Only Int :. Project) "select id, name, cabal, version, package_db_stack from projects where cabal == ?;" (Only $ view path cabal)
 	(Only pid :. proj) <- case projs of
 		[] -> sqlFailure $ "project with cabal {} not found" ~~ view path cabal
 		_ -> do
 			when (length projs > 1) $ sendLog Warning $ "multiple projects with same cabal = {} found" ~~ view path cabal
 			return $ head projs
 
-	libs <- query (toQuery $ select_ ["lib.modules"] ["libraries as lib"] [] `mappend` qBuildInfo `mappend` where_ [
-		"lib.build_info_id == bi.id",
-		"lib.project_id == ?"])
+	libs <- query
+		(toQuery $ mconcat [
+			select_ ["lib.modules"],
+			from_ ["libraries as lib"],
+			qBuildInfo,
+			where_ [
+				"lib.build_info_id == bi.id",
+				"lib.project_id == ?"]])
 			(Only pid)
 
-	exes <- query (toQuery $ select_ ["exe.name", "exe.path"] ["executables as exe"] [] `mappend` qBuildInfo `mappend` where_ [
-		"exe.build_info_id == bi.id",
-		"exe.project_id == ?"])
+	exes <- query
+		(toQuery $ mconcat [
+			select_ ["exe.name", "exe.path"],
+			from_ ["executables as exe"],
+			qBuildInfo,
+			where_ [
+				"exe.build_info_id == bi.id",
+				"exe.project_id == ?"]])
 			(Only pid)
 
-	tests <- query (toQuery $ select_ ["tst.name", "tst.enabled", "tst.main"] ["tests as tst"] [] `mappend` qBuildInfo `mappend` where_ [
-		"tst.build_info_id == bi.id",
-		"tst.project_id == ?"])
+	tests <- query
+		(toQuery $ mconcat [
+			select_ ["tst.name", "tst.enabled", "tst.main"],
+			from_ ["tests as tst"],
+			qBuildInfo,
+			where_ [
+				"tst.build_info_id == bi.id",
+				"tst.project_id == ?"]])
 			(Only pid)
 
 	return $
@@ -526,6 +570,54 @@ 		set (projectDescription . _Just . projectTests) tests $
 		proj
 
+-- | Update a bunch of modules
+updateModules :: SessionMonad m => [InspectedModule] -> m ()
+updateModules ims = scope "update-modules" $ transaction_ Immediate $ do
+	mapM_ (upsertModule >=> removeModuleContents) ims
+	insertModulesSymbols ims
+
+-- | Update symbols of bunch of modules
+insertModulesSymbols :: SessionMonad m => [InspectedModule] -> m ()
+insertModulesSymbols ims = scope "update-modules" $ timer "updated modules" $ do
+	ids <- mapM lookupId (ims ^.. each . inspectedKey)
+	let
+		imods = zip ids ims
+
+	insertModulesDefs imods
+	insertModulesExports imods
+	where
+		insertModulesDefs :: SessionMonad m => [(Int, InspectedModule)] -> m ()
+		insertModulesDefs imods = executeMany "insert into symbols (name, module_id, docs, line, column, what, type, parent, constructors, args, context, associate, pat_type, pat_constructor) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" $ do
+			(mid, im) <- imods
+			m <- im ^.. inspected
+			sym <- m ^. moduleExports
+			guard (sym ^. symbolId . symbolModule == m ^. moduleId)
+			return $ (
+				sym ^. symbolId . symbolName,
+				mid,
+				sym ^. symbolDocs,
+				sym ^? symbolPosition . _Just . positionLine,
+				sym ^? symbolPosition . _Just . positionColumn)
+				:. (sym ^. symbolInfo)
+
+		insertModulesExports :: SessionMonad m => [(Int, InspectedModule)] -> m ()
+		insertModulesExports imods = executeMany "insert into exports (module_id, symbol_id) select ?, s.id from modules as m, symbols as s where ((? = m.file) or (? = m.package_name and ? = m.package_version and ? = m.installed_name) or (? = m.other_location)) and s.module_id = m.id and ? = s.name and ? = s.what;" $ do
+			(mid, im) <- imods
+			m <- im ^.. inspected
+			sym <- m ^. moduleExports
+			return $
+				(Only mid) :.
+				mkLocationId (sym ^. symbolId . symbolModule) :.
+				(sym ^. symbolId . symbolName, symbolType sym)
+
+		mkLocationId m' = (
+			m' ^? moduleLocation . moduleFile,
+			m' ^? moduleLocation . modulePackage . packageName,
+			m' ^? moduleLocation . modulePackage . packageVersion,
+			m' ^? moduleLocation . installedModuleName,
+			m' ^? moduleLocation . otherLocationName)
+
+
 escapeLike :: Text -> Text
 escapeLike = T.replace "\\" "\\\\" . T.replace "%" "\\%" . T.replace "_" "\\_"
 
@@ -535,3 +627,7 @@ sqlFailure msg = do
 	sendLog Error msg
 	hsdevError $ SQLiteError $ T.unpack msg
+
+lookupId :: SessionMonad m => ModuleLocation -> m Int
+lookupId = lookupModuleLocation >=> maybe err return where
+	err = hsdevError $ SQLiteError "module not exist in db"

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Database.SQLite.Instances (
@@ -6,9 +6,10 @@ 	) where
 
 import Control.Lens ((^.), (^?), _Just)
-import Data.Aeson as A
+import Data.Aeson as A hiding (Error)
 import Data.Maybe
 import Data.Foldable
+import Data.Time.Clock.POSIX
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString.Lazy as L
@@ -16,12 +17,16 @@ import Database.SQLite.Simple.ToField
 import Database.SQLite.Simple.FromField
 import Language.Haskell.Extension
+import qualified Language.Haskell.Names as N
+import qualified Language.Haskell.Exts as H
 import Text.Format
 
 import System.Directory.Paths
+import HsDev.Symbols.Name
 import HsDev.Symbols.Location
 import HsDev.Symbols.Types
 import HsDev.Tools.Ghc.Types
+import HsDev.Tools.Types
 import HsDev.Util
 
 instance ToField Value where
@@ -101,56 +106,57 @@ instance ToRow SymbolId where
 	toRow (SymbolId nm mid) = toField nm : toRow mid
 
+instance FromRow SymbolInfo where
+	fromRow = do
+		what <- field @String
+		ty <- field
+		parent <- field
+		ctors <- field
+		args <- field
+		ctx <- field
+		assoc <- field
+		patTy <- field
+		patCtor <- field
+		maybe (fail $ "Can't parse symbol info: {}" ~~ show (what, ty, parent, ctors, args, ctx, assoc, patTy, patCtor)) return $ case what of
+			"function" -> return $ Function ty
+			"method" -> Method <$> pure ty <*> parent
+			"selector" -> Selector <$> pure ty <*> parent <*> (fromJSON' =<< ctors)
+			"ctor" -> Constructor <$> (fromJSON' =<< args) <*> parent
+			"type" -> Type <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
+			"newtype" -> NewType <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
+			"data" -> Data <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
+			"class" -> Class <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
+			"type-family" -> TypeFam <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx) <*> pure assoc
+			"data-family" -> DataFam <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx) <*> pure assoc
+			"pat-ctor" -> PatConstructor <$> (fromJSON' =<< args) <*> pure patTy
+			"pat-selector" -> PatSelector <$> pure ty <*> pure patTy <*> patCtor
+			_ -> Nothing
+
+instance ToRow SymbolInfo where
+	toRow si = [
+		toField $ symbolInfoType si,
+		toField $ si ^? functionType . _Just,
+		toField $ msum [si ^? parentClass, si ^? parentType],
+		toField $ toJSON $ si ^? selectorConstructors,
+		toField $ toJSON $ si ^? typeArgs,
+		toField $ toJSON $ si ^? typeContext,
+		toField $ si ^? familyAssociate . _Just,
+		toField $ si ^? patternType . _Just,
+		toField $ si ^? patternConstructor]
+
 instance FromRow Symbol where
-	fromRow = Symbol <$> fromRow <*> field <*> pos <*> infoP where
+	fromRow = Symbol <$> fromRow <*> field <*> pos <*> fromRow where
 		pos = do
 			line <- field
 			column <- field
 			return $ Position <$> line <*> column
-		infoP = do
-			what <- str' <$> field
-			ty <- field
-			parent <- field
-			ctors <- field
-			args <- field
-			ctx <- field
-			assoc <- field
-			patTy <- field
-			patCtor <- field
-			maybe (fail $ "Can't parse symbol info: {}" ~~ show (what, ty, parent, ctors, args, ctx, assoc, patTy, patCtor)) return $ case what of
-				"function" -> return $ Function ty
-				"method" -> Method <$> pure ty <*> parent
-				"selector" -> Selector <$> pure ty <*> parent <*> (fromJSON' =<< ctors)
-				"ctor" -> Constructor <$> (fromJSON' =<< args) <*> parent
-				"type" -> Type <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
-				"newtype" -> NewType <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
-				"data" -> Data <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
-				"class" -> Class <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx)
-				"type-family" -> TypeFam <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx) <*> pure assoc
-				"data-family" -> DataFam <$> (fromJSON' =<< args) <*> (fromJSON' =<< ctx) <*> pure assoc
-				"pat-ctor" -> PatConstructor <$> (fromJSON' =<< args) <*> pure patTy
-				"pat-selector" -> PatSelector <$> pure ty <*> pure patTy <*> patCtor
-				_ -> Nothing
-		str' :: String -> String
-		str' = id
 
 instance ToRow Symbol where
 	toRow sym = concat [
 		toRow (sym ^. symbolId),
 		[toField $ sym ^. symbolDocs],
 		maybe [SQLNull, SQLNull] toRow (sym ^. symbolPosition),
-		info]
-		where
-			info = [
-				toField $ symbolType sym,
-				toField $ sym ^? symbolInfo . functionType . _Just,
-				toField $ msum [sym ^? symbolInfo . parentClass, sym ^? symbolInfo . parentType],
-				toField $ toJSON $ sym ^? symbolInfo . selectorConstructors,
-				toField $ toJSON $ sym ^? symbolInfo . typeArgs,
-				toField $ toJSON $ sym ^? symbolInfo . typeContext,
-				toField $ sym ^? symbolInfo . familyAssociate . _Just,
-				toField $ sym ^? symbolInfo . patternType . _Just,
-				toField $ sym ^? symbolInfo . patternConstructor]
+		toRow (sym ^. symbolInfo)]
 
 instance FromRow a => FromRow (Scoped a) where
 	fromRow = flip Scoped <$> fromRow <*> field
@@ -158,12 +164,20 @@ instance ToRow a => ToRow (Scoped a) where
 	toRow (Scoped q s) = toRow s ++ [toField q]
 
+instance ToRow Project where
+	toRow (Project name _ cabal pdesc dbs) = [
+		toField name,
+		toField cabal,
+		toField $ pdesc ^? _Just . projectVersion,
+		toField dbs]
+
 instance FromRow Project where
 	fromRow = do
 		name <- field
 		cabal <- field
 		ver <- field
-		return $ Project name (takeDir cabal) cabal $ Just $ ProjectDescription ver Nothing [] []
+		dbs <- field
+		return $ Project name (takeDir cabal) cabal (fmap (\v -> ProjectDescription v Nothing [] []) ver) dbs
 
 instance FromRow Library where
 	fromRow = do
@@ -206,23 +220,35 @@ 				Just p' -> return $ PackageDb p'
 				Nothing -> fail $ "Can't parse package-db, invalid string: " ++ T.unpack s
 
+instance ToField PackageDbStack where
+	toField = toField . toJSON . packageDbs
+
+instance FromField PackageDbStack where
+	fromField = fromField >=> maybe (fail "Error parsing package-db-stack") (return . mkPackageDbStack) . fromJSON'
+
 instance FromRow SymbolUsage where
-	fromRow = SymbolUsage <$> fromRow <*> fromRow <*> fromRow
+	fromRow = SymbolUsage <$> fromRow <*> field <*> fromRow <*> fromRow
 
+instance FromField POSIXTime where
+	fromField = fmap (fromRational . toRational @Double) . fromField
+
+instance ToField POSIXTime where
+	toField = toField . fromRational @Double . toRational
+
 instance FromRow Inspection where
 	fromRow = do
 		tm <- field
 		opts <- field
 		case (tm, opts) of
 			(Nothing, Nothing) -> return InspectionNone
-			(_, Just opts') -> InspectionAt (maybe 0 (fromRational . (toRational :: Double -> Rational)) tm) <$>
+			(_, Just opts') -> InspectionAt (fromMaybe 0 tm) <$>
 				maybe (fail "Error parsing inspection opts") return (fromJSON' opts')
 			(Just _, Nothing) -> fail "Error parsing inspection data, time is set, but flags are null"
 
 instance ToRow Inspection where
 	toRow InspectionNone = [SQLNull, SQLNull]
 	toRow (InspectionAt tm opts) = [
-		if tm == 0 then SQLNull else toField (fromRational (toRational tm) :: Double),
+		if tm == 0 then SQLNull else toField tm,
 		toField $ toJSON opts]
 
 instance FromRow TypedExpr where
@@ -230,3 +256,94 @@ 
 instance ToRow TypedExpr where
 	toRow (TypedExpr e t) = [toField e, toField t]
+
+instance FromField (H.Name ()) where
+	fromField = fmap toName_ . fromField
+
+instance ToField (H.Name ()) where
+	toField = toField . fromName_
+
+instance FromField (H.ModuleName ()) where
+	fromField = fmap toModuleName_ . fromField
+
+instance ToField (H.ModuleName ()) where
+	toField = toField . fromModuleName_
+
+instance FromRow N.Symbol where
+	fromRow = do
+		what <- field @T.Text
+		mname <- field
+		name <- field
+		parent <- field
+		ctors <- do
+			ctorsJson <- field
+			return $ fmap (map toName_) (ctorsJson >>= fromJSON')
+		assoc <- field
+		patType <- field
+		patCtor <- field
+		let
+			m = toModuleName_ mname
+			n = toName_ name
+		maybe (fail $ "Can't parse symbol: {}" ~~ show (what, mname, name, parent, ctors, assoc, patType, patCtor)) return $ case what of
+			"function" -> return $ N.Value m n
+			"method" -> N.Method m n <$> parent
+			"selector" -> N.Selector m n <$> parent <*> ctors
+			"ctor" -> N.Constructor m n <$> parent
+			"type" -> return $ N.Type m n
+			"newtype" -> return $ N.NewType m n
+			"data" -> return $ N.Data m n
+			"class" -> return $ N.Class m n
+			"type-family" -> return $ N.TypeFam m n assoc
+			"data-family" -> return $ N.DataFam m n assoc
+			"pat-ctor" -> return $ N.PatternConstructor m n patType
+			"pat-selector" -> N.PatternSelector m n patType <$> patCtor
+			_ -> Nothing
+
+instance ToRow N.Symbol where
+	toRow = padNulls 8 . toRow' where
+		toRow' (N.Value m n) = mk "function" [toField m, toField n]
+		toRow' (N.Method m n p) = mk "method" [toField m, toField n, toField p]
+		toRow' (N.Selector m n p cs) = mk "selector" [toField m, toField n, toField p, toField $ toJSON (map fromName_ cs)]
+		toRow' (N.Constructor m n p) = mk "ctor" [toField m, toField n, toField p]
+		toRow' (N.Type m n) = mk "type" [toField m, toField n]
+		toRow' (N.NewType m n) = mk "newtype" [toField m, toField n]
+		toRow' (N.Data m n) = mk "data" [toField m, toField n]
+		toRow' (N.Class m n) = mk "class" [toField m, toField n]
+		toRow' (N.TypeFam m n assoc) = mk "type-family" [toField m, toField n, SQLNull, SQLNull, toField assoc]
+		toRow' (N.DataFam m n assoc) = mk "data-family" [toField m, toField n, SQLNull, SQLNull, toField assoc]
+		toRow' (N.PatternConstructor m n pty) = mk "pat-ctor" [toField m, toField n, SQLNull, SQLNull, SQLNull, toField pty]
+		toRow' (N.PatternSelector m n pty pctor) = mk "pat-selector" [toField m, toField n, SQLNull, SQLNull, SQLNull, toField pty, toField pctor]
+
+		mk :: T.Text -> [SQLData] -> [SQLData]
+		mk what = (toField what :)
+		padNulls n fs = fs ++ replicate (n - length fs) SQLNull
+
+instance FromField Severity where
+	fromField fld = do
+		s <- fromField @String fld
+		msum [
+			guard (s == "error") >> return Error,
+			guard (s == "warning") >> return Warning,
+			guard (s == "hint") >> return Hint,
+			fail ("Unknown severity: {}" ~~ s)]
+
+instance ToField Severity where
+	toField Error = toField @String "error"
+	toField Warning = toField @String "warning"
+	toField Hint = toField @String "hint"
+
+instance FromRow OutputMessage where
+	fromRow = OutputMessage <$> field <*> field
+
+instance ToRow OutputMessage where
+	toRow (OutputMessage msg suggest) = [toField msg, toField suggest]
+
+instance FromRow a => FromRow (Note a) where
+	fromRow = Note <$> (FileModule <$> field <*> pure Nothing) <*> fromRow <*> field <*> fromRow
+
+instance ToRow a => ToRow (Note a) where
+	toRow (Note mloc rgn sev n) = concat [
+		[toField $ mloc ^? moduleFile],
+		toRow rgn,
+		[toField sev],
+		toRow n]

@@ -5,8 +5,8 @@ 	) where
 
 import qualified Data.Text as T
-import Data.String
-import Database.SQLite.Simple (Query)
+import Data.List (unfoldr)
+import Database.SQLite.Simple (Query(..))
 
 import HsDev.Database.SQLite.Schema.TH
 
@@ -14,7 +14,12 @@ schema = T.pack $schemaExp
 
 commands :: [Query]
-commands =
-	map (fromString . T.unpack) $
-	filter (not . T.null) $
-	map T.strip $ T.splitOn ";" schema+commands = map (Query . T.unlines) . unfoldr takeStmt . T.lines $ schema where
+	takeStmt :: [T.Text] -> Maybe ([T.Text], [T.Text])
+	takeStmt ls = case break endsStmt ls of
+		(_, []) -> Nothing
+		(hs, t:ts) -> Just (hs ++ [t], ts)
+	comment :: T.Text -> Bool
+	comment t = "-- " `T.isPrefixOf` T.strip t
+	endsStmt :: T.Text -> Bool
+	endsStmt t = not (comment t) && ";" `T.isSuffixOf` T.strip t

@@ -1,8 +1,9 @@-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 
 module HsDev.Database.SQLite.Select (
-	Select(..), select_, where_, buildQuery, toQuery,
-	qSymbolId, qSymbol, qModuleLocation, qModuleId, qBuildInfo
+	Select(..), select_, from_, where_, buildQuery, toQuery,
+	qSymbolId, qSymbol, qModuleLocation, qModuleId, qBuildInfo,
+	qNSymbol, qNote
 	) where
 
 import Data.String
@@ -11,37 +12,40 @@ import Database.SQLite.Simple
 import Text.Format
 
-data Select = Select {
-	selectColumns :: [Text],
-	selectTables :: [Text],
-	selectConditions :: [Text] }
-		deriving (Eq, Ord, Read, Show)
+data Select a = Select {
+	selectColumns :: [a],
+	selectTables :: [a],
+	selectConditions :: [a] }
+		deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)
 
-instance Monoid Select where
+instance Monoid (Select a) where
 	mempty = Select mempty mempty mempty
 	Select lc lt lcond `mappend` Select rc rt rcond = Select
 		(lc `mappend` rc)
 		(lt `mappend` rt)
 		(lcond `mappend` rcond)
 
-select_ :: [Text] -> [Text] -> [Text] -> Select
-select_ = Select
+select_ :: [a] -> Select a
+select_ cols = Select cols [] []
 
-where_ :: [Text] -> Select
-where_ = select_ [] []
+from_ :: [a] -> Select a
+from_ tbls = Select [] tbls []
 
-buildQuery :: Select -> String
+where_ :: [a] -> Select a
+where_ = Select [] []
+
+buildQuery :: Select Text -> String
 buildQuery (Select cols tables conds) = "select {} from {} where {}"
 	~~ T.intercalate ", " cols
 	~~ T.intercalate ", " tables
 	~~ T.intercalate " and " (map (\cond -> T.concat ["(", cond, ")"]) conds)
 
-toQuery :: Select -> Query
+toQuery :: Select Text -> Query
 toQuery = fromString . buildQuery
 
-qSymbolId :: Select
-qSymbolId = select_
-	[
+qSymbolId :: Select Text
+qSymbolId = mconcat [
+	select_ [
 		"s.name",
 		"m.name",
 		"m.file",
@@ -50,13 +54,14 @@ 		"m.package_name",
 		"m.package_version",
 		"m.installed_name",
-		"m.other_location"]
-	["modules as m", "symbols as s"]
-	["m.id == s.module_id"]
+		"m.other_location"],
+	from_ ["modules as m", "symbols as s"],
+	where_ ["m.id == s.module_id"]]
 
-qSymbol :: Select
-qSymbol = qSymbolId `mappend` select_ cols [] [] where
-	cols = [
+qSymbol :: Select Text
+qSymbol = mconcat [
+	qSymbolId,
+	select_ [
 		"s.docs",
 		"s.line",
 		"s.column",
@@ -68,24 +73,23 @@ 		"s.context",
 		"s.associate",
 		"s.pat_type",
-		"s.pat_constructor"]
+		"s.pat_constructor"]]
 
-qModuleLocation :: Select
-qModuleLocation = select_
-	[
-		"ml.file",
-		"ml.cabal",
-		"ml.install_dirs",
-		"ml.package_name",
-		"ml.package_version",
-		"ml.installed_name",
-		"ml.other_location"]
-	["modules as ml"]
-	[]
+qModuleLocation :: Text -> Select Text
+qModuleLocation ml = template ["ml" ~% ml] [
+	select_ [
+		"{ml}.file",
+		"{ml}.cabal",
+		"{ml}.install_dirs",
+		"{ml}.package_name",
+		"{ml}.package_version",
+		"{ml}.installed_name",
+		"{ml}.other_location"],
+	from_ ["modules as {ml}"]]
 
-qModuleId :: Select
-qModuleId = select_
-	[
+qModuleId :: Select Text
+qModuleId = mconcat [
+	select_ [
 		"mu.name",
 		"mu.file",
 		"mu.cabal",
@@ -93,19 +97,47 @@ 		"mu.package_name",
 		"mu.package_version",
 		"mu.installed_name",
-		"mu.other_location"]
-	["modules as mu"]
-	[]
+		"mu.other_location"],
+	from_ ["modules as mu"],
+	where_ ["mu.name is not null"]]
 
-qBuildInfo :: Select
-qBuildInfo = select_
-	[
+qBuildInfo :: Select Text
+qBuildInfo = mconcat [
+	select_ [
 		"bi.depends",
 		"bi.language",
 		"bi.extensions",
 		"bi.ghc_options",
 		"bi.source_dirs",
-		"bi.other_modules"
-	]
-	["build_infos as bi"]
-	[]+		"bi.other_modules"],
+	from_ ["build_infos as bi"]]
+
+-- | Symbol from haskell-names
+qNSymbol :: Text -> Text -> Select Text
+qNSymbol m s = template ["m" ~% m, "s" ~% s] [
+	select_ [
+		"{s}.what",
+		"{m}.name",
+		"{s}.name",
+		"{s}.parent",
+		"{s}.constructors",
+		"{s}.associate",
+		"{s}.pat_type",
+		"{s}.pat_constructor"],
+	from_ ["symbols as {s}", "modules as {m}"],
+	where_ ["{m}.id = {s}.module_id"]]
+
+qNote :: Text -> Text -> Select Text
+qNote m n = template ["m" ~% m, "n" ~% n] [
+	select_ [
+		"{m}.file",
+		"{n}.line", "{n}.column", "{n}.line_to", "{n}.column_to",
+		"{n}.severity",
+		"{n}.message", "{n}.suggestion"],
+	from_ ["modules as {m}", "messages as {n}"],
+	where_ [
+		"{m}.file is not null",
+		"{n}.module_id = {m}.id"]]
+
+template :: [FormatArg] -> [Select Text] -> Select Text
+template args = fmap ((`formats` args) . T.unpack) . mconcat

@@ -30,7 +30,7 @@ 	retriesError :: SQLError -> Bool }
 
 instance Default Retries where
-	def = Retries (replicate 100 100000) $ \e -> sqlError e `elem` [ErrorBusy, ErrorLocked]
+	def = Retries (replicate 10 100000) $ \e -> sqlError e `elem` [ErrorBusy, ErrorLocked]
 
 -- | Don't retry
 noRetry :: Retries

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings, MultiParamTypeClasses, RankNTypes, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, MultiParamTypeClasses, RankNTypes, TypeOperators, TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Database.Update (
@@ -16,6 +16,8 @@ 	scan,
 	processEvents, updateEvents, applyUpdates,
 
+	cacheGhcWarnings, cachedWarnings,
+
 	module HsDev.Database.Update.Types,
 
 	module HsDev.Watcher,
@@ -28,17 +30,19 @@ import Control.DeepSeq
 import Control.Exception (ErrorCall, evaluate, displayException)
 import Control.Lens hiding ((.=))
-import Control.Monad.Catch (catch, handle, MonadThrow)
+import Control.Monad.Catch (catch, handle, MonadThrow, bracket_)
 import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.State (get, modify, evalStateT)
 import Data.Aeson
 import Data.List (intercalate)
+import Data.String (fromString)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import Data.Maybe
 import Data.Text (Text)
+import Data.Time.Clock.POSIX
 import qualified Data.Text as T
 import System.FilePath
 import qualified System.Log.Simple as Log
@@ -53,13 +57,13 @@ import HsDev.Sandbox
 import qualified HsDev.Stack as S
 import HsDev.Symbols
-import HsDev.Tools.Ghc.Session hiding (wait, evaluate)
+import HsDev.Tools.Ghc.Session hiding (Session, wait, evaluate)
 import HsDev.Tools.Ghc.Types (fileTypes, TypedExpr)
 import HsDev.Tools.Types
 import HsDev.Tools.HDocs
 import qualified HsDev.Scan as S
 import HsDev.Scan.Browse
-import HsDev.Util (ordNub, fromJSON')
+import HsDev.Util (ordNub, fromJSON', uniqueBy, timer)
 import qualified HsDev.Util as Util (withCurrentDirectory)
 import HsDev.Server.Types (commandNotify, inSessionGhc, FileSource(..))
 import HsDev.Server.Message
@@ -74,6 +78,9 @@ childTask :: UpdateMonad m => Task -> m a -> m a
 childTask t = local (over (updateOptions . updateTasks) (t:))
 
+transact :: SessionMonad m => m a -> m a
+transact = SQLite.transaction_ SQLite.Immediate
+
 runUpdate :: ServerMonadBase m => UpdateOptions -> UpdateM m a -> ClientM m a
 runUpdate uopts act = Log.scope "update" $ do
 	(r, updatedMods) <- withUpdateState uopts $ \ust ->
@@ -188,62 +195,74 @@ runTasks_ :: UpdateMonad m => [m ()] -> m ()
 runTasks_ = void . runTasks
 
+data PreloadFailure = PreloadFailure ModuleLocation Inspection HsDevError
+
+instance NFData PreloadFailure where
+	rnf (PreloadFailure mloc insp err) = rnf mloc `seq` rnf insp `seq` rnf err
+
 -- | Scan modules
 scanModules :: UpdateMonad m => [String] -> [S.ModuleToScan] -> m ()
 scanModules opts ms = Log.scope "scan-modules" $ mapM_ (uncurry scanModules') grouped where
 	scanModules' mproj ms' = do
-		pdbs <- maybe (return userDb) (inSessionGhc . getProjectPackageDbStack) mproj
-		case mproj of
-			Just proj -> sendUpdateAction $ SQLite.updateProject proj (Just pdbs)
-			Nothing -> return ()
+		maybe (return ()) (sendUpdateAction . SQLite.updateProject) mproj
 		updater $ ms' ^.. each . _1
 		defines <- askSession sessionDefines
 
 		let
 			pload (mloc, mopts, mcts) = runTask "preloading" mloc $ do
 				mfcts <- maybe (S.getFileContents (mloc ^?! moduleFile)) (const $ return Nothing) mcts
+				insp <- liftIO $ fileInspection (mloc ^?! moduleFile) (opts ++ mopts)
 				case (mfcts ^? _Just . _1) of
 					Just tm -> Log.sendLog Log.Trace $ "using edited file contents, mtime = {}" ~~ show tm
 					Nothing -> return ()
 				let
-					resetInspection = maybe id (set preloadedTime . fileContentsInspection_ (opts ++ mopts)) $ mfcts ^? _Just . _1
+					inspection' = maybe insp (fileContentsInspection_ (opts ++ mopts)) $ mfcts ^? _Just . _1
+					dirtyTag' = maybe id (const $ inspectTag DirtyTag) $ mfcts ^? _Just . _1
 					mcts' = mplus mcts (mfcts ^? _Just . _2)
-				p <- liftIO $ preload (mloc ^?! moduleFile) defines (opts ++ mopts) mloc mcts'
-				return $ resetInspection p
+				runInspect mloc $ withInspection (return inspection') $ dirtyTag' $ preload (mloc ^?! moduleFile) defines (opts ++ mopts) mcts'
 
 		ploaded <- runTasks (map pload ms')
-		mlocs' <- forM ploaded $ \p -> do
-			let
-				mloc = p ^. preloadedId . moduleLocation
-				inspectedMod = Inspected (p ^. preloadedTime) mloc (tag OnlyHeaderTag) $ Right $ p ^. asModule
-			sendUpdateAction $ Log.scope "preloaded" $ SQLite.updateModule inspectedMod
-			return mloc
+		sendUpdateAction $ Log.scope "preloaded" $ transact $ mapM_ SQLite.upsertModule $ map (fmap (view asModule)) ploaded
+		let
+			mlocs' = ploaded ^.. each . inspected . preloadedId . moduleLocation
+
 		updater mlocs'
 
-		(sqlMods', sqlAenv') <- do
-			let
-				mprojectDeps = SQLite.buildQuery $ SQLite.select_
-					["ps.module_id"]
-					["projects_modules_scope as ps"]
-					["ps.cabal is ?"]
-			sqlMods' <- SQLite.loadModules mprojectDeps (SQLite.Only $ mproj ^? _Just . projectCabal)
-			return (sqlMods', mconcat (map moduleAnalyzeEnv sqlMods'))
+		let
+			mcabal = mproj ^? _Just . projectCabal
 
-		Log.sendLog Log.Trace $ "resolving environment: {} modules" ~~ length sqlMods'
-		case order ploaded of
+		env <- loadEnvironment mcabal
+		fixities <- loadFixities mcabal
+
+		Log.sendLog Log.Trace $ "resolved environment: {} modules" ~~ M.size env
+		case orderBy (preview inspected) ploaded of
 			Left err -> Log.sendLog Log.Error ("failed order dependencies for files: {}" ~~ show err)
 			Right ordered -> do
-				ms'' <- flip evalStateT sqlAenv' $ runTasks (map inspect' ordered)
-				mlocs'' <- forM ms'' $ \im -> do
-					sendUpdateAction $ Log.scope "resolved" $ SQLite.updateModule im
-					return $ im ^. inspectedKey
+				ms'' <- flip evalStateT (env, fixities) $ runTasks (map inspect' ordered)
+				mlocs'' <- timer "updated scanned modules" $ do
+					Log.sendLog Log.Trace $ case mproj of
+						Just proj -> "inserting data for resolved modules of project: {}" ~~ proj
+						Nothing -> "inserting data for resolved standalone modules"
+					sendUpdateAction $ Log.scope "resolved" $ updateResolveds mcabal ms''
+					return (ms'' ^.. each . inspectedKey)
 				updater mlocs''
 				where
-					inspect' pmod = runTask "scanning" (pmod ^. preloadedId . moduleLocation) $ Log.scope "module" $ do
-						aenv <- get
-						m <- either (hsdevError . InspectError) eval $ analyzePreloaded aenv pmod
-						modify (mappend (moduleAnalyzeEnv m))
-						return $ Inspected (pmod ^. preloadedTime) (m ^. moduleId . moduleLocation) mempty (Right m)
+					inspect' pmod = runTask "scanning" ploc $ Log.scope "module" $ do
+						(env', fixities') <- get
+						r <- continueInspect pmod $ \p -> do
+							resolved' <- msum [
+								resolveModule env' fixities' p,
+								do
+									lift (Log.sendLog Log.Trace ("error resolving module {}, falling to resolving just imports/scope" ~~ (p ^. preloadedId . moduleLocation)))
+									resolvePreloaded env' p]
+							eval resolved'
+						modify $ mappend (
+							maybe mempty resolvedEnv (r ^? inspected),
+							maybe mempty resolvedFixitiesTable (r ^? inspected))
+						return r
+						where
+							ploc = pmod ^?! inspected . preloadedId . moduleLocation
+
 	grouped = M.toList $ M.unionsWith (++) [M.singleton (m ^? _1 . moduleProject . _Just) [m] | m <- ms]
 	eval v = handle onError (v `deepseq` liftIO (evaluate v)) where
 		onError :: MonadThrow m => ErrorCall -> m a
@@ -287,8 +306,7 @@ -- | Prepare sandbox for scanning. This is used for stack project to build & configure.
 prepareSandbox :: UpdateMonad m => Sandbox -> m ()
 prepareSandbox sbox@(Sandbox StackWork fpath) = Log.scope "prepare" $ runTasks_ [
-	runTask "building dependencies" sbox $ void $ Util.withCurrentDirectory dir $ inSessionGhc $ S.buildDeps Nothing,
-	runTask "configuring" sbox $ void $ Util.withCurrentDirectory dir $ inSessionGhc $ S.configure Nothing]
+	runTask "building dependencies" sbox $ void $ Util.withCurrentDirectory dir $ inSessionGhc $ S.buildDeps Nothing]
 	where
 		dir = takeDirectory $ view path fpath
 prepareSandbox _ = return ()
@@ -296,7 +314,7 @@ -- | Scan sandbox modules, doesn't rescan if already scanned
 scanSandbox :: UpdateMonad m => [String] -> Sandbox -> m ()
 scanSandbox opts sbox = Log.scope "sandbox" $ do
-	prepareSandbox sbox
+	-- prepareSandbox sbox
 	pdbs <- inSessionGhc $ sandboxPackageDbStack sbox
 	scanPackageDbStack opts pdbs
 
@@ -323,8 +341,8 @@ 			scan packageDbMods' ((,,) <$> mlocs <*> pure [] <*> pure Nothing) opts $ \mlocs' -> do
 				ms <- inSessionGhc $ browseModules opts pdbs (mlocs' ^.. each . _1)
 				Log.sendLog Log.Trace $ "scanned {} modules" ~~ length ms
-				sendUpdateAction $ do
-					mapM_ SQLite.updateModule ms
+				sendUpdateAction $ timer "updated package-db modules" $ do
+					SQLite.updateModules ms
 					SQLite.updatePackageDb (topPackageDb pdbs) (M.keys pdbState)
 
 				when hdocsSupported $ scanPackageDbStackDocs opts pdbs
@@ -354,8 +372,8 @@ 			scan packageDbStackMods ((,,) <$> mlocs <*> pure [] <*> pure Nothing) opts $ \mlocs' -> do
 				ms <- inSessionGhc $ browseModules opts pdbs (mlocs' ^.. each . _1)
 				Log.sendLog Log.Trace $ "scanned {} modules" ~~ length ms
-				sendUpdateAction $ do
-					mapM_ SQLite.updateModule ms
+				sendUpdateAction $ timer "updated package-db-stack modules" $ do
+					SQLite.updateModules ms
 					sequence_ [SQLite.updatePackageDb pdb (M.keys pdbState) | (pdb, pdbState) <- zip (packageDbs pdbs) pdbStates]
 
 				-- BUG: I don't know why, but these steps leads to segfault on my PC:
@@ -379,8 +397,10 @@ scanProjectFile opts cabal = runTask "scanning" cabal $ do
 	proj <- S.scanProjectFile opts cabal
 	pdbs <- inSessionGhc $ getProjectPackageDbStack proj
-	sendUpdateAction $ Log.scope "scan-project-file" $ SQLite.updateProject proj (Just pdbs)
-	return proj
+	let
+		proj' = set projectPackageDbStack (Just pdbs) proj
+	sendUpdateAction $ Log.scope "scan-project-file" $ SQLite.updateProject proj'
+	return proj'
 
 -- | Refine project info and update if necessary
 refineProjectInfo :: UpdateMonad m => Project -> m Project
@@ -391,8 +411,10 @@ 		else runTask "scanning" (proj ^. projectCabal) $ do
 			proj' <- liftIO $ loadProject proj
 			pdbs <- inSessionGhc $ getProjectPackageDbStack proj'
-			sendUpdateAction $ Log.scope "refine-project-info" $ SQLite.updateProject proj' (Just pdbs)
-			return proj'
+			let
+				proj'' = set projectPackageDbStack (Just pdbs) proj'
+			sendUpdateAction $ Log.scope "refine-project-info" $ SQLite.updateProject proj''
+			return proj''
 
 -- | Get project info for module
 locateProjectInfo :: UpdateMonad m => Path -> m (Maybe Project)
@@ -458,7 +480,7 @@ 		docs <- inSessionGhc $ hdocsCabal pdbs opts
 		Log.sendLog Log.Trace $ "docs scanned: {} packages, {} modules total"
 			~~ length docs ~~ sum (map (M.size . snd) docs)
-		sendUpdateAction $ SQLite.executeMany "update symbols set docs = ? where name == ? and module_id in (select id from modules where name == ? and package_name == ? and package_version == ?);" $ do
+		sendUpdateAction $ transact $ SQLite.executeMany "update symbols set docs = ? where name == ? and module_id in (select id from modules where name == ? and package_name == ? and package_version == ?);" $ do
 			(ModulePackage pname pver, pdocs) <- docs
 			(mname, mdocs) <- M.toList pdocs
 			(nm, doc) <- M.toList mdocs
@@ -483,7 +505,7 @@ 				-- Calling haddock with targets set sometimes cause errors
 				haddockSession pdbs opts'
 				readModuleDocs opts' m'
-			sendUpdateAction $ do
+			sendUpdateAction $ transact $ do
 				SQLite.executeMany "update symbols set docs = ? where name == ? and module_id == ?;"
 					[(doc, nm, mid') | (nm, doc) <- maybe [] M.toList docsMap]
 				SQLite.execute "update modules set tags = json_set(tags, '$.docs', 1) where id == ?;" (SQLite.Only mid')
@@ -493,12 +515,13 @@ setModTypes m ts = Log.scope "set-types" $ do
 	mid <- SQLite.lookupModule m
 	mid' <- maybe (hsdevError $ SQLiteError "module id not found") return mid
-	sendUpdateAction $ do
+	sendUpdateAction $ transact $ do
+		SQLite.execute "delete from types where module_id = ?;" (SQLite.Only mid')
 		SQLite.executeMany "insert into types (module_id, line, column, line_to, column_to, expr, type) values (?, ?, ?, ?, ?, ?, ?);" [
-			(SQLite.Only mid' SQLite.:. view noteRegion n' SQLite.:. view note n') | n' <- ts]
+			(SQLite.Only mid' SQLite.:. view noteRegion n' SQLite.:. view note n') | n' <- uniqueBy (view noteRegion) ts]
 		SQLite.execute "update names set inferred_type = (select type from types as t where t.module_id = ? and names.line = t.line and names.column = t.column and names.line_to = t.line_to and names.column_to = t.column_to) where module_id == ?;"
 			(mid', mid')
-		SQLite.execute "update symbols set type = (select type from types as t where t.module_id = ? and symbols.line = t.line and symbols.column = t.column order by t.line_to, t.column_to) where module_id == ?;" (mid', mid')
+		SQLite.execute "update symbols set type = (select type from types as t where t.module_id = ? and symbols.line = t.line and symbols.column = t.column order by t.line_to, t.column_to) where module_id == ? and type is null;" (mid', mid')
 		SQLite.execute "update modules set tags = json_set(tags, '$.types', 1) where id == ?;" (SQLite.Only mid')
 
 -- | Infer types for modules
@@ -510,10 +533,12 @@ 		m' <- mapMOf (moduleId . moduleLocation . moduleProject . _Just) refineProjectInfo m
 		Log.sendLog Log.Trace $ "Inferring types for {}" ~~ view (moduleId . moduleLocation) m'
 
+		sess <- getSession
 		mcts <- fmap (fmap snd) $ S.getFileContents (m' ^?! moduleId . moduleLocation . moduleFile)
 		types' <- inSessionGhc $ do
 			targetSession [] m'
-			fileTypes m' mcts
+			cacheGhcWarnings sess (m' ^.. moduleId . moduleLocation) $
+				fileTypes m' mcts
 
 		setModTypes (m' ^. moduleId) types'
 
@@ -533,7 +558,8 @@ 	let
 		obsolete = M.filterWithKey (\k _ -> k `S.notMember` S.fromList (map (^. _1) mlocs)) mlocs'
 	changed <- S.changedModules (M.map snd mlocs') opts mlocs
-	sendUpdateAction $ Log.scope "remove-obsolete" $ forM_ (M.elems obsolete) $ SQLite.removeModule . fst
+	sendUpdateAction $ Log.scope "remove-obsolete" $ transact $
+		forM_ (M.elems obsolete) $ SQLite.removeModule . fst
 	act changed
 
 processEvents :: ([(Watched, Event)] -> IO ()) -> MVar (A.Async ()) -> MVar [(Watched, Event)] -> [(Watched, Event)] -> ClientM IO ()
@@ -593,6 +619,74 @@ 
 applyUpdates :: UpdateOptions -> [(Watched, Event)] -> ClientM IO ()
 applyUpdates uopts = runUpdate uopts . updateEvents
+
+-- Save ghc warnings on loading target, because second loading won't produce any
+cacheGhcWarnings :: Session -> [ModuleLocation] -> GhcM a -> GhcM a
+cacheGhcWarnings sess mlocs act = Log.scope "cache-warnings" $ do
+	tm <- liftIO getPOSIXTime
+	(r, msgs) <- collectMessages act
+	Log.sendLog Log.Trace $ "collected {} warnings" ~~ length msgs
+	_ <- liftIO $ withSession sess $ postSessionUpdater $ refreshCache mlocs tm msgs
+	return r
+	where
+		refreshCache :: [ModuleLocation] -> POSIXTime -> [Note OutputMessage] -> ServerM IO ()
+		refreshCache mlocs' tm' msgs' = Log.scope "refresh" $ bracket_ initTemp dropTemp $ do
+			fillTemp
+			removeOutdated
+			insertMessages
+			where
+				initTemp :: SessionMonad m => m ()
+				initTemp = do
+					SQLite.execute_ "create temporary table updating_ids (id integer not null unique);"
+					SQLite.execute_ "create temporary table updating_messages as select * from messages where 0;"
+					SQLite.execute_ "create index update_messages_module_id_index on updating_messages (module_id);"
+
+				dropTemp :: SessionMonad m => m ()
+				dropTemp = do
+					SQLite.execute_ "drop table if exists updating_ids;"
+					SQLite.execute_ "drop table if exists updating_messages;"
+
+				fillTemp :: SessionMonad m => m ()
+				fillTemp = do
+					SQLite.executeMany "insert into updating_ids select distinct m.id from modules as m where (m.file = ?);" $ (map SQLite.Only $ mlocs' ^.. each . moduleFile)
+					SQLite.executeMany "insert into updating_messages select (select m.id from modules as m where (m.file = ?)), ?, ?, ?, ?, ?, ?, ?;" msgs'
+					SQLite.execute_ "insert into updating_ids select distinct umsgs.module_id from updating_messages as umsgs where umsgs.module_id not in (select id from updating_ids);"
+
+				removeOutdated :: SessionMonad m => m ()
+				removeOutdated = SQLite.execute_ $ fromString $ unlines [
+					"delete from messages",
+					"where",
+					" module_id in (",
+					"  select um.id",
+					"  from",
+					"   updating_ids as um, modules as m",
+					"  left outer join",
+					"   load_times as lt",
+					"  on",
+					"   lt.module_id = um.id",
+					"  where",
+					"   um.id = m.id and (",
+					"    lt.load_time is null or",
+					"    lt.load_time <= m.inspection_time or",
+					"    um.id in (select distinct umsgs.module_id from updating_messages as umsgs)",
+					"   )",
+					" );"]
+
+				insertMessages :: SessionMonad m => m ()
+				insertMessages = SQLite.transaction_ SQLite.Deferred $ do
+					SQLite.execute "insert or replace into load_times (module_id, load_time) select um.id, ? from updating_ids as um;" (SQLite.Only tm')
+					SQLite.execute_ "insert into messages select distinct * from updating_messages;"
+
+-- | Get cached warnings
+cachedWarnings :: SessionMonad m => [ModuleLocation] -> m [Note OutputMessage]
+cachedWarnings mlocs = liftM concat $ forM (mlocs ^.. each . moduleFile) $ \f -> SQLite.query @_ @(Note OutputMessage) (SQLite.toQuery $ mconcat [
+	SQLite.qNote "m" "n",
+	SQLite.from_ ["load_times as lt"],
+	SQLite.where_ [
+		"lt.module_id = m.id",
+		"m.file = ?",
+		"lt.load_time >= m.inspection_time"]])
+	(SQLite.Only f)
 
 watch :: SessionMonad m => (Watcher -> IO ()) -> m ()
 watch f = do

@@ -23,10 +23,8 @@ import Data.Functor
 import Data.Default
 import qualified System.Log.Simple as Log
-import qualified System.Log.Simple.Monad as Log
 
 import Control.Concurrent.Worker
-import HsDev.Database.SQLite
 import HsDev.Server.Types hiding (Command(..))
 import HsDev.Symbols
 import HsDev.Types
@@ -103,23 +101,22 @@ withUpdateState :: SessionMonad m => UpdateOptions -> (UpdateState -> m a) -> m a
 withUpdateState uopts fn = do
 	session <- getSession
-	bracket (liftIO $ startWorker (withSession session . Log.component "sqlite" . Log.scope "update") enterTransaction logAll) (liftIO . joinWorker) $ \w ->
+	bracket (liftIO $ startWorker (withSession session . Log.component "sqlite" . Log.scope "update") id logAll) (liftIO . joinWorker) $ \w ->
 		fn (UpdateState uopts w)
-	where
-		enterTransaction act = do
-			Log.sendLog Log.Trace "entering sqlite transaction"
-			transaction_ Immediate $ do
-				Log.sendLog Log.Debug "updating sql database"
-				_ <- act
-				Log.sendLog Log.Debug "sql database updated"
+	-- where
+	-- 	enterTransaction act = do
+	-- 		Log.sendLog Log.Trace "entering sqlite transaction"
+	-- 		timer "closed transaction" $ transaction_ Immediate $ do
+	-- 			Log.sendLog Log.Debug "updating sql database"
+	-- 			_ <- act
+	-- 			Log.sendLog Log.Debug "sql database updated"
 
 type UpdateMonad m = (CommandMonad m, MonadReader UpdateState m, MonadWriter [ModuleLocation] m)
 
 sendUpdateAction :: UpdateMonad m => ServerM IO () -> m ()
 sendUpdateAction act = do
 	w <- asks _updateWorker
-	s <- Log.askScope
-	liftIO $ inWorker w $ Log.localLog (Log.subLog mempty s) $ act
+	liftIO $ inWorker w act
 
 newtype UpdateM m a = UpdateM { runUpdateM :: ReaderT UpdateState (WriterT [ModuleLocation] (ClientM m)) a }
 	deriving (Applicative, Alternative, Monad, MonadPlus, MonadIO, MonadThrow, MonadCatch, MonadMask, Functor, MonadReader UpdateState, MonadWriter [ModuleLocation])

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP, TypeSynonymInstances, ImplicitParams, TemplateHaskell #-}
 
 module HsDev.Inspect (
-	Preloaded(..), preloadedId, preloadedMode, preloadedModule, asModule, preloadedTime, preloaded, preload,
+	preload,
 	AnalyzeEnv(..), analyzeEnv, analyzeFixities, analyzeRefine, moduleAnalyzeEnv,
 	analyzeResolve, analyzePreloaded,
 	inspectDocs, inspectDocsGhc,
@@ -11,6 +11,8 @@ 	getDefines,
 	preprocess, preprocess_,
 
+	module HsDev.Inspect.Types,
+	module HsDev.Inspect.Resolve,
 	module Control.Monad.Except
 	) where
 
@@ -18,15 +20,13 @@ import qualified Control.Exception as E
 import Control.Lens
 import Control.Monad
-import Control.Monad.State
+import Control.Monad.Catch
+import Control.Monad.Reader
 import Control.Monad.Except
-import Data.Data (Data)
-import Data.Function (on)
 import Data.List
 import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Ord (comparing)
-import Data.String (IsString, fromString)
+import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, getPOSIXTime, POSIXTime)
@@ -44,15 +44,16 @@ import qualified System.Directory as Dir
 import System.FilePath
 import Text.Format
-import Data.Generics.Uniplate.Data
 
 import HsDev.Display ()
 import HsDev.Error
+import HsDev.Inspect.Definitions
+import HsDev.Inspect.Types
+import HsDev.Inspect.Resolve
 import HsDev.Sandbox (searchPackageDbStack)
 import HsDev.Symbols
 import HsDev.Symbols.Name (fromModuleName_)
-import HsDev.Symbols.Resolve (refineSymbol, refineTable, RefineTable, symbolUniqId)
-import HsDev.Symbols.Parsed hiding (file)
+import HsDev.Symbols.Resolve (refineSymbol, refineTable, RefineTable)
 import qualified HsDev.Symbols.HaskellNames as HN
 import HsDev.Tools.Base
 import HsDev.Tools.Ghc.Worker (GhcM)
@@ -60,82 +61,56 @@ import HsDev.Util
 import System.Directory.Paths
 
--- | Preloaded module with contents and extensions
-data Preloaded = Preloaded {
-	_preloadedId :: ModuleId,
-	_preloadedMode :: H.ParseMode,
-	_preloadedModule :: H.Module H.SrcSpanInfo,
-	-- ^ Loaded module head without declarations
-	_preloadedTime :: Inspection,
-	_preloaded :: Text }
-
-instance NFData Preloaded where
-	rnf (Preloaded mid _ _ insp cts) = rnf mid `seq` rnf insp `seq` rnf cts
-
-asModule :: Lens' Preloaded Module
-asModule = lens g' s' where
-	g' p = Module {
-		_moduleId = _preloadedId p,
-		_moduleDocs = Nothing,
-		_moduleImports = map (fromModuleName_ . void . H.importModule) idecls,
-		_moduleExports = mempty,
-		_moduleFixities = mempty,
-		_moduleScope = mempty,
-		_moduleSource = Just $ fmap (N.Scoped N.None) $ _preloadedModule p }
-		where
-			H.Module _ _ _ idecls _ = _preloadedModule p
-	s' p m = p {
-		_preloadedId = _moduleId m,
-		_preloadedModule = maybe (_preloadedModule p) dropScope (_moduleSource m) }
-
 -- | Preload module - load head and imports to get actual extensions and dependencies
-preload :: Text -> [(String, String)] -> [String] -> ModuleLocation -> Maybe Text -> IO Preloaded
-preload name defines opts mloc@(FileModule fpath mproj) Nothing = do
-	cts <- readFileUtf8 (view path fpath)
-	insp <- fileInspection fpath opts
-	let
-		srcExts = fromMaybe (takeDir fpath `withExtensions` mempty) $ do
-			proj <- mproj
-			findSourceDir proj fpath
-	p' <- preload name defines (opts ++ extensionsOpts srcExts) mloc (Just cts)
-	return $ p' { _preloadedTime = insp }
-preload _ _ _ mloc Nothing = hsdevError $ InspectError $
-	format "preload called non-sourced module: {}" ~~ mloc
-preload name defines opts mloc (Just cts) = do
-	cts' <- preprocess_ defines exts fpath $ T.map untab cts
-	pragmas <- parseOk $ H.getTopPragmas (T.unpack cts')
-	let
-		fileExts = [H.parseExtension (T.unpack $ fromName_ $ void lang) | H.LanguagePragma _ langs <- pragmas, lang <- langs]
-		pmode = H.ParseMode {
-			H.parseFilename = view path fpath,
-			H.baseLanguage = H.Haskell2010,
-			H.extensions = ordNub (map H.parseExtension exts ++ fileExts),
-			H.ignoreLanguagePragmas = False,
-			H.ignoreLinePragmas = True,
-			H.fixities = Nothing,
-			H.ignoreFunctionArity = False }
-	H.ModuleHeadAndImports l mpragmas mhead mimps <- parseOk $ fmap H.unNonGreedy $ H.parseWithMode pmode (T.unpack cts')
-	when (H.isNullSpan $ H.srcInfoSpan l) $ hsdevError $ InspectError
-		(format "Error parsing module head and imports, file {}" ~~ view path fpath)
-	mname <- case mhead of
-		Just (H.ModuleHead _ (H.ModuleName _ nm) _ _) -> return $ fromString nm
-		_ -> hsdevError $ InspectError $ (format "Parsing module head and imports results in empty module name, file {}" ~~ view path fpath)
-	insp <- fileContentsInspection opts
-	return $ Preloaded {
-		_preloadedId = ModuleId mname mloc,
-		_preloadedMode = pmode,
-		_preloadedModule = H.Module l mhead mpragmas mimps [],
-		_preloadedTime = insp,
-		_preloaded = cts' }
+preload :: (MonadIO m, MonadCatch m) => Text -> [(String, String)] -> [String] -> Maybe Text -> InspectM ModuleLocation ModuleTag m Preloaded
+preload name defines opts mcts = inspectTag OnlyHeaderTag $ case mcts of
+	Nothing -> do
+		mloc <- ask
+		case mloc of
+			FileModule fpath mproj -> do
+				inspect_ (liftIO $ fileInspection fpath opts) $ do
+					cts <- liftIO $ readFileUtf8 (view path fpath)
+					let
+						srcExts = fromMaybe (takeDir fpath `withExtensions` mempty) $ do
+							proj <- mproj
+							findSourceDir proj fpath
+					liftIO $ preload' name defines (opts ++ extensionsOpts srcExts) mloc cts
+			_ -> throwError $ InspectError $ format "preload called on non-sourced module: {}" ~~ mloc
+	Just cts -> inspect (liftIO $ fileContentsInspection opts) $ \mloc ->
+		liftIO $ preload' name defines opts mloc cts
 	where
-		fpath = fromMaybe name (mloc ^? moduleFile)
-		parseOk :: H.ParseResult a -> IO a
-		parseOk (H.ParseOk v) = return v
-		parseOk (H.ParseFailed loc err) = hsdevError $ InspectError $
-			format "Parse {} failed at {} with: {}" ~~ fpath ~~ show loc ~~ err
-		untab '\t' = ' '
-		untab ch = ch
-		exts = mapMaybe flagExtension opts
+		preload' name' defines' opts' mloc' cts' = do
+			cts'' <- preprocess_ defines' exts fpath $ T.map untab cts'
+			pragmas <- parseOk $ H.getTopPragmas (T.unpack cts'')
+			let
+				fileExts = [H.parseExtension (T.unpack $ fromName_ $ void lang) | H.LanguagePragma _ langs <- pragmas, lang <- langs]
+				pmode = H.ParseMode {
+					H.parseFilename = view path fpath,
+					H.baseLanguage = H.Haskell2010,
+					H.extensions = ordNub (map H.parseExtension exts ++ fileExts),
+					H.ignoreLanguagePragmas = False,
+					H.ignoreLinePragmas = True,
+					H.fixities = Nothing,
+					H.ignoreFunctionArity = False }
+			H.ModuleHeadAndImports l mpragmas mhead mimps <- parseOk $ fmap H.unNonGreedy $ H.parseWithMode pmode (T.unpack cts'')
+			let
+				mname = case mhead of
+					Just (H.ModuleHead _ (H.ModuleName _ nm) _ _) -> nm
+					_ -> "Main"
+			return $ Preloaded {
+				_preloadedId = ModuleId (fromString mname) mloc',
+				_preloadedMode = pmode,
+				_preloadedModule = H.Module l mhead mpragmas mimps [],
+				_preloaded = cts'' }
+			where
+				fpath = fromMaybe name' (mloc' ^? moduleFile)
+				parseOk :: H.ParseResult a -> IO a
+				parseOk (H.ParseOk v) = return v
+				parseOk (H.ParseFailed loc err) = hsdevError $ InspectError $
+					format "Parse {} failed at {} with: {}" ~~ fpath ~~ show loc ~~ err
+				untab '\t' = ' '
+				untab ch = ch
+				exts = mapMaybe flagExtension opts'
 
 data AnalyzeEnv = AnalyzeEnv {
 	_analyzeEnv :: N.Environment,
@@ -201,111 +176,6 @@ 		qimps = M.keys $ N.importTable env (_preloadedModule p)
 		p' = p { _preloadedMode = (_preloadedMode p) { H.fixities = Just (mapMaybe (`M.lookup` gfixities) qimps) } }
 
--- | Get top symbols
-getSymbols :: [H.Decl Ann] -> [Symbol]
-getSymbols decls =
-	map mergeSymbols .
-	groupBy ((==) `on` symbolUniqId) .
-	sortBy (comparing symbolUniqId) $
-	concatMap getDecl decls
-	where
-		mergeSymbols :: [Symbol] -> Symbol
-		mergeSymbols [] = error "impossible"
-		mergeSymbols [s] = s
-		mergeSymbols ss@(s:_) = Symbol
-			(view symbolId s)
-			(msum $ map (view symbolDocs) ss)
-			(msum $ map (view symbolPosition) ss)
-			(foldr1 mergeInfo $ map (view symbolInfo) ss)
-
-		mergeInfo :: SymbolInfo -> SymbolInfo -> SymbolInfo
-		mergeInfo (Function lt) (Function rt) = Function $ lt `mplus` rt
-		mergeInfo (PatConstructor las lt) (PatConstructor ras rt) = PatConstructor (if null las then ras else las) (lt `mplus` rt)
-		mergeInfo (Selector lt lp lc) (Selector rt rp rc)
-			| lt == rt && lp == rp = Selector lt lp (nub $ lc ++ rc)
-			| otherwise = Selector lt lp lc
-		mergeInfo l _ = l
-
-
--- | Get symbols from declarations
-getDecl :: H.Decl Ann -> [Symbol]
-getDecl decl' = case decl' of
-	H.TypeDecl _ h _ -> [mkSymbol (tyName h) (Type (tyArgs h) [])]
-	H.TypeFamDecl _ h _ _ -> [mkSymbol (tyName h) (TypeFam (tyArgs h) [] Nothing)]
-	H.ClosedTypeFamDecl _ h _ _ _ -> [mkSymbol (tyName h) (TypeFam (tyArgs h) [] Nothing)]
-	H.DataDecl _ dt mctx h dcons _ -> mkSymbol nm ((getCtor dt) (tyArgs h) (getCtx mctx)) : concatMap (getConDecl nm) dcons where
-		nm = tyName h
-	H.GDataDecl _ dt mctx h _ gcons _ -> mkSymbol nm ((getCtor dt) (tyArgs h) (getCtx mctx)) : concatMap (getGConDecl nm) gcons where
-		nm = tyName h
-	H.DataFamDecl _ mctx h _ -> [mkSymbol (tyName h) (DataFam (tyArgs h) (getCtx mctx) Nothing)]
-	H.ClassDecl _ mctx h _ clsDecls -> mkSymbol nm (Class (tyArgs h) (getCtx mctx)) : concatMap (getClassDecl nm) (fromMaybe [] clsDecls) where
-		nm = tyName h
-	H.TypeSig _ ns tsig -> [mkSymbol n (Function (Just $ oneLinePrint tsig)) | n <- ns]
-	H.PatSynSig _ ns mas _ _ t -> [mkSymbol n (PatConstructor (maybe [] (map prp) mas) (Just $ oneLinePrint t)) | n <- ns'] where
-#if MIN_VERSION_haskell_src_exts(1,20,0)
-		ns' = ns
-#else
-		ns' = [ns]
-#endif
-	H.FunBind _ ms -> [mkSymbol (matchName m) (Function Nothing) | m <- ms] where
-		matchName (H.Match _ n _ _ _) = n
-		matchName (H.InfixMatch _ _ n _ _ _) = n
-	H.PatBind _ p _ _ -> [mkSymbol n (Function Nothing) | n <- patNames p] where
-		patNames :: H.Pat Ann -> [H.Name Ann]
-		patNames = childrenBi
-	H.PatSyn _ p _ _ -> case p of
-		H.PInfixApp _ _ qn _ -> [mkSymbol (qToName qn) (PatConstructor [] Nothing)]
-		H.PApp _ qn _ -> [mkSymbol (qToName qn) (PatConstructor [] Nothing)]
-		H.PRec _ qn fs -> mkSymbol (qToName qn) (PatConstructor [] Nothing) :
-			[mkSymbol (qToName n) (PatSelector Nothing Nothing (prp $ qToName qn)) | n <- (universeBi fs :: [H.QName Ann])]
-		_ -> []
-		where
-			qToName (H.Qual _ _ n) = n
-			qToName (H.UnQual _ n) = n
-			qToName _ = error "invalid qname"
-	_ -> []
-	where
-		tyName :: H.DeclHead Ann -> H.Name Ann
-		tyName = head . universeBi
-		tyArgs :: Data (ast Ann) => ast Ann -> [Text]
-		tyArgs n = map prp (universeBi n :: [H.TyVarBind Ann])
-		getCtx :: Maybe (H.Context Ann) -> [Text]
-		getCtx mctx = map prp (universeBi mctx :: [H.Asst Ann])
-		getCtor (H.DataType _) = Data
-		getCtor (H.NewType _) = NewType
-
-getConDecl :: H.Name Ann -> H.QualConDecl Ann -> [Symbol]
-getConDecl ptype (H.QualConDecl _ _ _ cdecl) = case cdecl of
-	H.ConDecl _ n ts -> [mkSymbol n (Constructor (map prp ts) (prp ptype))]
-	H.InfixConDecl _ lt n rt -> [mkSymbol n (Constructor (map prp [lt, rt]) (prp ptype))]
-	H.RecDecl _ n fs -> mkSymbol n (Constructor [prp t | H.FieldDecl _ _ t <- fs] (prp ptype)) :
-		[mkSymbol fn (Selector (Just $ prp ft) (prp ptype) [prp n]) | H.FieldDecl _ fns ft <- fs, fn <- fns]
-
-getGConDecl :: H.Name Ann -> H.GadtDecl Ann -> [Symbol]
-getGConDecl _ (H.GadtDecl _ n Nothing t) = [mkSymbol n (Constructor (map prp as) (prp res))] where
-	(as, res) = tyFunSplit t
-	tyFunSplit = go [] where
-		go as' (H.TyFun _ arg' res') = go (arg' : as') res'
-		go as' t' = (reverse as', t')
-getGConDecl ptype (H.GadtDecl _ n (Just fs) t) = mkSymbol n (Constructor [prp ft | H.FieldDecl _ _ ft <- fs] (prp t)) :
-	[mkSymbol fn (Selector (Just $ prp ft) (prp ptype) [prp n]) | H.FieldDecl _ fns ft <- fs, fn <- fns]
-
-getClassDecl :: H.Name Ann -> H.ClassDecl Ann -> [Symbol]
-getClassDecl pclass (H.ClsDecl _ (H.TypeSig _ ns tsig)) = [mkSymbol n (Method (Just $ oneLinePrint tsig) (prp pclass)) | n <- ns]
-getClassDecl _ _ = []
-
-prp :: H.Pretty a => a -> Text
-prp = fromString . H.prettyPrint
-
-
-mkSymbol :: H.Name Ann -> SymbolInfo -> Symbol
-mkSymbol nm = Symbol (SymbolId (fromName_ $ void nm) (ModuleId (fromString "") noLocation)) Nothing (nm ^? binders . defPos)
-
-
--- | Print something in one line
-oneLinePrint :: (H.Pretty a, IsString s) => a -> s
-oneLinePrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode
-
 -- | Adds documentation to declaration
 addDoc :: Map String String -> Symbol -> Symbol
 addDoc docsMap sym' = set symbolDocs (preview (ix (view (symbolId . symbolName) sym')) docsMap') sym' where
@@ -336,13 +206,14 @@ 	return $ maybe id addDocs docsMap m
 
 -- | Inspect contents
-inspectContents :: Text -> [(String, String)] -> [String] -> Text -> ExceptT String IO InspectedModule
-inspectContents name defines opts cts = inspect (OtherLocation name) (contentsInspection cts opts) $ do
-	p <- lift $ preload name defines opts (OtherLocation name) (Just cts)
-	analyzed <- ExceptT $ return $ analyzePreloaded mempty p
-	return $ set (moduleId . moduleLocation) (OtherLocation name) analyzed
+inspectContents :: Text -> [(String, String)] -> [String] -> Text -> IO InspectedModule
+inspectContents name defines opts cts = runInspect (OtherLocation name) $ withInspection (contentsInspection cts opts) $ do
+	p <- preload name defines opts (Just cts)
+	analyzed <- lift $ either (hsdevError . InspectError) return $ analyzePreloaded mempty p
+	inspectUntag OnlyHeaderTag $
+		return $ set (moduleId . moduleLocation) (OtherLocation name) analyzed
 
-contentsInspection :: Text -> [String] -> ExceptT String IO Inspection
+contentsInspection :: Text -> [String] -> IO Inspection
 contentsInspection _ _ = return InspectionNone -- crc or smth
 
 -- | Inspect file
@@ -351,14 +222,9 @@ 	absFilename <- canonicalize file
 	ex <- fileExists absFilename
 	unless ex $ hsdevError $ FileNotFound absFilename
-	inspect (FileModule absFilename mproj) (sourceInspection absFilename mcts opts) $ do
-		-- docsMap <- liftE $ if hdocsWorkaround
-		-- 	then hdocsProcess absFilename opts
-		-- 	else liftM Just $ hdocs (FileModule absFilename Nothing) opts
-		forced <- hsdevLiftWith InspectError $ ExceptT $ E.handle onError $ do
-			p <- preload absFilename defines opts (FileModule absFilename mproj) mcts
-			return $!! analyzePreloaded mempty p
-		-- return $ setLoc absFilename mproj . maybe id addDocs docsMap $ forced
+	runInspect (FileModule absFilename mproj) $ withInspection (sourceInspection absFilename mcts opts) $ do
+		p <- preload absFilename defines opts mcts
+		forced <- liftIO (E.handle onError (return $!! analyzePreloaded mempty p)) >>= either (hsdevError . InspectError) return
 		return $ set (moduleId . moduleLocation) (FileModule absFilename mproj) forced
 	where
 		onError :: E.ErrorCall -> IO (Either String Module)
@@ -381,7 +247,7 @@ 
 -- | File contents inspection data
 fileContentsInspection_ :: [String] -> POSIXTime -> Inspection
-fileContentsInspection_ opts tm = 	InspectionAt tm $ map fromString $ sort $ ordNub opts
+fileContentsInspection_ opts tm = InspectionAt tm $ map fromString $ sort $ ordNub opts
 
 -- | Installed module inspection data, just opts
 installedInspection :: [String] -> IO Inspection
@@ -448,8 +314,4 @@ 		exts' = map H.parseExtension exts ++ maybe [] snd (H.readExtensions $ T.unpack cts)
 		hasCPP = H.EnableExtension H.CPP `elem` exts'
 
-dropScope :: Functor f => f (N.Scoped l) -> f l
-dropScope = fmap (\(N.Scoped _ a) -> a)
-
-makeLenses ''Preloaded
 makeLenses ''AnalyzeEnv

@@ -0,0 +1,126 @@+{-# LANGUAGE CPP #-}
+
+module HsDev.Inspect.Definitions (
+	getSymbols,
+	getDecl
+	) where
+
+import Control.Lens
+import Control.Monad
+import Data.Data (Data)
+import Data.Generics.Uniplate.Data
+import Data.List
+import Data.Maybe
+import Data.Function
+import Data.Ord
+import Data.String
+import Data.Text (Text)
+import qualified Language.Haskell.Exts as H
+
+import HsDev.Symbols.Types
+import HsDev.Symbols.Parsed
+import HsDev.Symbols.Resolve (symbolUniqId)
+
+-- | Get top symbols
+getSymbols :: [H.Decl Ann] -> [Symbol]
+getSymbols decls =
+	map mergeSymbols .
+	groupBy ((==) `on` symbolUniqId) .
+	sortBy (comparing symbolUniqId) $
+	concatMap getDecl decls
+	where
+		mergeSymbols :: [Symbol] -> Symbol
+		mergeSymbols [] = error "impossible"
+		mergeSymbols [s] = s
+		mergeSymbols ss@(s:_) = Symbol
+			(view symbolId s)
+			(msum $ map (view symbolDocs) ss)
+			(msum $ map (view symbolPosition) ss)
+			(foldr1 mergeInfo $ map (view symbolInfo) ss)
+
+		mergeInfo :: SymbolInfo -> SymbolInfo -> SymbolInfo
+		mergeInfo (Function lt) (Function rt) = Function $ lt `mplus` rt
+		mergeInfo (PatConstructor las lt) (PatConstructor ras rt) = PatConstructor (if null las then ras else las) (lt `mplus` rt)
+		mergeInfo (Selector lt lp lc) (Selector rt rp rc)
+			| lt == rt && lp == rp = Selector lt lp (nub $ lc ++ rc)
+			| otherwise = Selector lt lp lc
+		mergeInfo l _ = l
+
+-- | Get symbols from declarations
+getDecl :: H.Decl Ann -> [Symbol]
+getDecl decl' = case decl' of
+	H.TypeDecl _ h _ -> [mkSymbol (tyName h) (Type (tyArgs h) [])]
+	H.TypeFamDecl _ h _ _ -> [mkSymbol (tyName h) (TypeFam (tyArgs h) [] Nothing)]
+	H.ClosedTypeFamDecl _ h _ _ _ -> [mkSymbol (tyName h) (TypeFam (tyArgs h) [] Nothing)]
+	H.DataDecl _ dt mctx h dcons _ -> mkSymbol nm ((getCtor dt) (tyArgs h) (getCtx mctx)) : concatMap (getConDecl nm) dcons where
+		nm = tyName h
+	H.GDataDecl _ dt mctx h _ gcons _ -> mkSymbol nm ((getCtor dt) (tyArgs h) (getCtx mctx)) : concatMap (getGConDecl nm) gcons where
+		nm = tyName h
+	H.DataFamDecl _ mctx h _ -> [mkSymbol (tyName h) (DataFam (tyArgs h) (getCtx mctx) Nothing)]
+	H.ClassDecl _ mctx h _ clsDecls -> mkSymbol nm (Class (tyArgs h) (getCtx mctx)) : concatMap (getClassDecl nm) (fromMaybe [] clsDecls) where
+		nm = tyName h
+	H.TypeSig _ ns tsig -> [mkSymbol n (Function (Just $ oneLinePrint tsig)) | n <- ns]
+	H.PatSynSig _ ns mas _ _ t -> [mkSymbol n (PatConstructor (maybe [] (map prp) mas) (Just $ oneLinePrint t)) | n <- ns'] where
+#if MIN_VERSION_haskell_src_exts(1,20,0)
+		ns' = ns
+#else
+		ns' = [ns]
+#endif
+	H.FunBind _ ms -> [mkSymbol (matchName m) (Function Nothing) | m <- ms] where
+		matchName (H.Match _ n _ _ _) = n
+		matchName (H.InfixMatch _ _ n _ _ _) = n
+	H.PatBind _ p _ _ -> [mkSymbol n (Function Nothing) | n <- patNames p] where
+		patNames :: H.Pat Ann -> [H.Name Ann]
+		patNames = childrenBi
+	H.PatSyn _ p _ _ -> case p of
+		H.PInfixApp _ _ qn _ -> [mkSymbol (qToName qn) (PatConstructor [] Nothing)]
+		H.PApp _ qn _ -> [mkSymbol (qToName qn) (PatConstructor [] Nothing)]
+		H.PRec _ qn fs -> mkSymbol (qToName qn) (PatConstructor [] Nothing) :
+			[mkSymbol (qToName n) (PatSelector Nothing Nothing (prp $ qToName qn)) | n <- (universeBi fs :: [H.QName Ann])]
+		_ -> []
+		where
+			qToName (H.Qual _ _ n) = n
+			qToName (H.UnQual _ n) = n
+			qToName _ = error "invalid qname"
+	_ -> []
+	where
+		tyName :: H.DeclHead Ann -> H.Name Ann
+		tyName = head . universeBi
+		tyArgs :: Data (ast Ann) => ast Ann -> [Text]
+		tyArgs n = map prp (universeBi n :: [H.TyVarBind Ann])
+		getCtx :: Maybe (H.Context Ann) -> [Text]
+		getCtx mctx = map prp (universeBi mctx :: [H.Asst Ann])
+		getCtor (H.DataType _) = Data
+		getCtor (H.NewType _) = NewType
+
+getConDecl :: H.Name Ann -> H.QualConDecl Ann -> [Symbol]
+getConDecl ptype (H.QualConDecl _ _ _ cdecl) = case cdecl of
+	H.ConDecl _ n ts -> [mkSymbol n (Constructor (map prp ts) (prp ptype))]
+	H.InfixConDecl _ lt n rt -> [mkSymbol n (Constructor (map prp [lt, rt]) (prp ptype))]
+	H.RecDecl _ n fs -> mkSymbol n (Constructor [prp t | H.FieldDecl _ _ t <- fs] (prp ptype)) :
+		[mkSymbol fn (Selector (Just $ prp ft) (prp ptype) [prp n]) | H.FieldDecl _ fns ft <- fs, fn <- fns]
+
+getGConDecl :: H.Name Ann -> H.GadtDecl Ann -> [Symbol]
+getGConDecl _ (H.GadtDecl _ n Nothing t) = [mkSymbol n (Constructor (map prp as) (prp res))] where
+	(as, res) = tyFunSplit t
+	tyFunSplit = go [] where
+		go as' (H.TyFun _ arg' res') = go (arg' : as') res'
+		go as' t' = (reverse as', t')
+getGConDecl ptype (H.GadtDecl _ n (Just fs) t) = mkSymbol n (Constructor [prp ft | H.FieldDecl _ _ ft <- fs] (prp t)) :
+	[mkSymbol fn (Selector (Just $ prp ft) (prp ptype) [prp n]) | H.FieldDecl _ fns ft <- fs, fn <- fns]
+
+getClassDecl :: H.Name Ann -> H.ClassDecl Ann -> [Symbol]
+getClassDecl pclass (H.ClsDecl _ (H.TypeSig _ ns tsig)) = [mkSymbol n (Method (Just $ oneLinePrint tsig) (prp pclass)) | n <- ns]
+getClassDecl _ _ = []
+
+prp :: H.Pretty a => a -> Text
+prp = fromString . H.prettyPrint
+
+
+mkSymbol :: H.Name Ann -> SymbolInfo -> Symbol
+mkSymbol nm = Symbol (SymbolId (fromName_ $ void nm) (ModuleId (fromString "") noLocation)) Nothing (nm ^? binders . defPos)
+
+
+-- | Print something in one line
+oneLinePrint :: (H.Pretty a, IsString s) => a -> s
+oneLinePrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode

@@ -1,11 +1,11 @@ module HsDev.Inspect.Order (
-	order
+	orderBy, order
 	) where
 
 import Control.Lens
-import Data.List
 import Data.Maybe
 import Data.String
+import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Language.Haskell.Exts as H
 
@@ -15,14 +15,14 @@ import System.Directory.Paths
 
 -- | Order source files so that dependencies goes first and we are able to resolve symbols and set fixities
-order :: [Preloaded] -> Either (DepsError Path) [Preloaded]
-order ps = do
+orderBy :: (a -> Maybe Preloaded) -> [a] -> Either (DepsError Path) [a]
+orderBy fn ps = do
 	order' <- linearize pdeps
-	return $ mapMaybe byFile order'
+	return $ mapMaybe (`M.lookup` pm) order'
 	where
-		pdeps = mconcat $ map getDeps ps
-		byFile f = find (\p -> (_preloadedId p ^? moduleLocation . moduleFile) == Just f) ps
-		files = S.fromList $ map _preloadedId ps ^.. each . moduleLocation . moduleFile
+		pdeps = mconcat $ mapMaybe (fmap getDeps . fn) ps
+		pm = M.fromList [(pfile, p) | p <- ps, pfile <- fn p ^.. _Just . preloadedId . moduleLocation . moduleFile]
+		files = S.fromList $ map fn ps ^.. each . _Just . preloadedId . moduleLocation . moduleFile
 		getDeps :: Preloaded -> Deps Path
 		getDeps p = deps mfile [ifile | ifile <- ifiles, S.member ifile files] where
 			H.Module _ _ _ idecls _ = _preloadedModule p
@@ -37,3 +37,6 @@ 				i <- fileTargets proj mfile
 				view infoSourceDirs i
 			ifiles = [normPath (joinPaths [mroot, dir, importPath imod]) | imod <- imods, dir <- if null dirs then [fromFilePath "."] else dirs]
+
+order :: [Preloaded] -> Either (DepsError Path) [Preloaded]
+order = orderBy Just

@@ -0,0 +1,490 @@+{-# LANGUAGE OverloadedStrings, TypeApplications, TypeOperators #-}
+
+module HsDev.Inspect.Resolve (
+	-- * Prepare
+	loadEnvironment, loadFixities, withEnv,
+	-- * Resolving
+	resolveModule, resolvePreloaded, resolve,
+	-- * Saving results
+	updateResolved, updateResolveds
+	) where
+
+import Control.Lens hiding ((.=))
+import Control.Monad.Catch
+import Data.Aeson
+import Data.Generics.Uniplate.Operations
+import Data.Functor
+import Data.Function
+import Data.List
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Ord
+import Data.String
+import qualified Data.Set as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Language.Haskell.Exts as H
+import qualified Language.Haskell.Names as N
+import qualified Language.Haskell.Names.Open as N
+import qualified Language.Haskell.Names.Annotated as N
+import qualified Language.Haskell.Names.Imports as N
+import qualified Language.Haskell.Names.Exports as N
+import qualified Language.Haskell.Names.ModuleSymbols as N
+import qualified Language.Haskell.Names.SyntaxUtils as N
+import System.Log.Simple
+import Text.Format
+
+import System.Directory.Paths
+import HsDev.Database.SQLite as SQLite
+import qualified HsDev.Display as Display
+import HsDev.Error
+import HsDev.Inspect.Definitions
+import HsDev.Inspect.Types
+import HsDev.Symbols
+import qualified HsDev.Symbols.HaskellNames as HN
+import HsDev.Symbols.Parsed as P
+import HsDev.Server.Types
+import HsDev.Util
+
+-- | Try resolve module symbols
+resolveModule :: MonadThrow m => Environment -> FixitiesTable -> Preloaded -> InspectM ModuleLocation ModuleTag m Resolved
+resolveModule env fixities p = inspectTag ResolvedNamesTag $ inspectUntag OnlyHeaderTag $ case H.parseFileContentsWithMode (p' ^. preloadedMode) (T.unpack $ p ^. preloaded) of
+	H.ParseFailed loc reason -> hsdevError $ InspectError $ "Parse failed at " ++ show loc ++ ": " ++ reason
+	H.ParseOk m -> return (resolve env m)
+	where
+		qimps = M.keys $ N.importTable env (p ^. preloadedModule)
+		p' = p { _preloadedMode = (_preloadedMode p) { H.fixities = Just (mapMaybe (`M.lookup` fixities) qimps) } }
+
+-- | Resolve just preloaded part of module, this will give imports and scope
+resolvePreloaded :: MonadThrow m => Environment -> Preloaded -> InspectM ModuleLocation ModuleTag m Resolved
+resolvePreloaded env = inspectTag ResolvedNamesTag . return . resolve env . view preloadedModule
+
+-- | Resolve parsed module
+resolve :: Environment -> H.Module H.SrcSpanInfo -> Resolved
+resolve env m = Resolved {
+	_resolvedModule = void mn,
+	_resolvedSource = annotated,
+	_resolvedDefs = getSymbols decls',
+	_resolvedImports = map (fromModuleName_ . void . H.importModule) idecls',
+	_resolvedExports = N.exportedSymbols tbl m,
+	_resolvedScope = tbl,
+	_resolvedFixities = [H.Fixity (void assoc) (fromMaybe 0 pr) (fixName opName)
+		| H.InfixDecl _ assoc pr ops <- decls', opName <- map getOpName ops] }
+	where
+		getOpName (H.VarOp _ nm) = nm
+		getOpName (H.ConOp _ nm) = nm
+		fixName o = H.Qual () (void mn) (void o)
+		itbl = N.importTable env m
+		tbl = N.moduleTable itbl m
+		-- Not using 'annotate' because we already computed needed tables
+		annotated = H.Module (noScope l) mhead' mpragmas' idecls' decls'
+		H.Module l mhead mpragmas idecls decls = m
+		mhead' = fmap scopeHead mhead
+		mpragmas' = fmap withNoScope mpragmas
+		scopeHead (H.ModuleHead lh mname mwarns mexports) = H.ModuleHead (noScope lh) (withNoScope mname) (fmap withNoScope mwarns) $
+			fmap (N.annotateExportSpecList tbl) mexports
+		idecls' = N.annotateImportDecls mn env idecls
+		decls' = map (N.annotateDecl (N.initialScope (N.dropAnn mn) tbl)) decls
+		mn = N.getModuleName m
+
+-- | Load environment from sql
+loadEnvironment :: SessionMonad m => Maybe Path -> m Environment
+loadEnvironment mcabal = transaction_ Deferred $ do
+	sendLog Trace $ "loading environment for {}" ~~ fromMaybe "<standalone>" mcabal
+	env <- query @_ @(Only (H.ModuleName ()) :. N.Symbol)
+		(toQuery $ mconcat [
+			select_ ["em.name"],
+			from_ ["projects_modules_scope as ps", "exports as e", "modules as em"],
+			where_ [
+				"ps.cabal is ?",
+				"ps.module_id = em.id",
+				"e.symbol_id = s.id",
+				"e.module_id = em.id"],
+			qNSymbol "m" "s"])
+		(Only mcabal)
+	return $ M.fromList $ do
+		group' <- groupBy ((==) `on` fst) . sortBy (comparing fst) $ [(m, s) | (Only m :. s) <- env]
+		let
+			(gmod:_, gsyms) = unzip group'
+		return (gmod, gsyms)
+
+-- | Load fixities from sql
+loadFixities :: SessionMonad m => Maybe Path -> m FixitiesTable
+loadFixities mcabal = transaction_ Deferred $ do
+	fixities' <- query @_ @(Only Value)
+		(toQuery $ mconcat [
+			select_ ["m.fixities"],
+			from_ ["projects_modules_scope as ps", "modules as m"],
+			where_ [
+				"ps.cabal is ?",
+				"ps.module_id = m.id",
+				"m.fixities is not null"]])
+		(Only mcabal)
+	return $ mconcat [M.singleton n f |
+		f@(H.Fixity _ _ n) <- concat (mapMaybe (fromJSON' . fromOnly) fixities')]
+
+-- | Run with temporary table for environment
+withEnv :: SessionMonad m => Maybe Path -> m a -> m a
+withEnv mcabal = withTemporaryTable "env" ["module text not null", "name text not null", "what text not null", "id integer not null"] . (initEnv >>) where
+	initEnv = transaction_ Immediate $ do
+		execute_ "create unique index env_id_index on env (id);"
+		execute_ "create unique index env_symbol_index on env (module, name, what);"
+		executeNamed "insert into env select m.name, s.name, s.what, min(s.id) from modules as m, symbols as s where m.id = s.module_id and s.id in (select distinct e.symbol_id from exports as e where e.module_id in (select ps.module_id from projects_modules_scope as ps where ps.cabal is :cabal)) group by m.name, s.name, s.what;" [
+			":cabal" := mcabal]
+		[Only cnt] <- query_ @(Only Int) "select count(*) from env;"
+		sendLog Trace $ "created env table with {} symbols" ~~ cnt
+
+-- | Save results in sql, also updates temporary environment table
+updateResolved :: SessionMonad m => InspectedResolved -> m ()
+updateResolved im = scope "update-resolved" $ do
+	_ <- upsertResolved im
+	insertResolvedSymbols im
+
+-- | Save results in sql, updated temporary env table
+updateResolveds :: SessionMonad m => Maybe Path -> [InspectedResolved] -> m ()
+updateResolveds mcabal ims = scope "update-resolveds" $ withEnv mcabal $ do
+	ids <- transaction_ Immediate $ mapM upsertResolved ims
+	updateResolvedsSymbols (zip ids ims)
+
+upsertResolved :: SessionMonad m => InspectedResolved -> m Int
+upsertResolved im = do
+	mmid <- lookupModuleLocation (im ^. inspectedKey)
+	case mmid of
+		Nothing -> do
+			execute "insert into modules (file, cabal, install_dirs, package_name, package_version, installed_name, other_location, name, docs, fixities, tags, inspection_error, inspection_time, inspection_opts) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
+				moduleData
+			lastRow
+		Just mid' -> do
+			execute "update modules set file = ?, cabal = ?, install_dirs = ?, package_name = ?, package_version = ?, installed_name = ?, other_location = ?, name = ?, docs = ?, fixities = ?, tags = ?, inspection_error = ?, inspection_time = ?, inspection_opts = ? where id == ?;"
+				(moduleData :. Only mid')
+			return mid'
+	where
+		moduleData = (
+			im ^? inspectedKey . moduleFile . path,
+			im ^? inspectedKey . moduleProject . _Just . projectCabal,
+			fmap (encode . map (view path)) (im ^? inspectedKey . moduleInstallDirs),
+			im ^? inspectedKey . modulePackage . packageName,
+			im ^? inspectedKey . modulePackage . packageVersion,
+			im ^? inspectedKey . installedModuleName,
+			im ^? inspectedKey . otherLocationName)
+			:. (
+			msum [im ^? inspected . resolvedModule . moduleName_, im ^? inspectedKey . installedModuleName],
+			Nothing @Text,
+			fmap encode $ im ^? inspected . resolvedFixities,
+			encode $ asDict $ im ^. inspectionTags,
+			fmap show $ im ^? inspectionResult . _Left)
+			:.
+			fromMaybe InspectionNone (im ^? inspection)
+		asDict tags = object [fromString (Display.display t) .= True | t <- S.toList tags]
+
+insertResolvedSymbols :: SessionMonad m => InspectedResolved -> m ()
+insertResolvedSymbols im = do
+	Just mid <- lookupModuleLocation (im ^. inspectedKey)
+	removeModuleContents mid
+	insertModuleImports mid (im ^?! inspected . resolvedSource)
+	insertModuleDefs mid (im ^.. inspected . resolvedDefs . each)
+	insertExportSymbols mid (im ^.. inspected . resolvedExports . each)
+	insertScopeSymbols mid (M.toList (im ^?! inspected . resolvedScope))
+	insertResolvedNames mid (im ^?! inspected . resolvedSource)
+	updateEnvironment mid
+	where
+		insertModuleImports :: SessionMonad m => Int -> Parsed -> m ()
+		insertModuleImports mid p = scope "imports" $ do
+			let
+				imps = childrenBi p :: [H.ImportDecl Ann]
+				importRow idecl@(H.ImportDecl _ mname qual _ _ _ alias specList) = (
+					mid,
+					idecl ^. pos . positionLine,
+					getModuleName mname,
+					qual,
+					fmap getModuleName alias,
+					maybe False getHiding specList,
+					fmap makeImportList specList)
+			executeMany "insert into imports (module_id, line, module_name, qualified, alias, hiding, import_list) values (?, ?, ?, ?, ?, ?, ?);"
+				(map importRow imps)
+			executeNamed "update imports set import_module_id = (select im.id from modules as im, projects_modules_scope as ps where ((ps.cabal is null and :cabal is null) or (ps.cabal == :cabal)) and ps.module_id == im.id and im.name == imports.module_name) where module_id == :module_id;" [
+			 ":cabal" := im ^? inspectedKey . moduleProject . _Just . projectCabal,
+			 ":module_id" := mid]
+			where
+				getModuleName (H.ModuleName _ s) = s
+				getHiding (H.ImportSpecList _ h _) = h
+
+				makeImportList (H.ImportSpecList _ _ specs) = encode $ map asJson specs
+				asJson (H.IVar _ nm) = object ["name" .= fromName_ (void nm), "what" .= id @String "var"]
+				asJson (H.IAbs _ ns nm) = object ["name" .= fromName_ (void nm), "what" .= id @String "abs", "ns" .= fromNamespace ns] where
+					fromNamespace :: H.Namespace l -> Maybe String
+					fromNamespace (H.NoNamespace _) = Nothing
+					fromNamespace (H.TypeNamespace _) = Just "type"
+					fromNamespace (H.PatternNamespace _) = Just "pat"
+				asJson (H.IThingAll _ nm) = object ["name" .= fromName_ (void nm), "what" .= id @String "all"]
+				asJson (H.IThingWith _ nm cs) = object ["name" .= fromName_ (void nm), "what" .= id @String "with", "list" .= map (fromName_ . void . toName') cs] where
+					toName' (H.VarName _ n') = n'
+					toName' (H.ConName _ n') = n'
+
+		insertModuleDefs :: SessionMonad m => Int -> [Symbol] -> m ()
+		insertModuleDefs mid syms = scope "defs" $ do
+			executeMany "insert into symbols (name, module_id, docs, line, column, what, type, parent, constructors, args, context, associate, pat_type, pat_constructor) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" $ do
+				sym <- syms
+				return $ (
+					sym ^. symbolId . symbolName,
+					mid,
+					sym ^. symbolDocs,
+					sym ^? symbolPosition . _Just . positionLine,
+					sym ^? symbolPosition . _Just . positionColumn)
+					:.
+					(sym ^. symbolInfo)
+			execute "insert or replace into env (module, name, what, id) select ?, s.name, s.what, s.id from symbols as s where s.module_id = ?;" (im ^?! inspected . resolvedModule . moduleName_, mid)
+
+		insertExportSymbols :: SessionMonad m => Int -> [N.Symbol] -> m ()
+		insertExportSymbols mid syms = scope "exports" $ do
+			executeMany "insert into exports (module_id, symbol_id) select ?, env.id from env where env.module = ? and env.name = ? and env.what = ?;" $ do
+				sym <- syms
+				return (
+					mid,
+					N.symbolModule sym,
+					N.symbolName sym,
+					symbolType (HN.fromSymbol sym))
+
+		insertScopeSymbols :: SessionMonad m => Int -> [(Name, [N.Symbol])] -> m ()
+		insertScopeSymbols mid snames = scope "scope" $ do
+			executeMany "insert into scopes (module_id, qualifier, name, symbol_id) select ?, ?, ?, env.id from env where env.module = ? and env.name = ? and env.what = ?;" $ do
+				(qn, syms) <- snames
+				sym <- syms
+				return (
+					mid,
+					nameModule qn,
+					nameIdent qn,
+					N.symbolModule sym,
+					N.symbolName sym,
+					symbolType (HN.fromSymbol sym))
+
+		insertResolvedNames :: SessionMonad m => Int -> Parsed -> m ()
+		insertResolvedNames mid p = scope "resolved" $ do
+			insertNames
+			replaceQNames
+			executeNamed "update names set resolved_module = :module, (resolved_name, resolved_what) = (select s.name, s.what from symbols as s where s.module_id = names.module_id and s.line = names.line and s.column = names.column) where module_id = :module_id and (line, column) = (def_line, def_column) and resolved_module is null and resolved_name is null;" [
+				":module" := im ^?! inspected . resolvedModule . moduleName_,
+				":module_id" := mid]
+			setResolvedSymbolIds
+			where
+				insertNames = executeMany insertQuery namesData
+				replaceQNames = executeMany insertQuery qnamesData
+				setResolvedSymbolIds = execute "update names set symbol_id = (select sc.symbol_id from scopes as sc, symbols as s, modules as m 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 and s.id == sc.symbol_id and m.id == s.module_id and s.name == names.resolved_name and s.what == names.resolved_what and m.name == names.resolved_module) where module_id == ? and resolved_module is not null and resolved_name is not null and resolved_what 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, resolved_what, resolve_error) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
+				namesData = map toData $ p ^.. P.names
+				qnamesData = map toQData $ p ^.. P.qnames
+				toData name = (
+					mid,
+					Nothing :: Maybe Text,
+					fromName_ $ void name,
+					name ^. P.pos . positionLine,
+					name ^. P.pos . positionColumn,
+					name ^. P.regionL . regionTo . positionLine,
+					name ^. P.regionL . regionTo . positionColumn)
+					:. (
+					name ^? P.defPos . positionLine,
+					name ^? P.defPos . positionColumn,
+					(name ^? P.resolvedName) >>= nameModule,
+					nameIdent <$> (name ^? P.resolvedName),
+					fmap (symbolType . HN.fromSymbol) $ name ^? P.symbolL,
+					P.resolveError name)
+				toQData qname = (
+					mid,
+					nameModule $ void qname,
+					nameIdent $ void qname,
+					qname ^. P.pos . positionLine,
+					qname ^. P.pos . positionColumn,
+					qname ^. P.regionL . regionTo . positionLine,
+					qname ^. P.regionL . regionTo . positionColumn)
+					:. (
+					qname ^? P.defPos . positionLine,
+					qname ^? P.defPos . positionColumn,
+					(qname ^? P.resolvedName) >>= nameModule,
+					nameIdent <$> (qname ^? P.resolvedName),
+					fmap (symbolType . HN.fromSymbol) $ qname ^? P.symbolL,
+					P.resolveError qname)
+
+		updateEnvironment :: SessionMonad m => Int -> m ()
+		updateEnvironment mid = do
+			execute "insert or replace into env (module, name, what, id) select m.name, s.name, s.what, min(s.id) from modules as m, symbols as s, exports as e where m.id = s.module_id and s.id = e.symbol_id and e.module_id = ? group by m.name, s.name, s.what;" (Only mid)
+
+updateResolvedsSymbols :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+updateResolvedsSymbols ims = bracket_ initTemps dropTemps $ do
+	initUpdatedIds ims
+
+	removeModulesContents
+	transaction_ Immediate $ insertModulesDefs ims
+	transaction_ Immediate $ insertModulesImports ims
+	transaction_ Immediate $ insertExportsSymbols ims
+	transaction_ Immediate $ do
+		insertScopesSymbols ims
+		insertResolvedsNames ims
+	commitTemps
+
+	where
+		initTemps :: SessionMonad m => m ()
+		initTemps = do
+			execute_ "create temporary table updated_ids (id integer not null, cabal text, module text not null, only_header int not null, dirty int not null);"
+			execute_ "create temporary table updating_scopes as select * from scopes where 0;"
+			execute_ "create index updating_scopes_name_index on updating_scopes (module_id, name);"
+			execute_ "create temporary table updating_names as select * from names where 0;"
+			execute_ "create unique index updating_names_position_index on updating_names (module_id, line, column, line_to, column_to);"
+
+		dropTemps :: SessionMonad m => m ()
+		dropTemps = do
+			execute_ "drop table if exists updated_ids;"
+			execute_ "drop table if exists updating_scopes;"
+			execute_ "drop table if exists updating_names;"
+
+		commitTemps :: SessionMonad m => m ()
+		commitTemps = do
+			transaction_ Immediate $ execute_ "insert into scopes select * from updating_scopes;"
+			transaction_ Immediate $ execute_ "insert into names select * from updating_names;"
+
+		initUpdatedIds :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+		initUpdatedIds imods = transaction_ Immediate $ do
+			execute_ "create unique index updated_ids_id_index on updated_ids (id);"
+			execute_ "create index updated_ids_module_index on updated_ids (module);"
+			executeMany "insert into updated_ids (id, cabal, module, only_header, dirty) values (?, ?, ?, ?, ?);" $ do
+				(mid, im) <- imods
+				return (
+					mid,
+					im ^? inspectedKey . moduleProject . _Just . projectCabal,
+					im ^?! inspected . resolvedModule . moduleName_,
+					hasTag OnlyHeaderTag im,
+					hasTag DirtyTag im)
+
+		removeModulesContents :: SessionMonad m => m ()
+		removeModulesContents = scope "remove-modules-contents" $ do
+			transaction_ Immediate $ do
+				execute_ "delete from symbols where module_id in (select id from updated_ids where not only_header or not dirty);"
+				execute_ "update symbols set line = null, column = null where module_id in (select id from updated_ids where only_header and dirty);"
+				execute_ "delete from imports where module_id in (select id from updated_ids);"
+				execute_ "delete from exports where module_id in (select id from updated_ids);"
+
+			transaction_ Immediate $ execute_ "delete from scopes where module_id in (select id from updated_ids);"
+			transaction_ Immediate $ execute_ "delete from names where module_id in (select id from updated_ids);"
+			transaction_ Immediate $ execute_ "delete from types where module_id in (select id from updated_ids);"
+
+		insertModulesImports :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+		insertModulesImports imods = scope "imports" $ do
+			executeMany "insert into imports (module_id, line, module_name, qualified, alias, hiding, import_list) values (?, ?, ?, ?, ?, ?, ?);" $ do
+				(mid, im) <- imods
+				let
+					p = im ^?! inspected . resolvedSource
+				idecl@(H.ImportDecl _ mname qual _ _ _ alias specList) <- childrenBi p :: [H.ImportDecl Ann]
+				return (
+					mid,
+					idecl ^. pos . positionLine,
+					getModuleName mname,
+					qual,
+					fmap getModuleName alias,
+					maybe False getHiding specList,
+					fmap makeImportList specList)
+			execute_ "update imports set import_module_id = (select im.id from updated_ids as u, modules as im, projects_modules_scope as ps where ((ps.cabal is null and u.cabal is null) or (ps.cabal == u.cabal)) and ps.module_id == im.id and im.name == imports.module_name) where module_id in (select u.id from updated_ids as u);"
+			where
+				getModuleName (H.ModuleName _ s) = s
+				getHiding (H.ImportSpecList _ h _) = h
+
+				makeImportList (H.ImportSpecList _ _ specs) = encode $ map asJson specs
+				asJson (H.IVar _ nm) = object ["name" .= fromName_ (void nm), "what" .= id @String "var"]
+				asJson (H.IAbs _ ns nm) = object ["name" .= fromName_ (void nm), "what" .= id @String "abs", "ns" .= fromNamespace ns] where
+					fromNamespace :: H.Namespace l -> Maybe String
+					fromNamespace (H.NoNamespace _) = Nothing
+					fromNamespace (H.TypeNamespace _) = Just "type"
+					fromNamespace (H.PatternNamespace _) = Just "pat"
+				asJson (H.IThingAll _ nm) = object ["name" .= fromName_ (void nm), "what" .= id @String "all"]
+				asJson (H.IThingWith _ nm cs) = object ["name" .= fromName_ (void nm), "what" .= id @String "with", "list" .= map (fromName_ . void . toName') cs] where
+					toName' (H.VarName _ n') = n'
+					toName' (H.ConName _ n') = n'
+
+		insertModulesDefs :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+		insertModulesDefs imods = scope "defs" $ do
+			executeMany "insert into symbols (name, module_id, docs, line, column, what, type, parent, constructors, args, context, associate, pat_type, pat_constructor) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" $ do
+				(mid, im) <- imods
+				sym <- im ^.. inspected . resolvedDefs . each
+				return $ (
+					sym ^. symbolId . symbolName,
+					mid,
+					sym ^. symbolDocs,
+					sym ^? symbolPosition . _Just . positionLine,
+					sym ^? symbolPosition . _Just . positionColumn)
+					:.
+					(sym ^. symbolInfo)
+			execute_ "insert or replace into env (module, name, what, id) select m.name, s.name, s.what, s.id from modules as m, symbols as s where m.id in (select id from updated_ids) and s.module_id = m.id;"
+
+		insertExportsSymbols :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+		insertExportsSymbols imods = scope "exports" $ executeMany "insert into exports (module_id, symbol_id) select ?, env.id from env where env.module = ? and env.name = ? and env.what = ?;" $ do
+			(mid, im) <- imods
+			sym <- im ^.. inspected . resolvedExports . each
+			return (
+				mid,
+				N.symbolModule sym,
+				N.symbolName sym,
+				symbolType (HN.fromSymbol sym))
+
+		insertScopesSymbols :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+		insertScopesSymbols imods = scope "scope" $ executeMany "insert into updating_scopes (module_id, qualifier, name, symbol_id) select ?, ?, ?, env.id from env where env.module = ? and env.name = ? and env.what = ?;" $ do
+			(mid, im) <- imods
+			(qn, syms) <- M.toList (im ^. inspected . resolvedScope)
+			sym <- syms
+			return (
+				mid,
+				nameModule qn,
+				nameIdent qn,
+				N.symbolModule sym,
+				N.symbolName sym,
+				symbolType (HN.fromSymbol sym))
+
+		insertResolvedsNames :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
+		insertResolvedsNames imods = scope "names" $ do
+			insertNames
+			replaceQNames
+			resolveGlobalBinders
+			setResolvedsSymbolIds
+			where
+				insertNames = executeMany insertQuery namesData
+				replaceQNames = executeMany insertQuery qnamesData
+				resolveGlobalBinders = execute_ "update updating_names set (resolved_module, resolved_name, resolved_what) = (select u.module, s.name, s.what from updated_ids as u, symbols as s where u.id = s.module_id and s.module_id = updating_names.module_id and s.line = updating_names.line and s.column = updating_names.column) where (line, column) = (def_line, def_column) and resolved_module is null and resolved_name is null;"
+				setResolvedsSymbolIds = execute_ "update updating_names set symbol_id = (select sc.symbol_id from updating_scopes as sc, symbols as s, modules as m where updating_names.module_id == sc.module_id and ((updating_names.qualifier is null and sc.qualifier is null) or (updating_names.qualifier == sc.qualifier)) and updating_names.name == sc.name and s.id == sc.symbol_id and m.id == s.module_id and s.name == updating_names.resolved_name and s.what == updating_names.resolved_what and m.name == updating_names.resolved_module) where resolved_module is not null and resolved_name is not null and resolved_what is not null;"
+				insertQuery = "insert or replace into updating_names (module_id, qualifier, name, line, column, line_to, column_to, def_line, def_column, resolved_module, resolved_name, resolved_what, resolve_error) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
+
+				namesData = map (uncurry toData) $ do
+					(mid, im) <- imods
+					n <- im ^.. inspected . resolvedSource . P.names
+					return (mid, n)
+				qnamesData = map (uncurry toQData) $ do
+					(mid, im) <- imods
+					n <- im ^.. inspected . resolvedSource . P.qnames
+					return (mid, n)
+
+				toData mid name = (
+					mid,
+					Nothing :: Maybe Text,
+					fromName_ $ void name,
+					name ^. P.pos . positionLine,
+					name ^. P.pos . positionColumn,
+					name ^. P.regionL . regionTo . positionLine,
+					name ^. P.regionL . regionTo . positionColumn)
+					:. (
+					name ^? P.defPos . positionLine,
+					name ^? P.defPos . positionColumn,
+					(name ^? P.resolvedName) >>= nameModule,
+					nameIdent <$> (name ^? P.resolvedName),
+					fmap (symbolType . HN.fromSymbol) $ name ^? P.symbolL,
+					P.resolveError name)
+				toQData mid qname = (
+					mid,
+					nameModule $ void qname,
+					nameIdent $ void qname,
+					qname ^. P.pos . positionLine,
+					qname ^. P.pos . positionColumn,
+					qname ^. P.regionL . regionTo . positionLine,
+					qname ^. P.regionL . regionTo . positionColumn)
+					:. (
+					qname ^? P.defPos . positionLine,
+					qname ^? P.defPos . positionColumn,
+					(qname ^? P.resolvedName) >>= nameModule,
+					nameIdent <$> (qname ^? P.resolvedName),
+					fmap (symbolType . HN.fromSymbol) $ qname ^? P.symbolL,
+					P.resolveError qname)

@@ -0,0 +1,100 @@+{-# LANGUAGE TemplateHaskell #-}
+
+module HsDev.Inspect.Types (
+	Preloaded(..), preloadedId, preloadedMode, preloadedModule, asModule, preloaded,
+	InspectedPreloaded,
+	Environment, FixitiesTable,
+	Resolved(..), resolvedModule, resolvedSource, resolvedDefs, resolvedImports, resolvedExports, resolvedScope, resolvedFixities,
+	InspectedResolved,
+
+	resolvedEnv, resolvedFixitiesTable,
+
+	dropScope, noScope, withNoScope
+	) where
+
+import Control.DeepSeq
+import Control.Lens
+import Data.Functor
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Language.Haskell.Exts as H
+import qualified Language.Haskell.Names as N
+import qualified Language.Haskell.Names.GlobalSymbolTable as N
+
+import HsDev.Symbols.Types
+import HsDev.Symbols.Parsed (Parsed)
+
+-- | Preloaded module with contents and extensions
+data Preloaded = Preloaded {
+	_preloadedId :: ModuleId,
+	_preloadedMode :: H.ParseMode,
+	_preloadedModule :: H.Module H.SrcSpanInfo,
+	-- ^ Loaded module head without declarations
+	_preloaded :: Text }
+
+instance NFData Preloaded where
+	rnf (Preloaded mid _ _ cts) = rnf mid `seq` rnf cts
+
+asModule :: Lens' Preloaded Module
+asModule = lens g' s' where
+	g' p = Module {
+		_moduleId = _preloadedId p,
+		_moduleDocs = Nothing,
+		_moduleImports = map (fromModuleName_ . void . H.importModule) idecls,
+		_moduleExports = mempty,
+		_moduleFixities = mempty,
+		_moduleScope = mempty,
+		_moduleSource = Just $ fmap (N.Scoped N.None) $ _preloadedModule p }
+		where
+			H.Module _ _ _ idecls _ = _preloadedModule p
+	s' p m = p {
+		_preloadedId = _moduleId m,
+		_preloadedModule = maybe (_preloadedModule p) dropScope (_moduleSource m) }
+
+type InspectedPreloaded = Inspected ModuleLocation ModuleTag Preloaded
+
+-- | Symbols environment, used to resolve names in source
+type Environment = N.Environment
+
+-- | Fixities environment, needed to parse source
+type FixitiesTable = Map Name H.Fixity
+
+-- | Resolved module
+data Resolved = Resolved {
+	_resolvedModule :: H.ModuleName (),
+	_resolvedSource :: Parsed,
+	_resolvedDefs :: [Symbol],
+	_resolvedImports :: [Text],
+	_resolvedExports :: [N.Symbol],
+	_resolvedScope :: N.Table,
+	_resolvedFixities :: [H.Fixity] }
+
+instance NFData Resolved where
+	rnf (Resolved _ _ defs imps _ _ _) = rnf defs `seq` rnf imps
+
+-- | Like @InspectedModule@, but for @Resolved@
+type InspectedResolved = Inspected ModuleLocation ModuleTag Resolved
+
+-- | Get environment for resolved module
+resolvedEnv :: Resolved -> Environment
+resolvedEnv r = M.singleton (_resolvedModule r) (_resolvedExports r)
+
+-- | Get fixities table from resolved module
+resolvedFixitiesTable :: Resolved -> FixitiesTable
+resolvedFixitiesTable r = mconcat [M.singleton n f | f@(H.Fixity _ _ n) <- _resolvedFixities r]
+
+-- | Drop extra info
+dropScope :: Functor f => f (N.Scoped l) -> f l
+dropScope = fmap (\(N.Scoped _ a) -> a)
+
+-- | Empty scope info
+noScope :: l -> N.Scoped l
+noScope = N.Scoped N.None
+
+-- | Set empty scope
+withNoScope :: Functor f => f l -> f (N.Scoped l)
+withNoScope = fmap noScope
+
+makeLenses ''Preloaded
+makeLenses ''Resolved

@@ -17,6 +17,8 @@ import Distribution.Text (disp)
 import System.FilePath
 
+import GHC.Paths
+
 import HsDev.PackageDb.Types
 import HsDev.Error
 import HsDev.Symbols.Location
@@ -27,22 +29,22 @@ -- | Get path to package-db
 packageDbPath :: PackageDb -> IO Path
 packageDbPath GlobalDb = do
-	out <- fmap lines $ runTool_ "ghc-pkg" ["list", "--global"]
+	out <- fmap lines $ runTool_ ghc_pkg ["list", "--global"]
 	case out of
 		(fpath:_) -> return $ fromFilePath $ normalise fpath
-		[] -> hsdevError $ ToolError "ghc-pkg" "empty output, expecting path to global package-db"
+		[] -> hsdevError $ ToolError ghc_pkg "empty output, expecting path to global package-db"
 packageDbPath UserDb = do
-	out <- fmap lines $ runTool_ "ghc-pkg" ["list", "--user"]
+	out <- fmap lines $ runTool_ ghc_pkg ["list", "--user"]
 	case out of
 		(fpath:_) -> return $ fromFilePath $ normalise fpath
-		[] -> hsdevError $ ToolError "ghc-pkg" "empty output, expecting path to user package db"
+		[] -> hsdevError $ ToolError ghc_pkg "empty output, expecting path to user package db"
 packageDbPath (PackageDb fpath) = return fpath
 
 -- | Read package-db conf files
 readPackageDb :: PackageDb -> IO (Map ModulePackage [ModuleLocation])
 readPackageDb pdb = do
 	p <- packageDbPath pdb
-	mlibdir <- fmap (listToMaybe . lines) $ runTool_ "ghc" ["--print-libdir"]
+	mlibdir <- fmap (listToMaybe . lines) $ runTool_ ghc ["--print-libdir"]
 	confs <- fmap (filter isConf) $ directoryContents (p ^. path)
 	fmap M.unions $ forM confs $ \conf -> do
 		cts <- readFileUtf8 conf
@@ -58,6 +60,6 @@ 			pmods = map (InstalledModule (map fromFilePath $ libraryDirs pinfo) pname) names
 			names = map (pack . show . disp) (exposedModules pinfo) ++ map (pack . show . disp) (hiddenModules pinfo)
 		subst Nothing f = f
-		subst (Just libdir) f = case splitPaths f of
-			("$topdir":rest) -> joinPaths (fromFilePath libdir : rest)
+		subst (Just libdir') f = case splitPaths f of
+			("$topdir":rest) -> joinPaths (fromFilePath libdir' : rest)
 			_ -> f

@@ -2,7 +2,8 @@ 
 module HsDev.PackageDb.Types (
 	PackageDb(..), packageDb,
-	PackageDbStack(..), packageDbStack, globalDb, userDb, fromPackageDbs,
+	PackageDbStack(..), packageDbStack, mkPackageDbStack,
+	globalDb, userDb, fromPackageDbs,
 	topPackageDb, packageDbs, packageDbStacks,
 	isSubStack,
 
@@ -86,6 +87,10 @@ 
 instance Paths PackageDbStack where
 	paths f (PackageDbStack ps) = PackageDbStack <$> (each . paths) f ps
+
+-- | Make @PackageDbStack@ from list of @PackageDb@
+mkPackageDbStack :: [PackageDb] -> PackageDbStack
+mkPackageDbStack = PackageDbStack . reverse . dropWhile (== GlobalDb)
 
 -- | Global db stack
 globalDb :: PackageDbStack

@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Project.Types (
-	Project(..), projectName, projectPath, projectCabal, projectDescription, project,
+	Project(..), projectName, projectPath, projectCabal, projectDescription, projectPackageDbStack, project,
 	ProjectDescription(..), projectVersion, projectLibrary, projectExecutables, projectTests, infos, targetInfos,
 	Target(..), TargetInfo(..), targetInfoName, targetBuildInfo, targetInfoMain, targetInfoModules, targetInfo,
 	Library(..), libraryModules, libraryBuildInfo,
@@ -27,6 +27,7 @@ 
 import System.Directory.Paths
 import HsDev.Display
+import HsDev.PackageDb.Types
 import HsDev.Util
 
 -- | Cabal project
@@ -34,11 +35,11 @@ 	_projectName :: Text,
 	_projectPath :: Path,
 	_projectCabal :: Path,
-	_projectDescription :: Maybe ProjectDescription }
-		deriving (Read)
+	_projectDescription :: Maybe ProjectDescription,
+	_projectPackageDbStack :: Maybe PackageDbStack }
 
 instance NFData Project where
-	rnf (Project n p c _) = rnf n `seq` rnf p `seq` rnf c
+	rnf (Project n p c _ dbs) = rnf n `seq` rnf p `seq` rnf c `seq` rnf dbs
 
 instance Eq Project where
 	l == r = _projectCabal l == _projectCabal r
@@ -64,17 +65,19 @@ 		"name" .= _projectName p,
 		"path" .= _projectPath p,
 		"cabal" .= _projectCabal p,
-		"description" .= _projectDescription p]
+		"description" .= _projectDescription p,
+		"package-db-stack" .= _projectPackageDbStack p]
 
 instance FromJSON Project where
 	parseJSON = withObject "project" $ \v -> Project <$>
 		v .:: "name" <*>
 		v .:: "path" <*>
 		v .:: "cabal" <*>
-		v .:: "description"
+		v .:: "description" <*>
+		v .:: "package-db-stack"
 
 instance Paths Project where
-	paths f (Project nm p c desc) = Project nm <$> paths f p <*> paths f c <*> traverse (paths f) desc
+	paths f (Project nm p c desc dbs) = Project nm <$> paths f p <*> paths f c <*> traverse (paths f) desc <*> pure dbs
 
 -- | Make project by .cabal file
 project :: FilePath -> Project
@@ -82,7 +85,8 @@ 	_projectName = fromFilePath . takeBaseName . takeDirectory $ cabal,
 	_projectPath = fromFilePath . takeDirectory $ cabal,
 	_projectCabal = fromFilePath cabal,
-	_projectDescription = Nothing }
+	_projectDescription = Nothing,
+	_projectPackageDbStack = Nothing }
 	where
 		file' = dropTrailingPathSeparator $ normalise file
 		cabal
@@ -170,7 +174,7 @@ 		"info" .= _libraryBuildInfo l]
 
 instance FromJSON Library where
-	parseJSON = withObject "library" $ \v -> Library <$> (fmap (T.split (== '.')) <$> v .:: "modules") <*> v .:: "info" where
+	parseJSON = withObject "library" $ \v -> Library <$> (fmap (T.split (== '.')) <$> v .:: "modules") <*> v .:: "info"
 
 instance Paths Library where
 	paths f (Library ms info) = Library ms <$> paths f info

@@ -5,8 +5,11 @@ 	isSandbox, guessSandboxType, sandboxFromPath,
 	findSandbox, searchSandbox, projectSandbox, sandboxPackageDbStack, searchPackageDbStack, restorePackageDbStack,
 
+	-- * package-db
+	userPackageDb,
+
 	-- * cabal-sandbox util
-	cabalSandboxLib, cabalSandboxPackageDb,
+	cabalSandboxPackageDb,
 
 	getModuleOpts, getProjectTargetOpts,
 
@@ -15,38 +18,34 @@ 	) where
 
 import Control.Applicative
-import Control.Arrow
 import Control.DeepSeq (NFData(..))
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import Control.Monad.Except
 import Control.Lens (view, makeLenses)
 import Data.Aeson
-import Data.List (find)
+import Data.List (find, intercalate)
 import Data.Maybe (isJust, fromMaybe)
+import Data.Maybe.JustIf
 import qualified Data.Text as T (unpack)
-import Distribution.Compiler
-import Distribution.System
-import qualified Distribution.Text as T (display)
+import System.Directory (getAppUserDataDirectory, doesDirectoryExist)
 import System.FilePath
 import System.Log.Simple (MonadLog(..))
 import Text.Format
 
 import System.Directory.Paths
 import HsDev.Display
+import HsDev.Error
 import HsDev.PackageDb
 import HsDev.Project.Types
 import HsDev.Scan.Browse (browsePackages)
 import HsDev.Stack hiding (path)
 import HsDev.Symbols (moduleOpts, projectTargetOpts)
 import HsDev.Symbols.Types (moduleId, Module(..), ModuleLocation(..), moduleLocation)
-import HsDev.Tools.Ghc.Worker (GhcM, tmpSession)
-import HsDev.Tools.Ghc.Compat as Compat
+import HsDev.Tools.Ghc.Worker (GhcM)
+import HsDev.Tools.Ghc.System (buildPath)
 import HsDev.Util (searchPath, directoryContents, cabalFile)
 
-import qualified GHC
-import qualified Packages as GHC
-
 data SandboxType = CabalSandbox | StackWork deriving (Eq, Ord, Read, Show, Enum, Bounded)
 
 data Sandbox = Sandbox { _sandboxType :: SandboxType, _sandbox :: Path } deriving (Eq, Ord)
@@ -125,8 +124,8 @@ -- | Get package-db stack for sandbox
 sandboxPackageDbStack :: Sandbox -> GhcM PackageDbStack
 sandboxPackageDbStack (Sandbox CabalSandbox fpath) = do
-	dir <- cabalSandboxPackageDb
-	return $ PackageDbStack [PackageDb $ fromFilePath $ view path fpath </> dir]
+	dir <- cabalSandboxPackageDb $ view path fpath
+	return $ PackageDbStack [PackageDb $ fromFilePath dir]
 sandboxPackageDbStack (Sandbox StackWork fpath) = liftM (view stackPackageDbStack) $ projectEnv $ takeDirectory (view path fpath)
 
 -- | Search package-db stack with user-db as default
@@ -145,23 +144,26 @@ 	sbox <- MaybeT $ liftIO $ searchSandbox p
 	lift $ sandboxPackageDbStack sbox
 
--- | Get actual sandbox build path: <arch>-<platform>-<compiler>-<version>
-cabalSandboxLib :: GhcM FilePath
-cabalSandboxLib = do
-	tmpSession globalDb ["-no-user-package-db"]
-	df <- GHC.getSessionDynFlags
-	let
-		res =
-			map (GHC.packageNameString &&& GHC.packageVersion) .
-			fromMaybe [] . Compat.pkgDatabase $ df
-		compiler = T.display buildCompilerFlavor
-		CompilerId _ version = buildCompilerId
-		ver = maybe (T.display version) T.display $ lookup compiler res
-	return $ T.display buildPlatform ++ "-" ++ compiler ++ "-" ++ ver
+-- | User package-db: <arch>-<os>-<version>
+userPackageDb :: GhcM FilePath
+userPackageDb = do
+	root <- liftIO $ getAppUserDataDirectory "ghc"
+	dir <- buildPath "{arch}-{os}-{version}"
+	return $ root </> dir
 
--- | Get sandbox package-db: <arch>-<platform>-<compiler>-<version>-packages.conf.d
-cabalSandboxPackageDb :: GhcM FilePath
-cabalSandboxPackageDb = liftM (++ "-packages.conf.d") cabalSandboxLib
+-- | Get sandbox package-db: <arch>-<os>-<compiler>-<version>-packages.conf.d
+cabalSandboxPackageDb :: FilePath -> GhcM FilePath
+cabalSandboxPackageDb root = do
+	dirs <- mapM (fmap (root </>) . buildPath) [
+		"{arch}-{os}-{compiler}-{version}-packages.conf.d",
+		"{arch}-{os/cabal}-{compiler}-{version}-packages.conf.d"]
+	mdir <- liftM msum $ forM dirs $ \dir -> do
+		justIf dir <$> liftIO (doesDirectoryExist dir)
+	case mdir of
+		Nothing -> hsdevError $ OtherError $ unlines [
+			"No suitable package-db found in sandbox, is it configured?",
+			"Searched in: {}" ~~ intercalate ", " dirs]
+		Just dir -> return dir
 
 -- | Options for GHC for module and project
 getModuleOpts :: [String] -> Module -> GhcM (PackageDbStack, [String])

@@ -130,7 +130,11 @@ enumRescan :: CommandMonad m => FilePath -> m ScanContents
 enumRescan fpath = Log.scope "enum-rescan" $ do
 	ms <- SQLite.query @_ @(ModuleLocation SQLite.:. Inspection)
-		(toQuery $ qModuleLocation `mappend` select_ ["ml.inspection_time", "ml.inspection_opts"] [] [] `mappend` where_ ["ml.file == ?"]) (SQLite.Only fpath)
+		(toQuery $ mconcat [
+			qModuleLocation "ml",
+			select_ ["ml.inspection_time", "ml.inspection_opts"],
+			where_ ["ml.file == ?"]])
+		(SQLite.Only fpath)
 	case ms of
 		[] -> do
 			Log.sendLog Log.Warning $ "file {} not found" ~~ fpath

@@ -20,7 +20,6 @@ import Data.List (groupBy, sort)
 import Data.Maybe
 import Data.String (fromString)
-import Data.Text (Text)
 import qualified Data.Set as S
 import Data.Version
 import Language.Haskell.Exts.Fixity
@@ -31,8 +30,7 @@ import HsDev.PackageDb
 import HsDev.Symbols
 import HsDev.Error
-import HsDev.Tools.Base (inspect)
-import HsDev.Tools.Ghc.Worker (GhcM, tmpSession)
+import HsDev.Tools.Ghc.Worker (GhcM, tmpSession, formatType)
 import HsDev.Tools.Ghc.Compat as Compat
 import HsDev.Util (ordNub)
 
@@ -44,13 +42,11 @@ import qualified GhcMonad as GHC (liftIO)
 import qualified Name as GHC
 import qualified IdInfo as GHC
-import qualified Outputable as GHC
 import qualified Packages as GHC
 import qualified PatSyn as GHC
 import qualified TyCon as GHC
 import qualified Type as GHC
 import qualified Var as GHC
-import qualified Pretty
 
 -- | Browse packages
 browsePackages :: [String] -> PackageDbStack -> GhcM [PackageConfig]
@@ -98,7 +94,7 @@ 	liftM catMaybes $ sequence [browseModule' lookupModuleId (cacheInTableM sidTbl) p m | (p, m) <- ms, ghcModuleLocation p m `S.member` mlocs']
 	where
 		browseModule' :: (GHC.PackageConfig -> GHC.Module -> GhcM ModuleId) -> (GHC.Name -> GhcM Symbol -> GhcM Symbol) -> GHC.PackageConfig -> GHC.Module -> GhcM (Maybe InspectedModule)
-		browseModule' modId' sym' p m = tryT $ inspect (ghcModuleLocation p m) (return $ InspectionAt 0 (map fromString opts)) (browseModule modId' sym' p m)
+		browseModule' modId' sym' p m = tryT $ runInspect (ghcModuleLocation p m) $ inspect_ (return $ InspectionAt 0 (map fromString opts)) (browseModule modId' sym' p m)
 		mlocs' = S.fromList mlocs
 
 browseModule :: (GHC.PackageConfig -> GHC.Module -> GhcM ModuleId) -> (GHC.Name -> GhcM Symbol -> GhcM Symbol) -> GHC.PackageConfig -> GHC.Module -> GhcM Module
@@ -137,17 +133,17 @@ 				_symbolInfo = fromMaybe (Function Nothing) (tyResult >>= showResult df) }
 		showResult :: GHC.DynFlags -> GHC.TyThing -> Maybe SymbolInfo
 		showResult dflags (GHC.AnId i) = case GHC.idDetails i of
-			GHC.RecSelId p _ -> Just $ Selector (Just $ formatType dflags $ GHC.varType i) parent ctors where
+			GHC.RecSelId p _ -> Just $ Selector (Just $ fromString $ formatType dflags $ GHC.varType i) parent ctors where
 				parent = fromString $ Compat.recSelParent p
 				ctors = map fromString $ Compat.recSelCtors p
-			GHC.ClassOpId cls -> Just $ Method (Just $ formatType dflags $ GHC.varType i) (fromString $ GHC.getOccString cls)
-			_ -> Just $ Function (Just $ formatType dflags $GHC.varType i)
+			GHC.ClassOpId cls -> Just $ Method (Just $ fromString $ formatType dflags $ GHC.varType i) (fromString $ GHC.getOccString cls)
+			_ -> Just $ Function (Just $ fromString $ formatType dflags $GHC.varType i)
 		showResult dflags (GHC.AConLike c) = case c of
 			GHC.RealDataCon d -> Just $ Constructor
-				(map (formatType dflags) $ GHC.dataConOrigArgTys d)
+				(map (fromString . formatType dflags) $ GHC.dataConOrigArgTys d)
 				(fromString $ GHC.getOccString (GHC.dataConTyCon d))
 			GHC.PatSynCon p -> Just $ PatConstructor
-				(map (formatType dflags) $ GHC.patSynArgs p)
+				(map (fromString . formatType dflags) $ GHC.patSynArgs p)
 				Nothing
 			-- TODO: Deal with `patSynFieldLabels` and `patSynFieldType`
 		showResult dflags (GHC.ATyCon t)
@@ -160,32 +156,12 @@ 			| GHC.isDataFamilyTyCon t = Just $ DataFam args ctx Nothing
 			| otherwise = Just $ Type [] []
 			where
-				args = map (formatType dflags . GHC.mkTyVarTy) $ GHC.tyConTyVars t
+				args = map (fromString . formatType dflags . GHC.mkTyVarTy) $ GHC.tyConTyVars t
 				ctx = case GHC.tyConClass_maybe t of
 					Nothing -> []
-					Just cls -> map (formatType dflags) $ GHC.classSCTheta cls
+					Just cls -> map (fromString . formatType dflags) $ GHC.classSCTheta cls
 		showResult _ _ = Nothing
 
-formatType :: GHC.DynFlags -> GHC.Type -> Text
-formatType dflag t = fromString $ showOutputable dflag (removeForAlls t)
-
-removeForAlls :: GHC.Type -> GHC.Type
-removeForAlls ty = removeForAlls' ty' tty' where
-	ty'  = GHC.dropForAlls ty
-	tty' = GHC.splitFunTy_maybe ty'
-
-removeForAlls' :: GHC.Type -> Maybe (GHC.Type, GHC.Type) -> GHC.Type
-removeForAlls' ty Nothing = ty
-removeForAlls' ty (Just (pre, ftype))
-	| GHC.isPredTy pre = GHC.mkFunTy pre (GHC.dropForAlls ftype)
-	| otherwise = ty
-
-showOutputable :: GHC.Outputable a => GHC.DynFlags -> a -> String
-showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . GHC.ppr
-
-showUnqualifiedPage :: GHC.DynFlags -> GHC.SDoc -> String
-showUnqualifiedPage dflag = renderStyle Pretty.LeftMode 0 . GHC.withPprStyleDoc dflag (Compat.unqualStyle dflag)
-
 tryT :: MonadCatch m => m a -> m (Maybe a)
 tryT act = catch (fmap Just act) (const (return Nothing) . (id :: SomeException -> SomeException))
 
@@ -214,7 +190,7 @@ 	dflags <- GHC.getSessionDynFlags
 	return [(p, m) |
 		p <- pkgs,
-		mn <- map Compat.exposedModuleName (GHC.exposedModules p),
+		mn <- map Compat.exposedModuleName (GHC.exposedModules p) ++ GHC.hiddenModules p,
 		m <- lookupModule_ dflags mn]
 
 -- Lookup module everywhere

@@ -20,8 +20,8 @@ import qualified Control.Concurrent.Chan as C
 import Control.Lens (set, traverseOf, view)
 import Control.Monad
+import Control.Monad.IO.Class
 import Control.Monad.Loops
-import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.Catch (bracket_, bracket, finally)
 import Data.Aeson hiding (Result, Error)
@@ -57,7 +57,7 @@ import HsDev.Tools.Ghc.Worker hiding (Session)
 import HsDev.Server.Types
 import HsDev.Server.Message
-import HsDev.Symbols.Location (ModuleLocation(..))
+import HsDev.Symbols.Location (ModuleLocation(..), globalDb)
 import qualified HsDev.Watcher as W
 import HsDev.Util
 
@@ -91,6 +91,7 @@ 	mmapPool <- Just <$> liftIO (createPool "hsdev")
 #endif
 	ghcw <- ghcWorker
+	liftIO $ inWorker ghcw $ tmpSession globalDb []
 	defs <- liftIO getDefines
 
 	session <- liftIO $ fixIO $ \sess -> do
@@ -136,8 +137,17 @@ 		tasksVar <- newMVar []
 		Update.onEvents_ watcher $ \evs -> withSession session $
 			void $ Client.runClient def $ Update.processEvents (withSession session . inSessionUpdater . void . Client.runClient def . Update.applyUpdates def) updaterTask tasksVar evs
-	liftIO $ runReaderT (runServerM $ watchDb >> act) session
+	liftIO $ runReaderT (runServerM $ (watchDb >> act) `finally` closeSession) session
+	where
+		closeSession = do
+			askSession sessionUpdater >>= liftIO . joinWorker
+			Log.sendLog Log.Info "updater worker stopped"
+			askSession sessionGhc >>= liftIO . joinWorker
+			Log.sendLog Log.Info "ghc worker stopped"
+			askSession sessionSqlDatabase >>= liftIO . SQLite.close
+			Log.sendLog Log.Info "sql connection closed"
 
+
 -- | Set initial watch: package-dbs, projects and standalone sources
 watchDb :: SessionMonad m => m ()
 watchDb = do
@@ -211,7 +221,7 @@ startServer_ sopts = startWorker (runServer sopts) id logAll
 
 stopServer :: Server -> IO ()
-stopServer s = sendServer_ s ["exit"] >> stopWorker s
+stopServer s = sendServer_ s ["exit"] >> joinWorker s
 
 withServer :: ServerOpts -> (Server -> IO a) -> IO a
 withServer sopts = bracket (startServer sopts) stopServer

@@ -32,19 +32,18 @@ 
 import HsDev.Server.Base
 import HsDev.Server.Types
-import HsDev.Tools.Base (runTool_)
 import HsDev.Error
 import HsDev.Util
 import HsDev.Version
 
 #if mingw32_HOST_OS
 import Data.List
+import HsDev.Tools.Base (runTool_)
 import System.Environment
 import System.Win32.PowerShell (escape, quote, quoteDouble)
 #else
 import Control.Exception (SomeException, handle)
 import System.Posix.Process
-import System.Posix.Files (removeLink)
 import System.Posix.IO
 #endif
 

@@ -49,7 +49,7 @@ messagesById i = map _message . filter ((== i) . _messageId)
 
 -- | Notification from server
-data Notification = Notification Value deriving (Eq, Show)
+newtype Notification = Notification Value deriving (Eq, Show)
 
 instance ToJSON Notification where
 	toJSON (Notification v) = object ["notify" .= v]
@@ -73,7 +73,7 @@ 	parseJSON j = (withObject "result" (\v -> (Result <$> v .:: "result")) j) <|> (Error <$> parseJSON j)
 
 -- | Part of result list, returns via notification
-data ResultPart = ResultPart Value
+newtype ResultPart = ResultPart Value
 
 instance ToJSON ResultPart where
 	toJSON (ResultPart r) = object ["result-part" .= r]

@@ -206,7 +206,13 @@ openSqlConnection :: SessionMonad m => m SQL.Connection
 openSqlConnection = do
 	p <- askSession sessionSqlPath
-	liftIO $ SQL.open p
+	-- FIXME: There's `new` function in HsDev's SQLite module
+	liftIO $ do
+		conn <- SQL.open p
+		SQL.execute_ conn "pragma case_sensitive_like = true;"
+		SQL.execute_ conn "pragma synchronous = off;"
+		SQL.execute_ conn "pragma journal_mode = memory;"
+		return conn
 
 -- | Close sql connection
 closeSqlConnection :: SessionMonad m => SQL.Connection -> m ()
@@ -472,6 +478,7 @@ 	Refactor [Note Refact] [Note Refact] Bool |
 	Rename Text Text Path |
 	GhcEval { ghcEvalExpressions :: [String], ghcEvalSource :: Maybe FileSource } |
+	GhcType { ghcTypeExpressions :: [String], ghcTypeSource :: Maybe FileSource } |
 	Langs |
 	Flags |
 	Link { linkHold :: Bool } |
@@ -524,6 +531,7 @@ 	paths f (CheckLint fs ghcs c) = CheckLint <$> traverse (paths f) fs <*> pure ghcs <*> pure c
 	paths f (Types fs ghcs c) = Types <$> traverse (paths f) fs <*> pure ghcs <*> pure c
 	paths f (GhcEval e mf) = GhcEval e <$> traverse (paths f) mf
+	paths f (GhcType e mf) = GhcType e <$> traverse (paths f) mf
 	paths _ c = pure c
 
 instance Paths FileSource where
@@ -585,7 +593,9 @@ 			option readJSON (long "rest" <> metavar "correction" <> short 'r' <> help "update corrections") <*>
 			pureFlag),
 		cmd "rename" "get rename refactors" (Rename <$> textArgument idm <*> textArgument idm <*> ctx),
-		cmd "ghc" "ghc commands" (subparser $ cmd "eval" "evaluate expression" (GhcEval <$> many (strArgument idm) <*> optional cmdP)),
+		cmd "ghc" "ghc commands" (
+				subparser (cmd "eval" "evaluate expression" (GhcEval <$> many (strArgument idm) <*> optional cmdP)) <|>
+				subparser (cmd "type" "expression type" (GhcType <$> many (strArgument idm) <*> optional cmdP))),
 		cmd "langs" "ghc language options" (pure Langs),
 		cmd "flags" "ghc flags" (pure Flags),
 		cmd "link" "link to server" (Link <$> holdFlag),
@@ -708,6 +718,7 @@ 	toJSON (Refactor ns rests pure') = cmdJson "refactor" ["messages" .= ns, "rest" .= rests, "pure" .= pure']
 	toJSON (Rename n n' f) = cmdJson "rename" ["name" .= n, "new-name" .= n', "file" .= f]
 	toJSON (GhcEval exprs f) = cmdJson "ghc eval" ["exprs" .= exprs, "file" .= f]
+	toJSON (GhcType exprs f) = cmdJson "ghc type" ["exprs" .= exprs, "file" .= f]
 	toJSON Langs = cmdJson "langs" []
 	toJSON Flags = cmdJson "flags" []
 	toJSON (Link h) = cmdJson "link" ["hold" .= h]
@@ -762,6 +773,7 @@ 		guardCmd "refactor" v *> (Refactor <$> v .:: "messages" <*> v .::?! "rest" <*> (v .:: "pure" <|> pure True)),
 		guardCmd "rename" v *> (Rename <$> v .:: "name" <*> v .:: "new-name" <*> v .:: "file"),
 		guardCmd "ghc eval" v *> (GhcEval <$> v .::?! "exprs" <*> v .::? "file"),
+		guardCmd "ghc type" v *> (GhcType <$> v .::?! "exprs" <*> v .::? "file"),
 		guardCmd "langs" v *> pure Langs,
 		guardCmd "flags" v *> pure Flags,
 		guardCmd "link" v *> (Link <$> (v .:: "hold" <|> pure False)),

@@ -3,7 +3,7 @@ module HsDev.Stack (
 	stack, yaml,
 	path, pathOf,
-	build, buildDeps, configure,
+	build, buildDeps,
 	StackEnv(..), stackRoot, stackProject, stackConfig, stackGhc, stackSnapshot, stackLocal,
 	getStackEnv, projectEnv,
 	stackPackageDbStack,
@@ -99,10 +99,6 @@ -- | Build only dependencies
 buildDeps :: Maybe FilePath -> GhcM ()
 buildDeps = build ["--only-dependencies"]
-
--- | Configure project
-configure :: Maybe FilePath -> GhcM ()
-configure = build ["--only-configure"]
 
 data StackEnv = StackEnv {
 	_stackRoot :: FilePath,

@@ -10,6 +10,7 @@ 
 	-- * Tags
 	setTag, hasTag, removeTag, dropTags,
+	inspectTag, inspectUntag,
 
 	-- * Reexportss
 	module HsDev.Symbols.Types,
@@ -22,6 +23,7 @@ import Control.Lens
 import Control.Monad.Trans.Maybe
 import Control.Monad.Except
+import Control.Monad.State
 import Data.List
 import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
 import qualified Data.Map.Strict as M
@@ -125,3 +127,11 @@ -- | Drop all tags
 dropTags :: Inspected i t a -> Inspected i t a
 dropTags = set inspectionTags S.empty
+
+-- | Set inspection tag
+inspectTag :: (Monad m, Ord t) => t -> InspectM k t m a -> InspectM k t m a
+inspectTag tag' act = act <* modify (over _2 (S.insert tag'))
+
+-- | Unser inspection tag
+inspectUntag :: (Monad m, Ord t) => t -> InspectM k t m a -> InspectM k t m a
+inspectUntag tag' act = act <* modify (over _2 (S.delete tag'))

@@ -2,9 +2,11 @@ 
 module HsDev.Symbols.Name (
 	Name, qualName, unqualName, nameModule, nameIdent, pattern Name, fromName_, toName_, toModuleName_, fromModuleName_, fromName, toName,
+	name_, moduleName_
 	) where
 
 import Control.Arrow
+import Control.Lens
 import Data.Char (isAlpha, isAlphaNum)
 import Data.Text (Text)
 import Data.String (fromString)
@@ -80,3 +82,9 @@ #if MIN_VERSION_haskell_src_exts(1,20,0)
 	ExprHole _ -> "_"
 #endif
+
+name_ :: Iso' (Exts.Name ()) Text
+name_ = iso fromName_ toName_
+
+moduleName_ :: Iso' (ModuleName ()) Text
+moduleName_ = iso fromModuleName_ toModuleName_

@@ -1,14 +1,15 @@-{-# LANGUAGE CPP, TemplateHaskell, TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
+{-# LANGUAGE CPP, TemplateHaskell, TypeSynonymInstances, FlexibleInstances, OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Symbols.Types (
 	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,
+	SymbolInfo(..), functionType, parentClass, parentType, selectorConstructors, typeArgs, typeContext, familyAssociate, symbolInfoType, symbolType, patternType, patternConstructor,
 	Scoped(..), scopeQualifier, scoped,
-	SymbolUsage(..), symbolUsed, symbolUsedIn, symbolUsedPosition,
+	SymbolUsage(..), symbolUsed, symbolUsedQualifier, symbolUsedIn, symbolUsedRegion,
 	infoOf, nullifyInfo,
 	Inspection(..), inspectionAt, inspectionOpts, fresh, Inspected(..), inspection, inspectedKey, inspectionTags, inspectionResult, inspected,
+	InspectM(..), runInspect, continueInspect, inspect, inspect_, withInspection,
 	inspectedTup, noTags, tag, ModuleTag(..), InspectedModule, notInspected,
 
 	module HsDev.PackageDb.Types,
@@ -23,6 +24,11 @@ import Control.Applicative
 import Control.Lens hiding ((.=))
 import Control.Monad
+import Control.Monad.Morph
+import Control.Monad.Catch
+import Control.Monad.Except
+import Control.Monad.Reader
+import Control.Monad.State
 import Control.DeepSeq (NFData(..))
 import Data.Aeson
 import Data.Aeson.Types (Pair, Parser)
@@ -44,6 +50,7 @@ 
 import Control.Apply.Util (chain)
 import HsDev.Display
+import HsDev.Error
 import HsDev.PackageDb.Types
 import HsDev.Project
 import HsDev.Symbols.Name
@@ -51,7 +58,6 @@ import HsDev.Symbols.Location
 import HsDev.Symbols.Documented
 import HsDev.Symbols.Parsed
-import HsDev.Types
 import HsDev.Util ((.::), (.::?), (.::?!), noNulls, objectUnion)
 import System.Directory.Paths
 
@@ -259,20 +265,22 @@ instance (Monoid a, EmptySymbolInfo r) => EmptySymbolInfo (a -> r) where
 	infoOf f = infoOf $ f mempty
 
+symbolInfoType :: SymbolInfo -> String
+symbolInfoType (Function{}) = "function"
+symbolInfoType (Method{}) = "method"
+symbolInfoType (Selector{}) = "selector"
+symbolInfoType (Constructor{}) = "ctor"
+symbolInfoType (Type{}) = "type"
+symbolInfoType (NewType{}) = "newtype"
+symbolInfoType (Data{}) = "data"
+symbolInfoType (Class{}) = "class"
+symbolInfoType (TypeFam{}) = "type-family"
+symbolInfoType (DataFam{}) = "data-family"
+symbolInfoType (PatConstructor{}) = "pat-ctor"
+symbolInfoType (PatSelector{}) = "pat-selector"
+
 symbolType :: Symbol -> String
-symbolType s = case _symbolInfo s of
-	Function{} -> "function"
-	Method{} -> "method"
-	Selector{} -> "selector"
-	Constructor{} -> "ctor"
-	Type{} -> "type"
-	NewType{} -> "newtype"
-	Data{} -> "data"
-	Class{} -> "class"
-	TypeFam{} -> "type-family"
-	DataFam{} -> "data-family"
-	PatConstructor{} -> "pat-ctor"
-	PatSelector{} -> "pat-selector"
+symbolType = symbolInfoType . _symbolInfo
 
 what :: String -> Pair
 what n = "what" .= n
@@ -317,19 +325,21 @@ -- | Symbol usage
 data SymbolUsage = SymbolUsage {
 	_symbolUsed :: Symbol,
+	_symbolUsedQualifier :: Maybe Text,
 	_symbolUsedIn :: ModuleId,
-	_symbolUsedPosition :: Position }
+	_symbolUsedRegion :: Region }
 		deriving (Eq, Ord)
 
 instance Show SymbolUsage where
-	show (SymbolUsage s m p) = show s ++ " at " ++ show m ++ ":" ++ show p
+	show (SymbolUsage s _ m p) = show s ++ " at " ++ show m ++ ":" ++ show p
 
 instance ToJSON SymbolUsage where
-	toJSON (SymbolUsage s m p) = object $ noNulls ["symbol" .= s, "in" .= m, "at" .= p]
+	toJSON (SymbolUsage s q m p) = object $ noNulls ["symbol" .= s, "qualifier" .= q, "in" .= m, "at" .= p]
 
 instance FromJSON SymbolUsage where
 	parseJSON = withObject "symbol-usage" $ \v -> SymbolUsage <$>
 		v .:: "symbol" <*>
+		v .::? "qualifier" <*>
 		v .:: "in" <*>
 		v .:: "at"
 
@@ -423,6 +433,39 @@ 		(S.fromList <$> (v .::?! "tags")) <*>
 		((Left <$> v .:: "error") <|> (Right <$> v .:: "result"))
 
+newtype InspectM k t m a = InspectM { runInspectM :: ReaderT k (ExceptT HsDevError (StateT (Inspection, S.Set t) m)) a }
+	deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadIO, MonadThrow, MonadCatch, MonadReader k, MonadError HsDevError, MonadState (Inspection, S.Set t))
+
+instance MonadTrans (InspectM k t) where
+	lift = InspectM . lift . lift . lift
+
+runInspect :: (Monad m, Ord t) => k -> InspectM k t m a -> m (Inspected k t a)
+runInspect key act = do
+	(res, (insp, ts)) <- flip runStateT (InspectionNone, mempty) . runExceptT . flip runReaderT key . runInspectM $ act
+	return $ Inspected insp key ts res
+
+-- | Continue inspection
+continueInspect :: (Monad m, Ord t) => Inspected k t a -> (a -> InspectM k t m b) -> m (Inspected k t b)
+continueInspect start act = runInspect (_inspectedKey start) $ do
+	put (_inspection start, _inspectionTags start)
+	val <- either throwError return $ _inspectionResult start
+	act val
+
+inspect :: MonadCatch m => m Inspection -> (k -> m a) -> InspectM k t m a
+inspect insp act = withInspection insp $ do
+	key <- ask
+	lift (hsdevCatch (hsdevLiftIO $ act key)) >>= either throwError return
+
+withInspection :: MonadCatch m => m Inspection -> InspectM k t m a -> InspectM k t m a
+withInspection insp inner = do
+	insp' <- lift insp
+	let
+		setInsp = modify (set _1 insp')
+	catchError (inner <* setInsp) (\e -> setInsp >> throwError e)
+
+inspect_ :: MonadCatch m => m Inspection -> m a -> InspectM k t m a
+inspect_ insp = inspect insp . const
+
 -- | Empty tags
 noTags :: Set t
 noTags = S.empty
@@ -431,29 +474,37 @@ tag :: t -> Set t
 tag = S.singleton
 
-data ModuleTag = InferredTypesTag | RefinedDocsTag | OnlyHeaderTag deriving (Eq, Ord, Read, Show, Enum, Bounded)
+data ModuleTag = InferredTypesTag | RefinedDocsTag | OnlyHeaderTag | DirtyTag | ResolvedNamesTag deriving (Eq, Ord, Read, Show, Enum, Bounded)
 
 instance NFData ModuleTag where
 	rnf InferredTypesTag = ()
 	rnf RefinedDocsTag = ()
 	rnf OnlyHeaderTag = ()
+	rnf DirtyTag = ()
+	rnf ResolvedNamesTag = ()
 
 instance Display ModuleTag where
 	display InferredTypesTag = "types"
 	display RefinedDocsTag = "docs"
 	display OnlyHeaderTag = "header"
+	display DirtyTag = "dirty"
+	display ResolvedNamesTag = "resolved"
 	displayType _ = "module-tag"
 
 instance ToJSON ModuleTag where
 	toJSON InferredTypesTag = toJSON ("types" :: String)
 	toJSON RefinedDocsTag = toJSON ("docs" :: String)
 	toJSON OnlyHeaderTag = toJSON ("header" :: String)
+	toJSON DirtyTag = toJSON ("dirty" :: String)
+	toJSON ResolvedNamesTag = toJSON ("resolved" :: String)
 
 instance FromJSON ModuleTag where
 	parseJSON = withText "module-tag" $ \txt -> msum [
 		guard (txt == "types") >> return InferredTypesTag,
 		guard (txt == "docs") >> return RefinedDocsTag,
-		guard (txt == "header") >> return OnlyHeaderTag]
+		guard (txt == "header") >> return OnlyHeaderTag,
+		guard (txt == "dirty") >> return DirtyTag,
+		guard (txt == "resolved") >> return ResolvedNamesTag]
 
 -- | Inspected module
 type InspectedModule = Inspected ModuleLocation ModuleTag Module

@@ -5,15 +5,11 @@ 	tool, tool_,
 	matchRx, splitRx, replaceRx,
 	at, at_,
-	inspect,
 
 	module HsDev.Tools.Types
 	) where
 
-import Control.Lens (set)
-import Control.Monad.Catch (MonadCatch)
 import Control.Monad.Except
-import Control.Monad.State
 import Data.Array (assocs)
 import Data.List (unfoldr, intercalate)
 import Data.Maybe (fromMaybe)
@@ -24,7 +20,6 @@ 
 import HsDev.Error
 import HsDev.Tools.Types
-import HsDev.Symbols
 import HsDev.Util (liftIOErrors)
 
 -- | Run tool, throwing HsDevError on fail
@@ -90,12 +85,3 @@ 
 at_ :: IsString s => (Int -> Maybe s) -> Int -> s
 at_ g = fromMaybe (fromString "") . g
-
-inspect :: MonadCatch m => ModuleLocation -> m Inspection -> m Module -> m InspectedModule
-inspect mloc insp act = execStateT inspect' (notInspected mloc) where
-	inspect' = do
-		r <- hsdevCatch $ hsdevLiftIO $ do
-			i <- lift insp
-			modify (set inspection i)
-			lift act
-		modify (set inspectionResult r)

@@ -0,0 +1,196 @@+{-# LANGUAGE PatternGuards #-}
+
+module HsDev.Tools.Ghc.Base (
+	-- * Running Ghc
+	ghcRun, ghcRunWith,
+	-- * Commonly used DynFlags
+	interpretedFlags, noLinkFlags,
+	-- * Setting DynFlags
+	withFlags, modifyFlags,
+	-- * Loading targets
+	clearTargets, makeTarget, loadTargets,
+	loadInteractive, reload,
+	-- * Logging messages
+	collectMessages, collectMessages_,
+
+	-- * Util
+	formatType,
+	spanRegion,
+	withCurrentDirectory,
+	logToChan, logToNull
+	) where
+
+import Control.Lens (view, over)
+import Control.Monad
+import Control.Monad.Except
+import Data.Time.Clock (getCurrentTime)
+import Data.String (fromString)
+import Data.Text (Text)
+import qualified Data.Text as T
+import System.Directory (getCurrentDirectory, setCurrentDirectory)
+import System.FilePath
+
+import Exception (ExceptionMonad(..))
+import GHC hiding (Warning, Module)
+import Outputable
+import FastString (unpackFS)
+import StringBuffer
+import Type
+import qualified Pretty
+
+import Control.Concurrent.FiniteChan
+import System.Directory.Paths
+import HsDev.Symbols.Location (Position(..), Region(..), region, ModuleLocation(..))
+import HsDev.Tools.Types
+import HsDev.Tools.Ghc.Compat
+import qualified HsDev.Tools.Ghc.Compat as C (setLogAction, addLogAction, unqualStyle)
+
+-- | Run ghc
+ghcRun :: GhcMonad m => [String] -> m a -> m a
+ghcRun = ghcRunWith interpretedFlags
+
+-- | Run ghc
+ghcRunWith :: GhcMonad m => (DynFlags -> DynFlags) -> [String] -> m a -> m a
+ghcRunWith onFlags opts act = do
+	fs <- getSessionDynFlags
+	cleanupHandler fs $ do
+		(fs', _, _) <- parseDynamicFlags fs (map noLoc opts)
+		void $ setSessionDynFlags $ onFlags fs'
+		modifyFlags $ C.setLogAction logToNull
+		act
+
+interpretedFlags :: DynFlags -> DynFlags
+interpretedFlags fs = fs {
+	ghcMode = CompManager,
+	ghcLink = LinkInMemory,
+	hscTarget = HscInterpreted }
+
+noLinkFlags :: DynFlags -> DynFlags
+noLinkFlags fs = fs {
+	ghcMode = CompManager,
+	ghcLink = NoLink,
+	hscTarget = HscNothing }
+
+-- | Alter @DynFlags@ temporary
+withFlags :: GhcMonad m => m a -> m a
+withFlags = gbracket getSessionDynFlags (void . setSessionDynFlags) . const
+
+-- | Update @DynFlags@
+modifyFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
+modifyFlags f = do
+	fs <- getSessionDynFlags
+	let
+		fs' = f fs
+	_ <- setSessionDynFlags fs'
+	-- _ <- liftIO $ initPackages fs'
+	return ()
+
+-- | Clear loaded targets
+clearTargets :: GhcMonad m => m ()
+clearTargets = loadTargets []
+
+-- | Make target with its source code optional
+makeTarget :: GhcMonad m => Text -> Maybe Text -> m Target
+makeTarget name Nothing = guessTarget (T.unpack name) Nothing
+makeTarget name (Just cts) = do
+	t <- guessTarget (T.unpack name) Nothing
+	tm <- liftIO getCurrentTime
+	return t { targetContents = Just (stringToStringBuffer $ T.unpack cts, tm) }
+
+-- | Load all targets
+loadTargets :: GhcMonad m => [Target] -> m ()
+loadTargets ts = setTargets ts >> load LoadAllTargets >> return ()
+
+-- | Load and set interactive context
+loadInteractive :: GhcMonad m => Path -> Maybe Text -> m ()
+loadInteractive fpath mcts = do
+	fpath' <- liftIO $ canonicalize fpath
+	withCurrentDirectory (view path $ takeDir fpath') $ do
+		t <- makeTarget (over path takeFileName fpath') mcts
+		loadTargets [t]
+		g <- getModuleGraph
+		setContext [IIModule (ms_mod_name m) | m <- g]
+
+-- | Reload targets
+reload :: GhcMonad m => m ()
+reload = do
+	ts <- getTargets
+	ctx <- getContext
+	setContext []
+	clearTargets
+	setTargets ts
+	setContext ctx
+
+-- | Collect messages from ghc for underlying computation
+collectMessages :: GhcMonad m => m a -> m (a, [Note OutputMessage])
+collectMessages act = do
+	ch <- liftIO newChan
+	r <- gbracket (liftM log_action getSessionDynFlags) (\action' -> modifyFlags (\fs -> fs { log_action = action' })) $ \_ -> do
+		modifyFlags (C.addLogAction $ logToChan ch)
+		act
+	notes <- liftIO $ stopChan ch
+	return (r, notes)
+
+-- | Same as @collectMessages@, but when no result except notes needed
+collectMessages_ :: GhcMonad m => m () -> m [Note OutputMessage]
+collectMessages_ = fmap snd . collectMessages
+
+-- | Format type for output
+formatType :: GHC.DynFlags -> GHC.Type -> String
+formatType dflag t = showOutputable dflag (removeForAlls t)
+
+-- | Get region of @SrcSpan@
+spanRegion :: SrcSpan -> Region
+spanRegion (RealSrcSpan s) = Position (srcSpanStartLine s) (srcSpanStartCol s) `region` Position (srcSpanEndLine s) (srcSpanEndCol s)
+spanRegion _ = Position 0 0 `region` Position 0 0
+
+-- | Set current directory and restore it after action
+withCurrentDirectory :: GhcMonad m => FilePath -> m a -> m a
+withCurrentDirectory dir act = gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) $
+	const (liftIO (setCurrentDirectory dir) >> act)
+
+-- | Log  ghc warnings and errors as to chan
+-- You may have to apply recalcTabs on result notes
+logToChan :: Chan (Note OutputMessage) -> LogAction
+logToChan ch fs sev src msg
+	| Just sev' <- checkSev sev = do
+		src' <- canonicalize srcMod
+		void $ sendChan ch Note {
+			_noteSource = src',
+			_noteRegion = spanRegion src,
+			_noteLevel = Just sev',
+			_note = OutputMessage {
+				_message = fromString $ showSDoc fs msg,
+				_messageSuggestion = Nothing } }
+	| otherwise = return ()
+	where
+		checkSev SevWarning = Just Warning
+		checkSev SevError = Just Error
+		checkSev SevFatal = Just Error
+		checkSev _ = Nothing
+		srcMod = case src of
+			RealSrcSpan s' -> FileModule (fromFilePath $ unpackFS $ srcSpanFile s') Nothing
+			_ -> NoLocation
+
+-- | Don't log ghc warnings and errors
+logToNull :: LogAction
+logToNull _ _ _ _ = return ()
+
+-- TODO: Load target by @ModuleLocation@, which may cause updating @DynFlags@
+
+removeForAlls :: Type -> Type
+removeForAlls ty = removeForAlls' ty' tty' where
+	ty'  = dropForAlls ty
+	tty' = splitFunTy_maybe ty'
+
+removeForAlls' :: Type -> Maybe (Type, Type) -> Type
+removeForAlls' ty Nothing = ty
+removeForAlls' ty (Just (pre, ftype))
+	| isPredTy pre = mkFunTy pre (dropForAlls ftype)
+	| otherwise = ty
+
+showOutputable :: Outputable a => DynFlags -> a -> String
+showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . ppr
+
+showUnqualifiedPage :: DynFlags -> SDoc -> String
+showUnqualifiedPage dflag = renderStyle Pretty.LeftMode 0 . withPprStyleDoc dflag (C.unqualStyle dflag)

@@ -19,14 +19,12 @@ 
 import GHC hiding (Warning, Module)
 
-import Control.Concurrent.FiniteChan
 import HsDev.Error
 import HsDev.PackageDb
 import HsDev.Symbols.Location
 import HsDev.Symbols.Types
 import HsDev.Tools.Base
 import HsDev.Tools.Ghc.Worker
-import HsDev.Tools.Ghc.Compat as C
 import HsDev.Tools.Types
 import HsDev.Tools.Tabs
 import System.Directory.Paths
@@ -35,7 +33,6 @@ check :: (MonadLog m, GhcMonad m) => Module -> Maybe Text -> m [Note OutputMessage]
 check m msrc = scope "check" $ case view (moduleId . moduleLocation) m of
 	FileModule file _ -> do
-		ch <- liftIO newChan
 		let
 			dir = sourceRoot_ (m ^. moduleId)
 			-- FIXME: There can be dependent modules with modified file contents
@@ -43,11 +40,9 @@ 			srcs = maybe mempty (M.singleton file) msrc
 		ex <- liftIO $ dirExists dir
 		sendLog Trace "loading targets"
-		withFlags $ (if ex then withCurrentDirectory (dir ^. path) else id) $ do
-			modifyFlags $ C.setLogAction $ logToChan ch
+		notes <- withFlags $ (if ex then withCurrentDirectory (dir ^. path) else id) $ collectMessages_ $ do
 			target <- makeTarget (relPathTo dir file) msrc
 			loadTargets [target]
-		notes <- liftIO $ stopChan ch
 		sendLog Trace "targets checked"
 		liftIO $ recalcNotesTabs srcs notes
 	_ -> scope "check" $ hsdevError $ ModuleNotSource (view (moduleId . moduleLocation) m)

@@ -5,18 +5,19 @@ 	pkgDatabase,
 	UnitId, InstalledUnitId, toInstalledUnitId,
 	unitId, moduleUnitId, depends, getPackageDetails, patSynType, cleanupHandler, renderStyle,
-	LogAction, setLogAction,
+	LogAction, setLogAction, addLogAction,
 	languages, flags,
 	recSelParent, recSelCtors,
 	getFixity,
 	unqualStyle,
-	exposedModuleName
+	exposedModuleName,
+	exprType
 	) where
 
 import qualified BasicTypes
 import qualified DynFlags as GHC
 import qualified ErrUtils
-import qualified IdInfo
+import qualified InteractiveEval as Eval
 import qualified GHC
 import qualified Module
 import qualified Name
@@ -27,10 +28,8 @@ 
 #if __GLASGOW_HASKELL__ >= 800
 import Data.List (nub)
-#endif
-
-#if __GLASGOW_HASKELL__ == 800
 import qualified IdInfo
+import TcRnDriver
 #endif
 
 #if __GLASGOW_HASKELL__ == 710
@@ -125,6 +124,19 @@ 	act' df sev src _ msg = act df sev src msg
 #endif
 
+addLogAction :: LogAction -> GHC.DynFlags -> GHC.DynFlags
+addLogAction act fs = fs { GHC.log_action = logBoth } where
+	logBoth :: GHC.LogAction
+#if __GLASGOW_HASKELL__ >= 800
+	logBoth df wreason sev src style msg = do
+		GHC.log_action fs df wreason sev src style msg
+		GHC.log_action (setLogAction act fs) df wreason sev src style msg
+#elif __GLASGOW_HASKELL__ == 710
+	logBoth df sev src style ms = do
+		GHC.log_action fs df sev src style msg
+		GHC.log_action (setLogAction act fs) df sev src style msg
+#endif
+
 #if __GLASGOW_HASKELL__ == 710
 instance (Monad m, GHC.HasDynFlags m) => GHC.HasDynFlags (ReaderT r m) where
 	getDynFlags = lift GHC.getDynFlags
@@ -189,4 +201,11 @@ #else
 exposedModuleName :: GHC.ExposedModule unit mname -> mname
 exposedModuleName = GHC.exposedName
+#endif
+
+exprType :: GHC.GhcMonad m => String -> m GHC.Type
+#if __GLASGOW_HASKELL__ > 800
+exprType = Eval.exprType TM_Inst
+#else
+exprType = Eval.exprType
 #endif

@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings, TypeApplications #-}
+
+module HsDev.Tools.Ghc.Repl (
+	importModules, preludeModules,
+	evaluate,
+	expressionType,
+
+	ReplResult(..),
+	tryRepl
+	) where
+
+import Control.Monad
+import Control.Monad.Catch
+import Data.Aeson
+import Data.Dynamic
+import Text.Format
+
+import GhcMonad
+import GHC
+
+import HsDev.Tools.Ghc.Base
+import qualified HsDev.Tools.Ghc.Compat as C
+import HsDev.Util
+
+-- | Import some modules
+importModules :: GhcMonad m => [String] -> m ()
+importModules mods = mapM parseImportDecl ["import " ++ m | m <- mods] >>= setContext . map IIDecl
+
+-- | Default interpreter modules
+preludeModules :: [String]
+preludeModules = ["Prelude", "Data.List", "Control.Monad", "HsDev.Tools.Ghc.Prelude"]
+
+-- | Evaluate expression
+evaluate :: GhcMonad m => String -> m String
+evaluate expr = liftM fromDynamic (dynCompileExpr $ "show ({})" ~~ expr) >>=
+	maybe (fail "evaluate fail") return
+
+-- | Get expression type as string
+expressionType :: GhcMonad m => String -> m String
+expressionType expr = do
+	dflags <- getSessionDynFlags
+	ty <- C.exprType expr
+	return $ formatType dflags ty
+
+data ReplResult a = ReplError String | ReplOk a deriving (Eq, Ord, Read, Show)
+
+instance ToJSON a => ToJSON (ReplResult a) where
+	toJSON (ReplError e) = object ["error" .= e]
+	toJSON (ReplOk v) = object ["ok" .= v]
+
+instance FromJSON a => FromJSON (ReplResult a) where
+	parseJSON = withObject "repl-result" $ \v -> msum [
+		ReplError <$> v .:: "error",
+		ReplOk <$> v .:: "ok"]
+
+tryRepl :: (GhcMonad m, MonadCatch m) => m a -> m (ReplResult a)
+tryRepl = fmap (either (ReplError . displayException @SomeException) ReplOk) . try

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Tools.Ghc.System (
+	BuildInfo(..), buildInfo,
+	examineCompilerVersion,
+
+	formatBuildPath, buildPath
+	) where
+
+import Control.Arrow
+import qualified Data.Map as M
+import Data.Maybe
+import Distribution.Text (display)
+import Distribution.System (buildOS)
+import qualified System.Info as Sys
+import Text.Format
+
+import DynFlags (DynFlags)
+import PackageConfig as GHC
+import GHC (getSessionDynFlags)
+
+import HsDev.Tools.Ghc.Compat as Compat
+import HsDev.Tools.Ghc.Worker (GhcM)
+
+data BuildInfo = BuildInfo {
+	targetArch :: String,
+	targetOS :: String,
+	cabalOS :: String,
+	compilerName :: String,
+	compilerVersion :: String }
+
+buildInfo :: DynFlags -> BuildInfo
+buildInfo = BuildInfo Sys.arch Sys.os (display buildOS) Sys.compilerName . examineCompilerVersion
+
+examineCompilerVersion :: DynFlags -> String
+examineCompilerVersion =
+	display .
+	fromMaybe Sys.compilerVersion .
+	M.lookup Sys.compilerName .
+	M.fromList .
+	map (GHC.packageNameString &&& GHC.packageVersion) .
+	fromMaybe [] . Compat.pkgDatabase
+
+-- | Can contain {arch}, {os}/{platform}, {compiler}, {version}
+formatBuildPath :: String -> BuildInfo -> String
+formatBuildPath f = formats f . toArgs where
+	toArgs b = [
+		"arch" ~% targetArch b,
+		"os" ~% targetOS b,
+		"os/cabal" ~% cabalOS b,
+		"compiler" ~% compilerName b,
+		"version" ~% compilerVersion b]
+
+buildPath :: String -> GhcM FilePath
+buildPath f = fmap (formatBuildPath f . buildInfo) getSessionDynFlags

@@ -21,7 +21,7 @@ import GHC hiding (exprType, Module, moduleName)
 import GHC.SYB.Utils (everythingStaged, Stage(TypeChecker))
 import GhcPlugins (mkFunTys)
-import CoreUtils
+import CoreUtils as C
 import Desugar (deSugarExpr)
 import TcHsSyn (hsPatType)
 import Outputable
@@ -37,23 +37,23 @@ import HsDev.Util
 
 class HasType a where
-	getType :: GhcMonad m => TypecheckedModule -> a -> m (Maybe (SrcSpan, Type))
+	getType :: GhcMonad m => a -> m (Maybe (SrcSpan, Type))
 
 instance HasType (LHsExpr Id) where
-	getType _ e = do
+	getType e = do
 		env <- getSession
 		mbe <- liftIO $ liftM snd $ deSugarExpr env e
 		return $ do
 			ex <- mbe
-			return (getLoc e, exprType ex)
+			return (getLoc e, C.exprType ex)
 
 instance HasType (LHsBind Id) where
-	getType _ (L _ FunBind { fun_id = fid, fun_matches = m}) = return $ Just (getLoc fid, typ) where
+	getType (L _ FunBind { fun_id = fid, fun_matches = m}) = return $ Just (getLoc fid, typ) where
 		typ = mkFunTys (mg_arg_tys m) (mg_res_ty m)
-	getType _ _ = return Nothing
+	getType _ = return Nothing
 
 instance HasType (LPat Id) where
-	getType _ (L spn pat) = return $ Just (spn, hsPatType pat)
+	getType (L spn pat) = return $ Just (spn, hsPatType pat)
 
 locatedTypes :: Typeable a => TypecheckedSource -> [Located a]
 locatedTypes = types' p where
@@ -73,9 +73,9 @@ 	let
 		ts = tm_typechecked_source tm
 	liftM (catMaybes . concat) $ sequence [
-		mapM (getType tm) (locatedTypes ts :: [LHsBind Id]),
-		mapM (getType tm) (locatedTypes ts :: [LHsExpr Id]),
-		mapM (getType tm) (locatedTypes ts :: [LPat Id])]
+		mapM getType (locatedTypes ts :: [LHsExpr Id]),
+		mapM getType (locatedTypes ts :: [LHsBind Id]),
+		mapM getType (locatedTypes ts :: [LPat Id])]
 
 data TypedExpr = TypedExpr {
 	_typedExpr :: Maybe Text,

@@ -8,38 +8,21 @@ 	ghcWorker,
 	workerSession, ghcSession, ghciSession, haddockSession, tmpSession,
 
-	-- * Initializers and actions
-	ghcRun, ghcRunWith, interpretedFlags, noLinkFlags,
-	withFlags, modifyFlags,
-	importModules, preludeModules,
-	evaluate,
-	clearTargets, makeTarget, loadTargets,
-	loadInteractive, reload,
-	-- * Utils
-	spanRegion,
-	withCurrentDirectory,
-	logToChan, logToNull,
-
 	Ghc,
 	LogT(..),
 
+	module HsDev.Tools.Ghc.Base,
+	module HsDev.Tools.Ghc.Repl,
 	module HsDev.Tools.Ghc.MGhc,
 	module Control.Concurrent.Worker
 	) where
 
-import Control.Lens (view, over)
+import Control.Lens (view)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.Catch
-import Data.Dynamic
 import Data.Monoid
-import Data.Time.Clock (getCurrentTime)
-import Data.String (fromString)
-import Data.Text (Text)
-import qualified Data.Text as T
-import System.Directory (getCurrentDirectory, setCurrentDirectory)
-import System.FilePath
 import qualified System.Log.Simple as Log
 import System.Log.Simple.Monad (MonadLog(..), LogT(..), withLog)
 import Text.Format hiding (withFlags)
@@ -47,18 +30,11 @@ import Exception (ExceptionMonad(..), ghandle)
 import GHC hiding (Warning, Module)
 import GHC.Paths
-import Outputable
-import FastString (unpackFS)
-import StringBuffer
 
-import Control.Concurrent.FiniteChan
 import Control.Concurrent.Worker
-import System.Directory.Paths
-import HsDev.Symbols.Location (Position(..), Region(..), region, ModuleLocation(..))
 import HsDev.PackageDb.Types
-import HsDev.Tools.Types
-import HsDev.Tools.Ghc.Compat
-import qualified HsDev.Tools.Ghc.Compat as C (setLogAction)
+import HsDev.Tools.Ghc.Base
+import HsDev.Tools.Ghc.Repl
 import HsDev.Tools.Ghc.MGhc
 
 data SessionType = SessionGhci | SessionGhc | SessionHaddock | SessionTmp deriving (Eq, Ord)
@@ -153,131 +129,3 @@ -- | Get haddock session with flags
 tmpSession :: PackageDbStack -> [String] -> GhcM ()
 tmpSession = workerSession SessionTmp
-
--- | Run ghc
-ghcRun :: GhcMonad m => [String] -> m a -> m a
-ghcRun = ghcRunWith interpretedFlags
-
--- | Run ghc
-ghcRunWith :: GhcMonad m => (DynFlags -> DynFlags) -> [String] -> m a -> m a
-ghcRunWith onFlags opts act = do
-	fs <- getSessionDynFlags
-	cleanupHandler fs $ do
-		(fs', _, _) <- parseDynamicFlags fs (map noLoc opts)
-		void $ setSessionDynFlags $ onFlags fs'
-		modifyFlags $ C.setLogAction logToNull
-		act
-
-interpretedFlags :: DynFlags -> DynFlags
-interpretedFlags fs = fs {
-	ghcMode = CompManager,
-	ghcLink = LinkInMemory,
-	hscTarget = HscInterpreted }
-
-noLinkFlags :: DynFlags -> DynFlags
-noLinkFlags fs = fs {
-	ghcMode = CompManager,
-	ghcLink = NoLink,
-	hscTarget = HscNothing }
-
--- | Alter @DynFlags@ temporary
-withFlags :: GhcMonad m => m a -> m a
-withFlags = gbracket getSessionDynFlags (\fs -> setSessionDynFlags fs >> return ()) . const
-
--- | Update @DynFlags@
-modifyFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
-modifyFlags f = do
-	fs <- getSessionDynFlags
-	let
-		fs' = f fs
-	_ <- setSessionDynFlags fs'
-	-- _ <- liftIO $ initPackages fs'
-	return ()
-
--- | Import some modules
-importModules :: GhcMonad m => [String] -> m ()
-importModules mods = mapM parseImportDecl ["import " ++ m | m <- mods] >>= setContext . map IIDecl
-
--- | Default interpreter modules
-preludeModules :: [String]
-preludeModules = ["Prelude", "Data.List", "Control.Monad", "HsDev.Tools.Ghc.Prelude"]
-
--- | Evaluate expression
-evaluate :: GhcMonad m => String -> m String
-evaluate expr = liftM fromDynamic (dynCompileExpr $ "show ({})" ~~ expr) >>=
-	maybe (fail "evaluate fail") return
-
--- | Clear loaded targets
-clearTargets :: GhcMonad m => m ()
-clearTargets = loadTargets []
-
--- | Make target with its source code optional
-makeTarget :: GhcMonad m => Text -> Maybe Text -> m Target
-makeTarget name Nothing = guessTarget (T.unpack name) Nothing
-makeTarget name (Just cts) = do
-	t <- guessTarget (T.unpack name) Nothing
-	tm <- liftIO getCurrentTime
-	return t { targetContents = Just (stringToStringBuffer $ T.unpack cts, tm) }
-
--- | Load all targets
-loadTargets :: GhcMonad m => [Target] -> m ()
-loadTargets ts = setTargets ts >> load LoadAllTargets >> return ()
-
--- | Load and set interactive context
-loadInteractive :: GhcMonad m => Path -> Maybe Text -> m ()
-loadInteractive fpath mcts = do
-	fpath' <- liftIO $ canonicalize fpath
-	withCurrentDirectory (view path $ takeDir fpath') $ do
-		t <- makeTarget (over path takeFileName fpath') mcts
-		loadTargets [t]
-		g <- getModuleGraph
-		setContext [IIModule (ms_mod_name m) | m <- g]
-
--- | Reload targets
-reload :: GhcMonad m => m ()
-reload = do
-	ts <- getTargets
-	ctx <- getContext
-	setContext []
-	clearTargets
-	setTargets ts
-	setContext ctx
-
--- | Get region of @SrcSpan@
-spanRegion :: SrcSpan -> Region
-spanRegion (RealSrcSpan s) = Position (srcSpanStartLine s) (srcSpanStartCol s) `region` Position (srcSpanEndLine s) (srcSpanEndCol s)
-spanRegion _ = Position 0 0 `region` Position 0 0
-
--- | Set current directory and restore it after action
-withCurrentDirectory :: GhcMonad m => FilePath -> m a -> m a
-withCurrentDirectory dir act = gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) $
-	const (liftIO (setCurrentDirectory dir) >> act)
-
--- | Log  ghc warnings and errors as to chan
--- You may have to apply recalcTabs on result notes
-logToChan :: Chan (Note OutputMessage) -> LogAction
-logToChan ch fs sev src msg
-	| Just sev' <- checkSev sev = do
-		src' <- canonicalize srcMod
-		void $ sendChan ch Note {
-			_noteSource = src',
-			_noteRegion = spanRegion src,
-			_noteLevel = Just sev',
-			_note = OutputMessage {
-				_message = fromString $ showSDoc fs msg,
-				_messageSuggestion = Nothing } }
-	| otherwise = return ()
-	where
-		checkSev SevWarning = Just Warning
-		checkSev SevError = Just Error
-		checkSev SevFatal = Just Error
-		checkSev _ = Nothing
-		srcMod = case src of
-			RealSrcSpan s' -> FileModule (fromFilePath $ unpackFS $ srcSpanFile s') Nothing
-			_ -> NoLocation
-
--- | Don't log ghc warnings and errors
-logToNull :: LogAction
-logToNull _ _ _ _ = return ()
-
--- TODO: Load target by @ModuleLocation@, which may cause updating @DynFlags@

@@ -17,6 +17,7 @@ 
 -- | hsdev exception type
 data HsDevError =
+	HsDevFailure |
 	ModuleNotSource ModuleLocation |
 	BrowseNoModuleInfo String |
 	FileNotFound Path |
@@ -37,6 +38,7 @@ 		deriving (Typeable)
 
 instance NFData HsDevError where
+	rnf HsDevFailure = ()
 	rnf (ModuleNotSource mloc) = rnf mloc
 	rnf (BrowseNoModuleInfo m) = rnf m
 	rnf (FileNotFound f) = rnf f
@@ -56,6 +58,7 @@ 	rnf (UnhandledError e) = rnf e
 
 instance Show HsDevError where
+	show HsDevFailure = format "failure"
 	show (ModuleNotSource mloc) = format "module is not source: {}" ~~ show mloc
 	show (BrowseNoModuleInfo m) = format "can't find module info for {}" ~~ m
 	show (FileNotFound f) = format "file '{}' not found" ~~ f
@@ -74,12 +77,17 @@ 	show (OtherError e) = e
 	show (UnhandledError e) = e
 
+instance Monoid HsDevError where
+	mempty = HsDevFailure
+	mappend _ r = r
+
 instance Formattable HsDevError where
 
 jsonErr :: String -> [Pair] -> Value
 jsonErr e = object . (("error" .= e) :)
 
 instance ToJSON HsDevError where
+	toJSON HsDevFailure = jsonErr "failure" []
 	toJSON (ModuleNotSource mloc) = jsonErr "module is not source" ["module" .= mloc]
 	toJSON (BrowseNoModuleInfo m) = jsonErr "no module info" ["module" .= m]
 	toJSON (FileNotFound f) = jsonErr "file not found" ["file" .= f]
@@ -102,6 +110,7 @@ 	parseJSON = withObject "hsdev-error" $ \v -> do
 		err <- v .: "error" :: Parser String
 		case err of
+			"failure" -> pure HsDevFailure
 			"module is not source" -> ModuleNotSource <$> v .: "module"
 			"no module info" -> BrowseNoModuleInfo <$> v .: "module"
 			"file not found" -> FileNotFound <$> v .: "file"

@@ -30,6 +30,9 @@ 	-- * Parse
 	parseDT,
 
+	-- * Log utils
+	timer,
+
 	-- * Reexportss
 	module Control.Monad.Except,
 	MonadIO(..)
@@ -57,6 +60,7 @@ import qualified Data.Text.IO as ST
 import qualified Data.Text.Lazy as T
 import qualified Data.Text.Lazy.Encoding as T
+import Data.Time.Clock.POSIX
 import Distribution.Text (simpleParse)
 import qualified Distribution.Text (Text)
 import Options.Applicative
@@ -307,3 +311,12 @@ parseDT :: (Monad m, Distribution.Text.Text a) => String -> String -> m a
 parseDT typeName v = maybe err return (simpleParse v) where
 	err = fail $ "Can't parse {}: {}" ~~ typeName ~~ v
+
+-- | Measure time of action
+timer :: MonadLog m => Text -> m a -> m a
+timer msg act = do
+	s <- liftIO getPOSIXTime
+	r <- act
+	e <- liftIO getPOSIXTime
+	sendLog Trace $ "{}: {}" ~~ msg ~~ show (e - s)
+	return r

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TypeApplications #-}
 
 module Main (
 	main
@@ -34,7 +34,7 @@ exports v = mkSet (v ^.. traverseArray . key "exports" . traverseArray . key "id" . key "name" . _Just)
 
 rgn :: Maybe Value -> Maybe Region
-rgn v = Region <$> (pos (v ^. key "from")) <*> (pos (v ^. key "to"))
+rgn v = Region <$> pos (v ^. key "from") <*> pos (v ^. key "to")
 
 pos :: Maybe Value -> Maybe Position
 pos v = Position <$> (v ^. key "line") <*> (v ^. key "column")
@@ -42,40 +42,59 @@ mkSet :: [String] -> S.Set String
 mkSet = S.fromList
 
+
 main :: IO ()
 main = hspec $ do
 	describe "scan project" $ do
 		dir <- runIO getCurrentDirectory
 		s <- runIO $ startServer_ (def { serverSilent = True })
+
 		it "should load data" $ do
 			inserts <- fmap lines $ readFile (dir </> "tests/data/base.sql")
 			inServer s $ mapM_ (execute_ . fromString) inserts
+
 		it "should scan project" $ do
 			void $ send s ["scan", "--project", dir </> "tests/test-package"]
+
 		it "should resolve export list" $ do
 			one <- send s ["module", "ModuleOne", "--exact"]
-			exports one `shouldBe` mkSet ["test", "newChan", "untypedFoo"]
+			exports one `shouldBe` mkSet ["Ctor", "ctor", "test", "newChan", "untypedFoo"]
 			two <- send s ["module", "ModuleTwo", "--exact"]
 			exports two `shouldBe` mkSet ["untypedFoo", "twice", "overloadedStrings"]
+
+		it "should return cached warnings on sequential checks without file modifications" $ do
+			firstCheck <- send s ["check", "--file", dir </> "tests/test-package/ModuleOne.hs"]
+			secondCheck <- send s ["check", "--file", dir </> "tests/test-package/ModuleOne.hs"]
+			firstCheck `shouldNotSatisfy` null
+			firstCheck `shouldBe` secondCheck
+
+		it "should not lose warnings that comes while loading module for inferring types" $ do
+			void $ send s ["infer", "--file", dir </> "tests/test-package/ModuleThree.hs"]
+			checks <- send s ["check", "--file", dir </> "tests/test-package/ModuleThree.hs"]
+			checks `shouldNotSatisfy` null
+
 		it "should pass extensions when checks" $ do
 			checks <- send s ["check", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
 			(checks ^.. traverseArray . key "level" . _Just) `shouldSatisfy` (("error" :: String) `notElem`)
+
 		it "should return types and docs" $ do
 			test' <- send s ["whois", "test", "--file", dir </> "tests/test-package/ModuleOne.hs"]
 			let
 				testType :: Maybe String
 				testType = test' ^. traverseArray . key "info" . key "type"
 			testType `shouldBe` Just "IO ()"
+
 		it "should infer types" $ do
 			ts <- send s ["types", "--file", dir </> "tests/test-package/ModuleOne.hs"]
 			let
-				untypedFooRgn = Region (Position 14 1) (Position 14 11)
+				untypedFooRgn = Region (Position 15 1) (Position 15 11)
 				exprs :: [(Region, String)]
 				exprs = do
 					note' <- ts ^.. traverseArray
 					rgn' <- maybeToList $ rgn (note' ^. key "region")
 					return (rgn', note' ^. key "note" . key "type" . _Just)
 			lookup untypedFooRgn exprs `shouldBe` Just "a -> a -> a" -- FIXME: Where's Num constraint?
+
 		it "should return symbol under location" $ do
 			_ <- send s ["infer", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
 			who' <- send s ["whoat", "13", "15", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
@@ -86,40 +105,64 @@ 				whoType = who' ^. traverseArray . key "info" . key "type"
 			whoName `shouldBe` Just "f"
 			whoType `shouldBe` Just "a -> a"
+
+		it "should distinguish between constructor and data" $ do
+			whoData <- send s ["whoat", "20", "9", "--file", dir </> "tests/test-package/ModuleOne.hs"]
+			whoCtor <- send s ["whoat", "21", "8", "--file", dir </> "tests/test-package/ModuleOne.hs"]
+			(whoData ^. traverseArray . key "info" . key "what" :: Maybe String) `shouldBe` Just "data"
+			(whoCtor ^. traverseArray . key "info" . key "what" :: Maybe String) `shouldBe` Just "ctor"
+
 		it "should use modified file contents" $ do
 			modifiedContents <- fmap unpack $ readFileUtf8 $ dir </> "tests/data/ModuleTwo.modified.hs"
 			void $ send s ["set-file-contents", "--file", dir </> "tests/test-package/ModuleTwo.hs", "--contents", modifiedContents]
 			-- Call scan to wait until file updated
 			void $ send s ["scan", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
+
 		it "should rescan module with modified contents" $ do
 			two <- send s ["module", "ModuleTwo", "--exact"]
 			exports two `shouldBe` mkSet ["untypedFoo", "twice", "overloadedStrings", "useUntypedFoo"]
+
 		it "should use modified source in `check` command" $ do
 			checks <- send s ["check", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
 			(checks ^.. traverseArray . key "note" . key "message" . _Just) `shouldSatisfy` (any ("Defined but not used" `isPrefixOf`))
+
 		it "should get usages of symbol" $ do
 			-- Note, that source was modified
 			us <- send s ["usages", "2", "2", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
 			let
-				locs :: [(String, Position)]
+				locs :: [(String, Region)]
 				locs = do
 					n <- us ^.. traverseArray
 					nm <- maybeToList $ n ^. key "in" . key "name"
-					p <- maybeToList $ pos (n ^. key "at")
+					p <- maybeToList $ rgn (n ^. key "at")
 					return (nm, p)
 			S.fromList locs `shouldBe` S.fromList [
-				("ModuleOne", Position 4 2),
-				("ModuleTwo", Position 2 2),
-				("ModuleTwo", Position 8 19),
-				("ModuleTwo", Position 25 21),
-				("ModuleTwo", Position 25 35)]
+				("ModuleOne", Position 4 2 `region` Position 4 12),
+				("ModuleOne", Position 15 1 `region` Position 15 11),
+				("ModuleTwo", Position 2 2 `region` Position 2 12),
+				("ModuleTwo", Position 8 19 `region` Position 8 29),
+				("ModuleTwo", Position 25 21 `region` Position 25 31),
+				("ModuleTwo", Position 25 35 `region` Position 25 45)]
+
 		it "should get usages of local symbols" $ do
 			us <- send s ["usages", "14", "15", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
 			let
-				locs :: [Position]
+				locs :: [Region]
 				locs = do
 					n <- us ^.. traverseArray
-					maybeToList $ pos (n ^. key "at")
-			S.fromList locs `shouldBe` S.fromList [Position 14 7, Position 14 11, Position 14 15]
+					maybeToList $ rgn (n ^. key "at")
+			S.fromList locs `shouldBe` S.fromList [
+				Position 14 7 `region` Position 14 8,
+				Position 14 11 `region` Position 14 12,
+				Position 14 15 `region` Position 14 16]
+
+		it "should evaluate expression in context of module" $ do
+			vals <- send s ["ghc", "eval", "smth [1,2,3]", "--file", dir </> "tests/test-package/ModuleThree.hs"]
+			vals ^.. traverseArray . key @String "ok" . _Just `shouldBe` ["[3,4]"]
+
+		it "should return type of expression in context of module" $ do
+			tys <- send s ["ghc", "type", "twice twice", "--file", dir </> "tests/test-package/ModuleTwo.hs"]
+			tys ^.. traverseArray . key @String "ok" . _Just `shouldBe` ["(a -> a) -> a -> a"]
+
 		_ <- runIO $ send s ["exit"]
 		return ()

@@ -1,7 +1,8 @@ module ModuleOne (
 	test,
 	newChan,
-	untypedFoo
+	untypedFoo,
+	Ctor(..), ctor,
 	) where
 
 import Control.Concurrent.Chan (newChan)
@@ -12,3 +13,9 @@ 
 -- | Some function without type
 untypedFoo x y = x + y
+
+-- | Same name of type and ctor
+data Ctor a = Ctor a
+
+ctor :: Ctor Int
+ctor = Ctor 10

@@ -0,0 +1,15 @@+module ModuleThree (
+	smth,
+
+	module ModuleOne,
+	module ModuleTwo
+	) where
+
+import Control.Concurrent.Chan
+
+import ModuleOne (test)
+import ModuleTwo hiding (twice)
+
+smth :: [Int] -> [Int]
+smth [] = [1]
+smth (x:xs) = map (+x) xs

@@ -15,6 +15,7 @@   exposed-modules:
     ModuleOne
     ModuleTwo
+    ModuleThree
   -- other-modules:       
   -- other-extensions:    
   build-depends:       base >=4.8