hiedb 0.6.0.2 → 0.7.0.0

raw patch · 8 files changed

+146/−44 lines, 8 filesdep ~algebraic-graphsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: algebraic-graphs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• hiedb.cabal +3/−2
• src/HieDb/Create.hs +24/−9
• src/HieDb/Query.hs +54/−10
• src/HieDb/Run.hs +11/−3
• src/HieDb/Types.hs +15/−13
• src/HieDb/Utils.hs +5/−5
• test/Main.hs +27/−2

@@ -1,5 +1,12 @@ # Revision history for hiedb +## 0.7.0.0++* DB schema change: added new bool field `refs.is_generated` to distinguish between references coming from source code+and those generated by the compiler+* Extended `hie-db ref-graph` cli command by adding possibility to filter by occurrence name / module / unit-id:+    `hiedb ref-graph [NAME] [MODULE] [-u|--unit-id UNITID]`+ ## 0.6.0.2  * Bump base and ghc version bounds to support GHC 9.12

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                hiedb-version:             0.6.0.2+version:             0.7.0.0 synopsis:            Generates a references DB from .hie files description:         Tool and library to index and query a collection of `.hie` files bug-reports:         https://github.com/wz1000/HieDb/issues@@ -21,7 +21,7 @@                       || ==9.4.8                       || ==9.6.7                       || ==9.8.4-                      || ==9.10.1+                      || ==9.10.2                       || ==9.12.2  source-repository head@@ -92,3 +92,4 @@                     , hspec                     , process                     , temporary+                    , algebraic-graphs

@@ -4,6 +4,8 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use camelCase" #-} module HieDb.Create where  import Prelude hiding (mod)@@ -37,7 +39,7 @@ import HieDb.Utils  sCHEMA_VERSION :: Integer-sCHEMA_VERSION = 8+sCHEMA_VERSION = 9  dB_VERSION :: Integer dB_VERSION = read (show sCHEMA_VERSION ++ "999" ++ show hieVersion)@@ -117,6 +119,7 @@                 \, sc   INTEGER NOT NULL \                 \, el   INTEGER NOT NULL \                 \, ec   INTEGER NOT NULL \+                \, is_generated BOOLEAN NOT NULL \                 \, FOREIGN KEY(hieFile) REFERENCES mods(hieFile) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED \                 \)"   execute_ conn "CREATE INDEX IF NOT EXISTS refs_mod ON refs(hieFile)"@@ -331,27 +334,39 @@       mod    = moduleName smod       uid    = moduleUnit smod       smod   = hie_module hf-      refmap = generateReferencesMap $ getAsts $ hie_asts hf+      asts   = getAsts $ hie_asts hf+      refmapAll = generateReferencesMap asts+      refmapSourceOnly = generateReferencesMap $ fmap (dropNodeInfos GeneratedInfo) asts+      refmapGeneratedOnly = generateReferencesMap $ fmap (dropNodeInfos SourceInfo) asts       (srcFile, isReal) = case sourceFile of         RealFile f -> (Just f, True)         FakeFile mf -> (mf, False)       modrow = HieModuleRow path (ModuleInfo mod uid isBoot srcFile isReal hash) +      -- We want to distinguish between references from source (NodeOrigin is SourceInfo)+      -- vs. generated by compiler (NodeOrigin is GeneratedInfo).+      -- Unfortunately generateReferencesMap throws away the info about NodeOrigin,+      -- so we need to use this to preprocess the ASTs from which the references map is generated.+      dropNodeInfos :: NodeOrigin -> HieAST a -> HieAST a+      dropNodeInfos originToDrop (Node (SourcedNodeInfo sniMap) sp children) =+        let sourceOnlyNodeInfo = SourcedNodeInfo $ M.delete originToDrop sniMap+        in Node sourceOnlyNodeInfo sp (map (dropNodeInfos originToDrop) children)+   execute conn "INSERT INTO mods VALUES (?,?,?,?,?,?,?)" modrow -  let AstInfo rows decls imports = genAstInfo path smod refmap+  let AstInfo refsSrc declsSrc importsSrc = genAstInfo path smod SourceInfo refmapSourceOnly+      AstInfo refsGen declsGen importsGen = genAstInfo path smod GeneratedInfo refmapGeneratedOnly    unless (skipRefs skipOptions) $-    executeMany conn "INSERT INTO refs  VALUES (?,?,?,?,?,?,?,?)" rows+    executeMany conn "INSERT INTO refs VALUES (?,?,?,?,?,?,?,?,?)" (refsSrc <> refsGen)   unless (skipDecls skipOptions) $-    executeMany conn "INSERT INTO decls VALUES (?,?,?,?,?,?,?)" decls+    executeMany conn "INSERT INTO decls VALUES (?,?,?,?,?,?,?)" (declsSrc <> declsGen)   unless (skipImports skipOptions) $-    executeMany conn "INSERT INTO imports VALUES (?,?,?,?,?,?)" imports+    executeMany conn "INSERT INTO imports VALUES (?,?,?,?,?,?)" (importsSrc <> importsGen) -  let defs = genDefRow path smod refmap+  let defs = genDefRow path smod refmapAll   unless (skipDefs skipOptions) $-    forM_ defs $ \def ->-      execute conn "INSERT INTO defs VALUES (?,?,?,?,?,?)" def+      executeMany conn "INSERT INTO defs VALUES (?,?,?,?,?,?)" defs    let exports = generateExports path $ hie_exports hf   unless (skipExports skipOptions) $

