hiedb 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+73/−50 lines, 7 filesdep +extradep −timePVP ok

version bump matches the API change (PVP)

Dependencies added: extra

Dependencies removed: time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• hiedb.cabal +2/−2
• src/HieDb/Create.hs +16/−18
• src/HieDb/Query.hs +21/−17
• src/HieDb/Run.hs +17/−10
• src/HieDb/Types.hs +7/−2
• src/HieDb/Utils.hs +1/−1

@@ -1,5 +1,14 @@ # Revision history for hiedb +## 0.2.0.0 -- 2021-01-06++* Use fingerprints/hashes instead of modtimes to maintin database consistency+* Type references are only reported for bind sites+* Type references are computed for all files+* Total time taken to index is reported+* `search` is now called `findReferences`+* `findTypeRefs` has a similar type signature to `findReferences`+ ## 0.1.0.0 -- 2020-11-08  * First version.

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                hiedb-version:             0.1.0.0+version:             0.2.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@@ -55,12 +55,12 @@                      , mtl                      , sqlite-simple                      , hie-compat-                     , time                      , text                      , bytestring                      , algebraic-graphs                      , lucid                      , optparse-applicative+                     , extra                      , terminal-size  test-suite hiedb-tests

@@ -18,13 +18,11 @@ import Control.Monad import Control.Exception -import System.Directory- import Database.SQLite.Simple-import Data.Time.Clock import Data.List ( isSuffixOf ) import Data.String import Data.Int+import GHC.Fingerprint  import HieDb.Types import HieDb.Utils@@ -33,7 +31,7 @@ import Data.Maybe  sCHEMA_VERSION :: Integer-sCHEMA_VERSION = 4+sCHEMA_VERSION = 5  dB_VERSION :: Integer dB_VERSION = read (show sCHEMA_VERSION ++ "999" ++ show hieVersion)@@ -81,7 +79,7 @@                 \, is_boot BOOL NOT NULL \                 \, hs_src  TEXT UNIQUE ON CONFLICT REPLACE \                 \, is_real BOOL NOT NULL \-                \, time    TEXT NOT NULL \+                \, hash    TEXT NOT NULL UNIQUE ON CONFLICT REPLACE \                 \, CONSTRAINT modid UNIQUE (mod, unit, is_boot) ON CONFLICT REPLACE \                 \)" @@ -173,9 +171,11 @@     asts = getAsts $ hie_asts hf     addTypesFromAst :: HieAST TypeIndex -> IO ()     addTypesFromAst ast = do-      mapM_ (addTypeRef db path arr ixs (nodeSpan ast)) $ mapMaybe identType $ M.elems $ nodeIdentifiers $ nodeInfo ast-      when (null $ nodeChildren ast) $-        mapM_ (addTypeRef db path arr ixs (nodeSpan ast)) $ nodeType $ nodeInfo ast+      mapM_ (addTypeRef db path arr ixs (nodeSpan ast))+        $ mapMaybe (\x -> guard (any (not . isOccurrence) (identInfo x)) *> identType x)+        $ M.elems+        $ nodeIdentifiers+        $ nodeInfo ast       mapM_ addTypesFromAst $ nodeChildren ast  {-| Adds all references from given @.hie@ file to 'HieDb'.@@ -183,11 +183,11 @@ -} addRefsFrom :: (MonadIO m, NameCacheMonad m) => HieDb -> FilePath -> m () addRefsFrom c@(getConn -> conn) path = do-  time <- liftIO $ getModificationTime path-  mods <- liftIO $ query conn "SELECT * FROM mods WHERE hieFile = ? AND time >= ?" (path, time)+  hash <- liftIO $ getFileHash path+  mods <- liftIO $ query conn "SELECT * FROM mods WHERE hieFile = ? AND hash = ?" (path, hash)   case mods of     (HieModuleRow{}:_) -> return ()-    [] -> withHieFile path $ \hf -> addRefsFromLoaded c path Nothing False time hf+    [] -> withHieFile path $ \hf -> addRefsFromLoaded c path Nothing False hash hf  addRefsFromLoaded   :: MonadIO m@@ -195,10 +195,10 @@   -> FilePath -- ^ Path to @.hie@ file   -> Maybe FilePath -- ^ Path to .hs file from which @.hie@ file was created   -> Bool -- ^ Is this a real source file? I.e. does it come from user's project (as opposed to from project's dependency)?-  -> UTCTime -- ^ The last modification time of the @.hie@ file+  -> Fingerprint -- ^ The hash of the @.hie@ file   -> HieFile -- ^ Data loaded from the @.hie@ file   -> m ()-addRefsFromLoaded db@(getConn -> conn) path srcFile isReal time hf = liftIO $ withTransaction conn $ do+addRefsFromLoaded db@(getConn -> conn) path srcFile isReal hash hf = liftIO $ withTransaction conn $ do   execute conn "DELETE FROM refs  WHERE hieFile = ?" (Only path)   execute conn "DELETE FROM decls WHERE hieFile = ?" (Only path)   execute conn "DELETE FROM defs  WHERE hieFile = ?" (Only path)@@ -209,7 +209,7 @@       uid    = moduleUnitId smod       smod   = hie_module hf       refmap = generateReferencesMap $ getAsts $ hie_asts hf-      modrow = HieModuleRow path (ModuleInfo mod uid isBoot srcFile isReal time)+      modrow = HieModuleRow path (ModuleInfo mod uid isBoot srcFile isReal hash)    execute conn "INSERT INTO mods VALUES (?,?,?,?,?,?,?)" modrow @@ -217,13 +217,11 @@   executeMany conn "INSERT INTO refs  VALUES (?,?,?,?,?,?,?,?)" rows   executeMany conn "INSERT INTO decls VALUES (?,?,?,?,?,?,?)" decls -  ixs <- addArr db (hie_types hf)-   let defs = genDefRow path smod refmap   executeMany conn "INSERT INTO defs VALUES (?,?,?,?,?,?)" defs -  when isReal $-    addTypeRefs db path hf ixs+  ixs <- addArr db (hie_types hf)+  addTypeRefs db path hf ixs  {-| Add path to .hs source given path to @.hie@ file which has already been indexed. No action is taken if the corresponding @.hie@ file has not been indexed yet.

