hiedb 0.4.3.0 → 0.4.4.0

raw patch · 8 files changed

+79/−15 lines, 8 filesdep ~algebraic-graphsdep ~basedep ~ghcPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: algebraic-graphs, base, ghc

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• hiedb.cabal +4/−4
• src/HieDb/Compat.hs +19/−5
• src/HieDb/Create.hs +26/−3
• src/HieDb/Query.hs +18/−2
• src/HieDb/Run.hs +3/−1
• src/HieDb/Utils.hs +1/−0
• test/Main.hs +1/−0

@@ -1,5 +1,12 @@ # Revision history for hiedb +## 0.4.4.0 -- 2023-11-13+* Add `--src-base-dir` option allowing for src file indexing in `mods`+* 9.8.1 support+* Add `lookupHieFileFromHash`+* Add `lookupPackage`+* Add `removeDependencySrcFiles`+ ## 0.4.3.0 -- 2023-03-13  * Support GHC 9.6

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                hiedb-version:             0.4.3.0+version:             0.4.4.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@@ -26,7 +26,7 @@  common common-options   default-language:    Haskell2010-  build-depends:       base >= 4.12 && < 4.18+  build-depends:       base >= 4.12 && < 4.20   ghc-options:         -Wall                        -Wincomplete-uni-patterns                        -Wincomplete-record-updates@@ -55,7 +55,7 @@                        HieDb.Dump,                        HieDb.Html,                        HieDb.Run-  build-depends:       ghc >= 8.6+  build-depends:       ghc >= 8.6 && < 9.9                      , array                      , containers                      , filepath@@ -65,7 +65,7 @@                      , hie-compat ^>= 0.3                      , text                      , bytestring-                     , algebraic-graphs >= 0.3 && < 0.7+                     , algebraic-graphs >= 0.3                      , lucid                      , optparse-applicative                      , extra

@@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, PatternSynonyms, ViewPatterns #-}+{-# LANGUAGE CPP, PatternSynonyms, ViewPatterns, TupleSections #-} module HieDb.Compat (     nodeInfo'     , Unit@@ -80,6 +80,7 @@     , IfaceType     , IfaceTyCon(..)     , field_label+    , dfs ) where  import Compat.HieTypes@@ -135,6 +136,8 @@  import qualified Data.Map as M import qualified Data.Set as S+import qualified Algebra.Graph.AdjacencyMap           as Graph+import qualified Algebra.Graph.AdjacencyMap.Algorithm as Graph   -- nodeInfo' :: Ord a => HieAST a -> NodeInfo a@@ -182,7 +185,9 @@ {-# COMPLETE AvailTC, AvailName, AvailFL #-}  pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo-#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 907+pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces))+#elif __GLASGOW_HASKELL__ >= 902 pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names, pieces) -> case gre of       Avail.NormalGreName name -> (name: names, pieces)       Avail.FieldGreName label -> (names, label:pieces)) ([], []) gres) -> (names, pieces))@@ -191,14 +196,18 @@ #endif  pattern AvailName :: Name -> Avail.AvailInfo-#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 907+pattern AvailName n <- Avail.Avail n+#elif __GLASGOW_HASKELL__ >= 902 pattern AvailName n <- Avail.Avail (Avail.NormalGreName n) #else pattern AvailName n <- Avail.Avail n #endif  pattern AvailFL :: FieldLabel -> Avail.AvailInfo-#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 907+pattern AvailFL fl <- (const Nothing -> Just fl) -- this pattern always fails as this field was removed in 9.7+#elif __GLASGOW_HASKELL__ >= 902 pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl) #else -- pattern synonym that is never populated@@ -214,4 +223,9 @@ field_label = id #endif -+dfs :: Ord a => Graph.AdjacencyMap a -> [a] -> [a]+#if MIN_VERSION_algebraic_graphs(0,7,0)+dfs = Graph.dfs+#else+dfs = flip Graph.dfs+#endif

@@ -26,6 +26,7 @@ import Data.String  import System.Directory+import System.FilePath  import Database.SQLite.Simple @@ -210,15 +211,28 @@ The indexing is skipped if the file was not modified since the last time it was indexed. The boolean returned is true if the file was actually indexed -}-addRefsFrom :: (MonadIO m, NameCacheMonad m) => HieDb -> FilePath -> m Bool-addRefsFrom c@(getConn -> conn) path = do+addRefsFrom :: (MonadIO m, NameCacheMonad m) => HieDb -> Maybe FilePath -> FilePath -> m Bool+addRefsFrom c@(getConn -> conn) mSrcBaseDir path = do   hash <- liftIO $ getFileHash path   mods <- liftIO $ query conn "SELECT * FROM mods WHERE hieFile = ? AND hash = ?" (path, hash)   case mods of     (HieModuleRow{}:_) -> pure False     [] -> do-      withHieFile path $ addRefsFromLoaded c path (FakeFile Nothing) hash+      withHieFile path $ addRefsWithFile  hash       pure True+  where+      addRefsWithFile :: MonadIO m => Fingerprint -> HieFile -> m ()+      addRefsWithFile hash hieFile = do+        srcfile <- liftIO $+              maybe+                (pure . FakeFile $ Nothing)+                (\srcBaseDir ->  do+                    srcFullPath <- makeAbsolute (srcBaseDir </> hie_hs_file hieFile)+                    fileExists <- doesFileExist srcFullPath+                    pure $ if fileExists then RealFile srcFullPath else (FakeFile Nothing)+                )+                mSrcBaseDir+        addRefsFromLoaded c path srcfile hash hieFile  addRefsFromLoaded   :: MonadIO m@@ -290,6 +304,15 @@   -> IO () addSrcFile (getConn -> conn) hie srcFile isReal =   execute conn "UPDATE mods SET hs_src = ? , is_real = ? WHERE hieFile = ?" (srcFile, isReal, hie)++{-| Remove the path to .hs source for all dependency @.hie@ files. Useful for resetting+the indexed dependencies if the sources have been deleted for some reason.+-}+removeDependencySrcFiles+  :: HieDb+  -> IO ()+removeDependencySrcFiles (getConn -> conn) =+  execute conn "UPDATE mods SET hs_src = NULL WHERE NOT is_real" ()  {-| Delete all occurrences of given @.hie@ file from the database -} deleteFileFromIndex :: HieDb -> FilePath -> IO ()

