module HsDev.Inspect.Resolve (
loadEnv, saveEnv,
loadEnvironment, loadFixities, withEnv,
resolveModule, resolvePreloaded, resolve,
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 Data.LookupTable
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
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) } }
resolvePreloaded :: MonadThrow m => Environment -> Preloaded -> InspectM ModuleLocation ModuleTag m Resolved
resolvePreloaded env = inspectTag ResolvedNamesTag . return . resolve env . view preloadedModule
resolve :: Environment -> H.Module H.SrcSpanInfo -> Resolved
resolve env m = Resolved {
_resolvedModule = void mn,
_resolvedSource = annotated,
_resolvedDefs = getSymbols decls',
_resolvedImports = map (toImport . dropScope) 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
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
loadEnv :: SessionMonad m => Maybe Path -> m (Environment, FixitiesTable)
loadEnv mcabal = do
envTable <- askSession sessionResolveEnvironment
cacheInTableM envTable mcabal $ (,) <$> loadEnvironment mcabal <*> loadFixities mcabal
saveEnv :: SessionMonad m => Maybe Path -> Environment -> FixitiesTable -> m ()
saveEnv mcabal env fixities = do
envTable <- askSession sessionResolveEnvironment
void $ insertTable mcabal (env, fixities) envTable
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)
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')]
withEnv :: SessionMonad m => Maybe Path -> m a -> m a
withEnv mcabal = (initEnv >>) where
initEnv = do
execute_ "create temporary table if not exists resolve (cabal text);"
execute_ "create temporary table if not exists env (module text not null, name text not null, what text not null, id integer not null);"
execute_ "create unique index if not exists env_id_index on env (id);"
execute_ "create unique index if not exists env_symbol_index on env (module, name, what);"
curEnv <- query_ "select cabal from resolve;"
unless (fmap fromOnly (listToMaybe curEnv) == Just mcabal) $ do
execute_ "delete from resolve;"
execute "insert into resolve values (?);" (Only mcabal)
execute_ "delete from env;"
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
updateResolved :: SessionMonad m => InspectedResolved -> m ()
updateResolved im = scope "update-resolved" $ do
_ <- upsertResolved im
insertResolvedSymbols im
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, exposed, 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 = ?, exposed = ?, 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 . installedModuleExposed,
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,
idecl ^. pos . positionColumn,
getModuleName mname,
qual,
fmap getModuleName alias,
maybe False getHiding specList,
fmap makeImportList specList)
executeMany "insert into imports (module_id, line, column, 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, column, 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,
idecl ^. pos . positionColumn,
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)