@@ -35,7 +35,6 @@ import           HieDb.Dump (sourceCode) import           HieDb.Types import           HieDb.Utils-import           HieDb.Create import qualified HieDb.Html as Html  {-| List all modules indexed in HieDb. -}@@ -48,21 +47,22 @@ -} resolveUnitId :: HieDb -> ModuleName -> IO (Either HieDbErr UnitId) resolveUnitId (getConn -> conn) mn = do-  luid <- query conn "SELECT mod, unit, is_boot, hs_src, is_real, time FROM mods WHERE mod = ? and is_boot = 0" (Only mn)+  luid <- query conn "SELECT mod, unit, is_boot, hs_src, is_real, hash FROM mods WHERE mod = ? and is_boot = 0" (Only mn)   return $ case luid of     [] ->  Left $ NotIndexed mn Nothing     [x] -> Right $ modInfoUnit x     (x:xs) -> Left $ AmbiguousUnitId $ x :| xs -search :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe UnitId -> [FilePath] -> IO [Res RefRow]-search (getConn -> conn) isReal occ mn uid exclude =+findReferences :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe UnitId -> [FilePath] -> IO [Res RefRow]+findReferences (getConn -> conn) isReal occ mn uid exclude =   queryNamed conn thisQuery ([":occ" := occ, ":mod" := mn, ":unit" := uid, ":real" := isReal] ++ excludedFields)   where     excludedFields = zipWith (\n f -> (":exclude" <> T.pack (show n)) := f) [1 :: Int ..] exclude     thisQuery =-      "SELECT refs.*,mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.time \+      "SELECT refs.*,mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.hash \       \FROM refs JOIN mods USING (hieFile) \-      \WHERE refs.occ = :occ AND (:mod IS NULL OR refs.mod = :mod) AND (:unit is NULL OR refs.unit = :unit) AND ( (NOT :real) OR (mods.is_real AND mods.hs_src IS NOT NULL))"+      \WHERE refs.occ = :occ AND (:mod IS NULL OR refs.mod = :mod) AND (:unit is NULL OR refs.unit = :unit) AND \+            \((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 'HieModule' row from 'HieDb' given its 'ModuleName' and 'UnitId' -}@@ -89,18 +89,23 @@             ++ show fp ++ ". Entries: "             ++ intercalate ", " (map (show . toRow) xs) -findTypeRefs :: HieDb -> OccName -> ModuleName -> UnitId -> IO [Res TypeRef]-findTypeRefs (getConn -> conn) occ mn uid-  = query conn  "SELECT typerefs.*, mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.time \-                \FROM typerefs JOIN mods ON typerefs.hieFile = mods.hieFile \-                              \JOIN typenames ON typerefs.id = typenames.id \-                \WHERE typenames.name = ? AND typenames.mod = ? AND typenames.unit = ? AND mods.is_real \-                       \ORDER BY typerefs.depth ASC"-                (occ,mn,uid)+findTypeRefs :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe UnitId -> [FilePath] -> IO [Res TypeRef]+findTypeRefs (getConn -> conn) isReal occ mn uid exclude+  = queryNamed conn thisQuery ([":occ" := occ, ":mod" := mn, ":unit" := uid, ":real" := isReal] ++ excludedFields)+  where+    excludedFields = zipWith (\n f -> (":exclude" <> T.pack (show n)) := f) [1 :: Int ..] exclude+    thisQuery =+      "SELECT typerefs.*, mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.hash \+      \FROM typerefs JOIN mods ON typerefs.hieFile = mods.hieFile \+                    \JOIN typenames ON typerefs.id = typenames.id \+      \WHERE typenames.name = :occ AND (:mod IS NULL OR typenames.mod = :mod) AND \+            \(:unit IS NULL OR typenames.unit = :unit) AND ((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)) <> ")"+      <> " ORDER BY typerefs.depth ASC"  findDef :: HieDb -> OccName -> Maybe ModuleName -> Maybe UnitId -> IO [Res DefRow] findDef conn occ mn uid-  = queryNamed (getConn conn) "SELECT defs.*, mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.time \+  = queryNamed (getConn conn) "SELECT defs.*, mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.hash \                               \FROM defs 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]@@ -115,7 +120,7 @@  searchDef :: HieDb -> String -> IO [Res DefRow] searchDef conn cs-  = query (getConn conn) "SELECT defs.*,mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.time \+  = query (getConn conn) "SELECT defs.*,mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.hash \                          \FROM defs JOIN mods USING (hieFile) \                          \WHERE occ LIKE ? \                          \LIMIT 200" (Only $ '_':cs++"%")@@ -145,7 +150,6 @@       fp' <- canonicalizePath fp       nc <- newIORef =<< makeNc       runDbM nc $ do-        addRefsFrom conn fp'         Right <$> withHieFile fp' (return . f)    

