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

@@ -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);

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

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 

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 = "<span class=\"occ-line\">" <> txt <> "</span>" 
 
 getHeader :: T.Text -> HtmlUrl Route

src/ExHack/Renderer/templates/modulePage.hamlet

@@ -30,7 +30,7 @@ $doctype 5
                                                 <div class="example">
                                                    #{preEscapedToHtml sourceex}
                                                 <hr>
-        <script src="/static/list.min.js"></script>
+        <script src="/static/list.min.js">
         <script>
             document.addEventListener("DOMContentLoaded", function(event) {
                 var list = new List('symbols', {