From d19355fc9e0018503ea02a3f675939c9077ddf65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?F=C3=A9lix=20Baylac-Jacqu=C3=A9?= Date: Tue, 2 Oct 2018 10:50:07 +0200 Subject: [PATCH] Debugged lookup scope generation. We were looking up for symbols occurences only in the package where they were defined. This was a forgotten WIP mock... --- misc/useful-requests.sql | 12 ++++ src/ExHack/Data/Db.hs | 60 ++++++++++++------- src/ExHack/ProcessingSteps.hs | 3 +- src/ExHack/Renderer/Html.hs | 10 ++-- .../Renderer/templates/modulePage.hamlet | 2 +- 5 files changed, 59 insertions(+), 28 deletions(-) create mode 100644 misc/useful-requests.sql diff --git a/misc/useful-requests.sql b/misc/useful-requests.sql new file mode 100644 index 0000000..0787a00 --- /dev/null +++ b/misc/useful-requests.sql @@ -0,0 +1,12 @@ +-- Those requests are quite handy to manually debug the software. + +-- Check the packages dep graph +select p1.name, '=>', p2.name from dependancies d +inner join packages p1 on (d.packId = p1.packageId) +inner join packages p2 on (d.depId = p2.packageId); + +-- Where did we find the occurences? +select p.name, em.name, es.name from symbolOccurences so +inner join exposedSymbols es on (so.importedSymId = es.id) +inner join exposedModules em on (es.modId = em.id) +inner join packages p on (em.packId = p.packageId); diff --git a/src/ExHack/Data/Db.hs b/src/ExHack/Data/Db.hs index 441bc78..f3a19ab 100644 --- a/src/ExHack/Data/Db.hs +++ b/src/ExHack/Data/Db.hs @@ -35,9 +35,9 @@ import Database.Selda ((:*:) (..), RowID, Selector, Table, aggregate, autoPrimary, count, def, fk, fromRowId, fromSql, groupBy, innerJoin, insertWithPK, insert_, literal, query, - required, restrict, select, table, + required, restrict, select, tableWithSelectors, text, - tryCreateTable, (!), (.==)) + tryCreateTable, (!), (.==), (.||)) import Database.Selda.Backend (MonadSelda (..), SqlValue (SqlInt)) import GHC (SrcSpan (..), getLoc, srcSpanStartCol, srcSpanStartLine) @@ -65,7 +65,9 @@ packages ::  Table (RowID :*: Text :*: Text :*: Text) :*: required "cabal_file" dependancies :: Table (RowID :*: RowID :*: RowID) -dependancies = table "dependancies" $ +depPack :: Selector (RowID :*: RowID :*: RowID) RowID +depId :: Selector (RowID :*: RowID :*: RowID) RowID +(dependancies, _ :*: depPack :*: depId) = tableWithSelectors "dependancies" $ autoPrimary "id" :*: required "packID" `fk` (packages, packageId) :*: required "depID" `fk` (packages, packageId) @@ -126,7 +128,7 @@ initDb = do -- | Save a package dependancies. -- --- Note that if we can't a dependancy in the +-- Note that if we can't find a dependancy in the -- packages table, we'll ignore it. -- -- You should make sure your package database is already @@ -142,7 +144,7 @@ savePackageDeps p = do pks <- select packages restrict (pks ! packageName .== text (pack d)) return $ pks ! packageId - mapM_ (\depId -> insert_ dependancies [ def :*: depId :*: pid ]) (listToMaybe mdid) + mapM_ (\did -> insert_ dependancies [ def :*: pid :*: did]) (listToMaybe mdid) -- | Save a package list in the DB. savePackages :: (MonadSelda m) => [ET.Package] -> m () @@ -191,25 +193,14 @@ queryPkg p = do return $ pks ! packageId listToMaybe <$> r -getPkgModules :: (MonadSelda m, MonadMask m) => ET.Package -> m [IndexedModuleNameT] -getPkgModules p = do - pid <- getPackageId p - q <- query $ do - mods <- select exposedModules - restrict (mods ! modPack .== literal pid) - return (mods ! modId :*: mods ! modName) - pure $ wrapResult <$> q - where - wrapResult (i :*: n) = IndexedModuleNameT (ModuleNameT n, fromRowId i) - -- | Query ExHack database to retrieve the available symbols to be imported -- from within this package. -- -- This scope should be filtered on a per-module basis, depending on the module --- imports, before being used in a symbol unification. +-- imports, before being used in a symbol unification process. getPkgImportScopes :: forall m. (MonadSelda m, MonadMask m) => ET.Package -> m ImportsScope getPkgImportScopes p = do - mods <- getPkgModules p + mods <- getScopeModules p o <- sequence (wrapSyms <$> mods) pure $ HM.fromList o where @@ -224,6 +215,26 @@ getPkgImportScopes p = do pure (mnt, HS.fromList (wrapResult <$> q)) wrapResult (i :*: n) = IndexedSym (SymName n, fromRowId i) +getScopeModules :: (MonadSelda m, MonadMask m) => ET.Package -> m [IndexedModuleNameT] +getScopeModules p = do + pid <- getPackageId p + q <- query $ do + deps <- select dependancies + restrict (deps ! depPack .== literal pid) + mods <- innerJoin (\m -> m ! modPack .== deps ! depId) $ select exposedModules + return (mods ! modId :*: mods ! modName) + -- Here, we also want to look for occurences in current's package module. + -- Not sure if it's a really good idea: we'll find occurences for sure, but we also + -- probably consider the symbol definition as an occurence... + qp <- query $ do + mods <- select exposedModules + restrict $ (mods ! modPack .== literal pid) + return (mods ! modId :*: mods ! modName) + pure $ (wrapResult <$> q) <> (wrapResult <$> qp) + where + wrapResult (i :*: n) = IndexedModuleNameT (ModuleNameT n, fromRowId i) + + -- | Insert both the source file in which some symbols have been unified as well as -- the symbols occurences in ExHack's database. saveModuleUnifiedSymbols :: forall m. (MonadSelda m, MonadMask m) => [UnifiedSym] -> SourceCodeFile -> m () @@ -300,7 +311,12 @@ extractSample line t = (nLine, T.unlines nText) !tLines = T.lines t linesBefore = 15 linesAfter = 5 - !nStart = max 0 (line - linesBefore) - !nEnd = min (linesBefore + linesAfter) (length tLines - nStart) - !nLine = line - nStart - !nText = take nEnd $ drop nStart tLines + -- Nb lines to ignore. + !toIgnore = max 0 (line - linesBefore) + -- Intermediate length, ie init length - ignored lines. + !iLength = length tLines - toIgnore + -- New line number. + !nLine = line - toIgnore + -- Nb lines to take + !toTake = min (nLine + linesAfter) iLength + !nText = take toTake $ drop toIgnore tLines diff --git a/src/ExHack/ProcessingSteps.hs b/src/ExHack/ProcessingSteps.hs index 0d29636..0f03e75 100644 --- a/src/ExHack/ProcessingSteps.hs +++ b/src/ExHack/ProcessingSteps.hs @@ -266,6 +266,7 @@ saveGraphDep pkgs = do -- Builds the packages using cabal, load the modules in a -- GHC-API program which extracts the exports and finally save -- everything in the ex-hack database. +-- TODO: merge those two steps. retrievePkgsExports :: forall c m. (Has c WorkDir, Has c (DatabaseHandle 'DepsGraph), @@ -350,7 +351,7 @@ indexSymbols pkgs = do indexModule dbFp p pfp is (mn,cr) = handleAll logErrors $ do imports <- getModImports pfp cr mn -- fis: filtered import scope according to this module imports - -- isyms: imported symbols hashmap on which we will perform the unification + -- isyms: imported symbols hashsets on which we will perform the unification let !fis = HM.filterWithKey (\(IndexedModuleNameT (n, _)) _ -> n `elem` imports) is !isyms = HS.unions $ HM.elems fis !isymsMap = HS.foldl' (\hm is'@(IndexedSym (n, _)) -> HM.insert n is' hm) HM.empty isyms diff --git a/src/ExHack/Renderer/Html.hs b/src/ExHack/Renderer/Html.hs index 9a3a49b..f365fbd 100644 --- a/src/ExHack/Renderer/Html.hs +++ b/src/ExHack/Renderer/Html.hs @@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadMask, throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Text as T (Text, lines, pack, unlines, unpack) +import Safe (headMay) import System.Exit (ExitCode (..)) import System.Process (readProcessWithExitCode) import Text.Blaze.Html (preEscapedToHtml) @@ -42,11 +43,12 @@ highLightCode t = do ExitFailure _ -> throwM $ HighLightError err addLineMarker :: Int -> T.Text -> T.Text -addLineMarker line t = T.unlines $ start <> [wrapL (head end)] <> drop 1 end +addLineMarker line t = let slm = headMay end + in maybe t (\l -> T.unlines $ start <> [wrapL l] <> drop 1 end) slm where - l = T.lines t - start = take (line - 1) l - end = drop (line - 1) l + xs = T.lines t + start = take (line - 1) xs + end = drop (line - 1) xs wrapL txt = "" <> txt <> "" getHeader :: T.Text -> HtmlUrl Route diff --git a/src/ExHack/Renderer/templates/modulePage.hamlet b/src/ExHack/Renderer/templates/modulePage.hamlet index c69fba1..d67dc4c 100644 --- a/src/ExHack/Renderer/templates/modulePage.hamlet +++ b/src/ExHack/Renderer/templates/modulePage.hamlet @@ -30,7 +30,7 @@ $doctype 5
#{preEscapedToHtml sourceex}
- +