@@ -5,7 +5,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module HieDb.Query where -import           Algebra.Graph.AdjacencyMap (AdjacencyMap, edges, vertexSet, vertices, overlay)+import           Algebra.Graph.AdjacencyMap (AdjacencyMap, edges, induce, vertexSet, vertices, overlay, transpose)+import           Algebra.Graph.AdjacencyMap.Algorithm (reachable) import           Algebra.Graph.Export.Dot hiding ((:=)) import qualified Algebra.Graph.Export.Dot as G @@ -140,12 +141,7 @@                               [":occ" := occ,":mod" := mn, ":unit" := uid]  findOneDef :: HieDb -> OccName -> Maybe ModuleName -> Maybe Unit -> IO (Either HieDbErr (Res DefRow))-findOneDef conn occ mn muid = wrap <$> findDef conn occ mn muid-  where-    wrap [x]    = Right x-    wrap []     = Left $ NameNotFound occ mn muid-    wrap (x:xs) = Left $ AmbiguousUnitId (defUnit x :| map defUnit xs)-    defUnit (_:.i) = i+findOneDef = findOneVia . findDef  searchDef :: HieDb -> String -> IO [Res DefRow] searchDef conn cs@@ -154,6 +150,30 @@                          \WHERE occ LIKE ? \                          \LIMIT 200" (Only $ '_':':':cs++"%") +findDecl :: HieDb -> OccName -> Maybe ModuleName -> Maybe Unit -> IO [Res DeclRow]+findDecl conn occ mn uid+  = queryNamed (getConn conn) "SELECT decls.*, mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.hash \+                              \FROM decls JOIN mods USING (hieFile) \+                              \WHERE occ = :occ AND (:mod IS NULL OR mod = :mod) AND (:unit IS NULL OR unit = :unit)"+                              [":occ" := occ,":mod" := mn, ":unit" := uid]++findOneDecl :: HieDb -> OccName -> Maybe ModuleName -> Maybe Unit -> IO (Either HieDbErr (Res DeclRow))+findOneDecl = findOneVia . findDecl++findOneVia+  :: Functor f+  => (OccName -> Maybe ModuleName -> Maybe Unit -> f [Res a])+  -> OccName+  -> Maybe ModuleName+  -> Maybe Unit+  -> f (Either HieDbErr (Res a))+findOneVia f occ mn muid = wrap <$> f occ mn muid+  where+    wrap [x]    = Right x+    wrap []     = Left $ NameNotFound occ mn muid+    wrap (x:xs) = Left $ AmbiguousUnitId (declUnit x :| map declUnit xs)+    declUnit (_:.i) = i+ {-| @withTarget db t f@ runs function @f@ with HieFile specified by HieTarget @t@. In case the target is given by ModuleName (and optionally Unit) it is first resolved from HieDb, which can lead to error if given file is not indexed/Module name is ambiguous.@@ -184,8 +204,27 @@  type Vertex = (String, String, String, Int, Int, Int, Int) -declRefs :: HieDb -> IO ()-declRefs db = do+-- | Find a @'Res' 'DeclRow'@ by name and return it as a 'Vertex'+lookupVertex :: HieDb -> OccName -> Maybe ModuleName -> Maybe Unit -> IO (Either HieDbErr Vertex)+lookupVertex db occ mm muid =+  fmap declRowToVertex <$> findOneDecl db occ mm muid+ where+  declRowToVertex :: Res DeclRow -> Vertex+  declRowToVertex (dr :. mi) =+    ( moduleNameString $ modInfoName mi+    , declSrc dr+    , occNameToField $ declNameOcc dr+    , declSLine dr+    , declSCol dr+    , declELine dr+    , declECol dr+    )++  occNameToField :: OccName -> String+  occNameToField occ = toNsChar (occNameSpace occ) ++ occNameString occ++declRefs :: HieDb -> Maybe Vertex -> IO ()+declRefs db mv = do   graph <- getGraph db   writeFile     "refs.dot"@@ -197,8 +236,13 @@               ]           }         )-        graph+        (maybe id pruneToCallersOf mv graph)     )++pruneToCallersOf :: Vertex -> AdjacencyMap Vertex -> AdjacencyMap Vertex+pruneToCallersOf v g = induce (`elem` vs) g+ where+  vs = reachable (transpose g) v  getGraph :: HieDb -> IO (AdjacencyMap Vertex) getGraph (getConn -> conn) = do