@@ -6,7 +6,6 @@ module HieDb.Query where  import           Algebra.Graph.AdjacencyMap (AdjacencyMap, edges, vertexSet, vertices, overlay)-import           Algebra.Graph.AdjacencyMap.Algorithm (dfs) import           Algebra.Graph.Export.Dot hiding ((:=)) import qualified Algebra.Graph.Export.Dot as G @@ -78,6 +77,11 @@             \((NOT :real) OR (mods.is_real AND mods.hs_src IS NOT NULL))"       <> " AND mods.hs_src NOT IN (" <> Query (T.intercalate "," (map (\(l := _) -> l) excludedFields)) <> ")" +{-| Lookup all 'HieModule' rows from 'HieDb' that are part of a given 'Unit' -}+lookupPackage :: HieDb -> Unit -> IO [HieModuleRow]+lookupPackage (getConn -> conn) uid =+  query conn "SELECT * FROM mods WHERE unit = ?" (Only uid)+ {-| Lookup 'HieModule' row from 'HieDb' given its 'ModuleName' and 'Unit' -} lookupHieFile :: HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow) lookupHieFile (getConn -> conn) mn uid = do@@ -102,6 +106,18 @@             ++ show fp ++ ". Entries: "             ++ intercalate ", " (map (show . toRow) xs) +{-| Lookup 'HieModule' row from 'HieDb' given the hash of the HIE file -}+lookupHieFileFromHash :: HieDb -> Fingerprint -> IO (Maybe HieModuleRow)+lookupHieFileFromHash (getConn -> conn) hash = do+  files <- query conn "SELECT * FROM mods WHERE hash = ?" (Only hash)+  case files of+    [] -> return Nothing+    [x] -> return $ Just x+    xs ->+      error $ "DB invariant violated, hash in mods not unique: "+            ++ show hash ++ ". Entries: "+            ++ intercalate ", " (map (show . toRow) xs)+ findTypeRefs :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe Unit -> [FilePath] -> IO [Res TypeRef] findTypeRefs (getConn -> conn) isReal occ mn uid exclude   = queryNamed conn thisQuery ([":occ" := occ, ":mod" := mn, ":unit" := uid, ":real" := isReal] ++ excludedFields)@@ -267,4 +283,4 @@   return (Set.toList xs, Set.toList ys)  splitByReachability :: Ord a => AdjacencyMap a -> [a] -> (Set a, Set a)-splitByReachability m vs = let s = Set.fromList (dfs vs m) in (s, vertexSet m Set.\\ s)+splitByReachability m vs = let s = Set.fromList (dfs m vs) in (s, vertexSet m Set.\\ s)

@@ -79,6 +79,7 @@   , context :: Maybe Natural   , reindex :: Bool   , keepMissing :: Bool+  , srcBaseDir :: Maybe FilePath   }  data Command@@ -125,6 +126,7 @@   <*> optional (option auto (long "context" <> short 'C' <> help "Number of lines of context for source spans - show no context by default"))   <*> switch (long "reindex" <> short 'r' <> help "Re-index all files in database before running command, deleting those with missing '.hie' files")   <*> switch (long "keep-missing" <> help "Keep missing files when re-indexing")+  <*> optional (strOption (long "src-base-dir" <> help "Provide a base directory to index src files as real files"))   where     colourFlag = flag' True (long "colour" <> long "color" <> help "Force coloured output")             <|> flag' False (long "no-colour" <> long "no-color" <> help "Force uncoloured ouput")@@ -236,7 +238,7 @@    istart <- offsetTime   (length -> done, length -> skipped)<- runDbM nc $ partition id <$>-    zipWithM (\f n -> progress' h (length files) n (addRefsFrom conn) f) files [0..]+    zipWithM (\f n -> progress' h (length files) n (addRefsFrom conn (srcBaseDir opts)) f) files [0..]   indexTime <- istart    start <- offsetTime

@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}

@@ -370,4 +370,5 @@   , context = Nothing   , reindex = False   , keepMissing = False+  , srcBaseDir = Nothing   }