@@ -23,6 +23,7 @@ import System.Directory import System.IO import System.Exit+import System.Time.Extra  import System.Console.Terminal.Size @@ -187,11 +188,15 @@       (Left <$> strOption (long "hiefile" <> short 'f' <> metavar "HIEFILE"))   <|> (Right <$> ((,) <$> moduleNameParser  <*> maybeUnitId)) -progress :: Int -> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a-progress l total cur act f = do-  liftIO $ putStr $ replicate l ' '-  liftIO $ putStr "\r"-  let msg = take (l-8) $ unwords ["Processing file", show (cur + 1) ++ "/" ++ show total ++ ":", f] ++ "..."+progress :: Maybe Int -> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a+progress mw total cur act f = do+  let msg' = unwords ["Processing file", show (cur + 1) ++ "/" ++ show total ++ ":", f] ++ "..."+  msg <- liftIO $ case mw of+    Nothing -> putStrLn "" >> pure msg'+    Just w -> do+      putStr $ replicate w ' '+      putStr "\r"+      pure $ take (w-8) $ msg'   liftIO $ putStr msg   x <- act f   liftIO $ putStr " done\r"@@ -207,20 +212,22 @@       initConn conn       files <- concat <$> mapM getHieFilesIn dirs       nc <- newIORef =<< makeNc-      wsize <- maybe 80 width <$> size+      wsize <- fmap width <$> size       let progress' = if quiet opts then (\_ _ _ k -> k) else progress+      start <- offsetTime       runDbM nc $         zipWithM_ (\f n -> progress' wsize (length files) n (addRefsFrom conn) f) files [0..]+      end <- start       unless (quiet opts) $-        putStrLn "\nCompleted!"+        putStrLn $ "\nCompleted! (" <> showDuration end <> ")"     TypeRefs typ mn muid -> do       let occ = mkOccName tcClsName typ-      refs <- search conn False occ mn muid []+      refs <- findReferences conn False occ mn muid []       reportRefs refs     NameRefs nm mn muid -> do       let ns = if isCons nm then dataName else varName       let occ = mkOccName ns nm-      refs <- search conn False occ mn muid []+      refs <- findReferences conn False occ mn muid []       reportRefs refs     NameDef nm mn muid -> do       let ns = if isCons nm then dataName else varName@@ -277,7 +284,7 @@         putStrLn $ unwords ["Name", occNameString (nameOccName name),"at",show sp,"is used in:"]         case nameModule_maybe name of           Just mod -> do-            reportRefs =<< search conn False (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) []+            reportRefs =<< findReferences conn False (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) []           Nothing -> do             let refmap = generateReferencesMap (getAsts $ hie_asts hf)                 refs = map (toRef . fst) $ M.findWithDefault [] (Right name) refmap

@@ -13,6 +13,7 @@ import Name import Module import NameCache+import Fingerprint  import IfaceEnv (NameCacheUpdater(..)) import Data.IORef@@ -25,7 +26,6 @@  import Data.List.NonEmpty (NonEmpty(..)) -import Data.Time.Clock import Data.Int  import Database.SQLite.Simple@@ -54,7 +54,7 @@                           -- False when it was created from @.hie@ file   , modInfoSrcFile :: Maybe FilePath -- ^ The path to the haskell source file, from which the @.hie@ file was created   , modInfoIsReal :: Bool -- ^ Is this a real source file? I.e. does it come from user's project (as opposed to from project's dependency)?-  , modInfoTime :: UTCTime -- ^ The last modification time of the @.hie@ file from which this ModuleInfo was created+  , modInfoHash :: Fingerprint -- ^ The hash of the @.hie@ file from which this ModuleInfo was created   }  instance Show ModuleInfo where@@ -77,6 +77,11 @@   toField uid = SQLText $ T.pack $ unitIdString uid instance FromField UnitId where   fromField fld = stringToUnitId . T.unpack <$> fromField fld++instance ToField Fingerprint where+  toField hash = SQLText $ T.pack $ show hash+instance FromField Fingerprint where+  fromField fld = readHexFingerprint . T.unpack <$> fromField fld  toNsChar :: NameSpace -> Char toNsChar ns

@@ -74,7 +74,7 @@         HFunTy a b -> mapM_ next [a,b]         HQualTy a b -> mapM_ next [a,b]         HLitTy _ -> pure ()-        HCastTy a -> next a+        HCastTy a -> go d a         HCoercionTy -> pure ()  makeNc :: IO NameCache