@@ -37,6 +37,7 @@ import Data.Foldable import Data.IORef import Data.List.Extra+import Data.Traversable (for)  import Numeric.Natural @@ -101,7 +102,7 @@   | TypesAtPoint HieTarget (Int,Int) (Maybe (Int,Int))   | DefsAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))   | InfoAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))-  | RefGraph+  | RefGraph (Maybe String) (Maybe ModuleName) (Maybe Unit)   | Dump FilePath   | Reachable [Symbol]   | Unreachable [Symbol]@@ -205,7 +206,10 @@                             <*> posParser 'S'                             <*> optional (posParser 'E'))               $ progDesc "Print name, module name, unit id for symbol at point/span")-  <> command "ref-graph" (info (pure RefGraph) $ progDesc "Generate a reachability graph")+  <> command "ref-graph" (info (RefGraph <$> optional (strArgument (metavar "NAME"))+                                         <*> optional moduleNameParser+                                         <*> maybeUnitId)+                         $ progDesc "Generate a reachability graph")   <> command "dump" (info (Dump <$> strArgument (metavar "HIE")) $ progDesc "Dump a HIE AST")   <> command "reachable" (info (Reachable <$> some symbolParser)                          $ progDesc "Find all symbols reachable from the given symbols")@@ -429,7 +433,11 @@     InfoAtPoint target sp mep -> hieFileCommand conn opts target $ \hf -> do       mapM_ (uncurry $ printInfo dynFlags) $ pointCommand hf sp mep $ \ast ->         (hieTypeToIface . flip recoverFullType (hie_types hf) <$> nodeInfo' ast, nodeSpan ast)-    RefGraph -> declRefs conn+    RefGraph mname mm muid -> do+      mv <- for mname $ \n -> do+        let ns = if isCons n then dataName else varName+        reportAmbiguousErr opts =<< lookupVertex conn (mkOccName ns n) mm muid+      declRefs conn mv     Dump path -> do       nc <- newIORef =<< makeNc       runDbM nc $ dump dynFlags path

@@ -150,15 +150,17 @@   , refSCol :: Int   , refELine :: Int   , refECol :: Int+  , refIsGenerated :: Bool -- ^ True if the reference to this name is generated by GHC (NodeOrigin is GeneratedInfo)+                           -- False if it comes from the source code (NodeOrigin is SourceInfo)   }  instance ToRow RefRow where-  toRow (RefRow a b c d e f g h) = toRow ((a,b,c):.(d,e,f):.(g,h))+  toRow (RefRow a b c d e f g h i) = toRow ((a,b,c):.(d,e,f):.(g,h,i))  instance FromRow RefRow where   fromRow = RefRow <$> field <*> field <*> field                    <*> field <*> field <*> field-                   <*> field <*> field+                   <*> field <*> field <*> field  data DeclRow   = DeclRow@@ -178,23 +180,23 @@   fromRow = DeclRow <$> field <*> field <*> field <*> field                     <*> field <*> field <*> field -data ImportRow -  = ImportRow +data ImportRow+  = ImportRow     { importSrc :: FilePath     , importModuleName :: ModuleName-    , importSLine :: Int -    , importSCol :: Int -    , importELine :: Int -    , importECol :: Int +    , importSLine :: Int+    , importSCol :: Int+    , importELine :: Int+    , importECol :: Int     } -instance FromRow ImportRow where -  fromRow = -    ImportRow -      <$> field <*> field <*> field <*> field +instance FromRow ImportRow where+  fromRow =+    ImportRow+      <$> field <*> field <*> field <*> field       <*> field <*> field -instance ToRow ImportRow where +instance ToRow ImportRow where   toRow (ImportRow a b c d e f) = toRow ((a,b,c,d):.(e,f))  data TypeName = TypeName

@@ -179,18 +179,18 @@ instance Monoid AstInfo where   mempty = AstInfo [] [] [] -genAstInfo :: FilePath -> Module -> M.Map Identifier [(Span, IdentifierDetails a)] -> AstInfo-genAstInfo path smdl refmap = genRows $ flat $ M.toList refmap+genAstInfo :: FilePath -> Module -> NodeOrigin -> M.Map Identifier [(Span, IdentifierDetails a)] -> AstInfo+genAstInfo path smdl nodeOrigin refmap = genRows $ flat $ M.toList refmap   where+    isGenerated = nodeOrigin == GeneratedInfo     flat = concatMap (\(a,xs) -> map (a,) xs)-    genRows = foldMap go-    go = mkAstInfo+    genRows = foldMap mkAstInfo      mkAstInfo x = AstInfo (maybeToList $ goRef x) (maybeToList $ goDec x) (maybeToList $ goImport x)      goRef (Right name, (sp,_))       | Just mod <- nameModule_maybe name = Just $-          RefRow path occ (moduleName mod) (moduleUnit mod) sl sc el ec+          RefRow path occ (moduleName mod) (moduleUnit mod) sl sc el ec isGenerated           where             occ = nameOccName name             sl = srcSpanStartLine sp

@@ -1,13 +1,15 @@ {-# LANGUAGE CPP #-} module Main where +import qualified Algebra.Graph.AdjacencyMap as AdjacencyMap+import Data.Bifunctor (bimap) import GHC.Paths (libdir, ghc) import HieDb (HieDb, HieModuleRow (..), LibDir (..), ModuleInfo (..), withHieDb, withHieFile, addRefsFromLoaded, deleteMissingRealFiles, defaultSkipOptions)-import HieDb.Query (getAllIndexedMods, lookupHieFile, resolveUnitId, lookupHieFileFromSource)+import HieDb.Query (Vertex, getAllIndexedMods, lookupHieFile, resolveUnitId, lookupHieFileFromSource, lookupVertex, getGraph, pruneToCallersOf) import HieDb.Run (Command (..), Options (..), runCommand) import HieDb.Types (HieDbErr (..), SourceFile(..), runDbM) import HieDb.Utils (makeNc)-import HieDb.Compat (stringToUnit, moduleNameString, mkModuleName, getFileHash)+import HieDb.Compat (stringToUnit, moduleNameString, mkModuleName, getFileHash, mkOccName, varName) import System.Directory (findExecutable, getCurrentDirectory, removeDirectoryRecursive) import System.Exit (ExitCode (..), die) import System.FilePath ((</>))@@ -124,6 +126,29 @@             -- Check that the other modules are still indexed             afterMods <- getAllIndexedMods conn             originalMods `shouldBe` afterMods++        describe "pruneToCallersOf" $ do+          it "prunes the graph to recursive callers of an identifier" $ \conn -> do+            result <- lookupVertex conn (mkOccName varName "showInt") Nothing Nothing++            case result of+              Left _ -> fail "Failed to lookup vertex for v:showInt"+              Right v -> do+                g <- getGraph conn++                let+                  renderFn :: Vertex -> String+                  renderFn (modName, _, fnName, _, _, _, _) = modName <> "." <> fnName++                  callers =+                      map (bimap renderFn (map renderFn))+                        $ AdjacencyMap.adjacencyList+                        $ pruneToCallersOf v g++                callers `shouldBe`+                  [ ("Module1.v:function2", ["Sub.Module2.v:showInt"])+                  , ("Sub.Module2.v:showInt", [])+                  ]  cliSpec :: Spec cliSpec =