hiedb 0.5.0.1 → 0.6.0.0

raw patch · 10 files changed

+258/−174 lines, 10 filesdep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−3
• hiedb.cabal +15/−12
• src/HieDb/Compat.hs +9/−38
• src/HieDb/Create.hs +88/−20
• src/HieDb/Query.hs +2/−2
• src/HieDb/Run.hs +23/−7
• src/HieDb/Types.hs +19/−1
• src/HieDb/Utils.hs +67/−42
• test/Main.hs +12/−46
• test/data/Module1.hs +3/−3

@@ -1,16 +1,33 @@ # Revision history for hiedb +## 0.6.0.0 -- 2024-02-11++* Add index on column `unit` of table `mods`+* Add new table `imports` which indexes import statements+* Add new cli options that allow selectively skipping indexing of some things:+    `--skip-refs`              Skip refs table when indexing+    `--skip-decls`             Skip decls table when indexing+    `--skip-defs`              Skip defs table when indexing+    `--skip-exports`           Skip exports table when indexing+    `--skip-imports`           Skip imports table when indexing+    `--skip-types`             Skip types and typerefs table when indexing+    `--skip-typerefs`          Skip typerefs table when indexing+* Fix a bug where duplicate entries were inserted into `typerefs` table during indexing+* Fix a bug in `searchDef` query which was mistakenly not including ':' when searching by occurrence names+ ## 0.5.0.1 -- 2024-01-12 -- Fix incorrect Show Symbol instance in 0.5.0.0+* Fix incorrect Show Symbol instance in 0.5.0.0  ## 0.5.0.0 -- 2024-01-12 -- Handle duplicate record fields in GHC 9.8 instead of crashing+* Handle duplicate record fields in GHC 9.8 instead of crashing  ## 0.4.4.0 -- 2023-11-13+ * Add `--src-base-dir` option allowing for src file indexing in `mods`-* 9.8.1 support+* Support GHC 9.8.1+* Drop support for GHC 8.10 * Add `lookupHieFileFromHash` * Add `lookupPackage` * Add `removeDependencySrcFiles`

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                hiedb-version:             0.5.0.1+version:             0.6.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@@ -10,15 +10,17 @@ maintainer:          zubin.duggal@gmail.com copyright:           Zubin Duggal category:            Development-extra-source-files:-  CHANGELOG.md+extra-doc-files:   README.md+  CHANGELOG.md+extra-source-files:   test/data/*.hs   test/data/Sub/*.hs-tested-with:         GHC ==8.8.1 || ==8.8.2  || ==8.8.3  || ==8.8.4-                     || ==8.10.1 || ==8.10.2 || ==8.10.3 || ==8.10.4-                     || ==9.0.1-+tested-with:         GHC ==9.0.2+                      || ==9.2.8+                      || ==9.4.8+                      || ==9.6.4+                      || ==9.8.1  source-repository head   type: git@@ -28,13 +30,15 @@   default-language:    Haskell2010   build-depends:       base >= 4.12 && < 4.20   ghc-options:         -Wall-                       -Wincomplete-uni-patterns-                       -Wincomplete-record-updates                        -Wcompat                        -Widentities-                       -Wredundant-constraints+                       -Wincomplete-record-updates+                       -Wincomplete-uni-patterns                        -Wpartial-fields-                       -Wno-unrecognised-pragmas+                       -Wredundant-constraints+                       -Wunused-packages+                       -Wno-name-shadowing+ executable hiedb   import:              common-options   hs-source-dirs:      exe@@ -81,7 +85,6 @@   build-tool-depends: hiedb:hiedb   build-depends:      directory                     , filepath-                    , ghc >= 8.6                     , ghc-paths                     , hiedb                     , hspec

@@ -25,7 +25,11 @@     , mkVarOccFS     , Name     , nameSrcSpan+#if __GLASGOW_HASKELL__ >= 903+    , NameCacheUpdater+#else     , NameCacheUpdater(..)+#endif     , NameCache     , nsNames     , initNameCache@@ -88,7 +92,6 @@  import Compat.HieTypes -#if __GLASGOW_HASKELL__ >= 900 import GHC.Data.FastString as FS import GHC.Driver.Session import GHC.Iface.Env@@ -114,33 +117,15 @@ #else import GHC.Utils.Outputable (showSDoc, ppr, (<+>), hang, text) #endif-#else-import DynFlags-import FastString-import Fingerprint-import FieldLabel-import Module-import Name-import NameCache-import Outputable (showSDoc, ppr, (<+>), hang, text)-#if __GLASGOW_HASKELL__ < 903-import IfaceEnv (NameCacheUpdater(..))-#endif-import IfaceType-import UniqSupply-import SrcLoc-import SysTools-import qualified Avail-#endif -#if __GLASGOW_HASKELL__ >= 900+import qualified Algebra.Graph.AdjacencyMap           as Graph+import qualified Algebra.Graph.AdjacencyMap.Algorithm as Graph+ import GHC.Types.SrcLoc import Compat.HieUtils  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@@ -158,22 +143,7 @@                                         GT -> b : mergeSorted la bs     mergeSorted as [] = as     mergeSorted [] bs = bs-#else-import qualified FastString as FS -nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex-nodeInfo' = nodeInfo-type Unit = UnitId-unitString :: Unit -> String-unitString = unitIdString-stringToUnit :: String -> Unit-stringToUnit = stringToUnitId-moduleUnit :: Module -> Unit-moduleUnit = moduleUnitId-unhelpfulSpanFS :: FS.FastString -> FS.FastString-unhelpfulSpanFS = id-#endif- #if __GLASGOW_HASKELL__ < 902 type HiePath = FastString #endif@@ -238,8 +208,9 @@ -- This is horrible, we can improve it once -- https://gitlab.haskell.org/ghc/ghc/-/issues/24244 is addressed fieldNameSpace_maybe ns = fieldOcc_maybe (mkOccName ns "")-#endif+#else fieldNameSpace_maybe _ = Nothing+#endif  #if __GLASGOW_HASKELL__ < 907 fieldName :: FastString -> NameSpace

@@ -16,9 +16,11 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class+import Control.Monad.State.Strict (evalStateT)  import qualified Data.Array as A import qualified Data.Map as M+import qualified Data.IntMap.Strict as IMap  import Data.Int import Data.List ( isSuffixOf )@@ -35,7 +37,7 @@ import HieDb.Utils  sCHEMA_VERSION :: Integer-sCHEMA_VERSION = 7+sCHEMA_VERSION = 8  dB_VERSION :: Integer dB_VERSION = read (show sCHEMA_VERSION ++ "999" ++ show hieVersion)@@ -91,6 +93,7 @@                 \, CONSTRAINT real_has_src CHECK ( (NOT is_real) OR (hs_src IS NOT NULL) ) \                 \)"   execute_ conn "CREATE INDEX IF NOT EXISTS mod_hash ON mods(hieFile,hash)"+  execute_ conn "CREATE INDEX IF NOT EXISTS mod_unit ON mods(unit)"    execute_ conn "CREATE TABLE IF NOT EXISTS exports \                 \( hieFile TEXT NOT NULL \@@ -130,6 +133,19 @@                 \)"   execute_ conn "CREATE INDEX IF NOT EXISTS decls_mod ON decls(hieFile)" +  execute_ conn "CREATE TABLE IF NOT EXISTS imports \+                \( hieFile    TEXT NOT NULL \+                \, mod     TEXT NOT NULL \+                \, sl      INTEGER NOT NULL \+                \, sc      INTEGER NOT NULL \+                \, el      INTEGER NOT NULL \+                \, ec      INTEGER NOT NULL \+                \, FOREIGN KEY(hieFile) REFERENCES mods(hieFile) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED \+                \)"+  execute_ conn "CREATE INDEX IF NOT EXISTS imports_mod ON imports(mod)"+  execute_ conn "CREATE INDEX IF NOT EXISTS imports_hiefile ON imports(hieFile)"++   execute_ conn "CREATE TABLE IF NOT EXISTS defs \                 \( hieFile    TEXT NOT NULL \                 \, occ        TEXT NOT NULL \@@ -183,7 +199,7 @@             mod = moduleName m             uid = moduleUnit m         execute conn "INSERT INTO typenames(name,mod,unit) VALUES (?,?,?)" (occ,mod,uid)-        Just . fromOnly . head <$> query conn "SELECT id FROM typenames WHERE name = ? AND mod = ? AND unit = ?" (occ,mod,uid)+        fmap fromOnly . listToMaybe <$> query conn "SELECT id FROM typenames WHERE name = ? AND mod = ? AND unit = ?" (occ,mod,uid)  {-| Add references to types from given @.hie@ file to DB. -} addTypeRefs@@ -200,19 +216,47 @@     asts = getAsts $ hie_asts hf     addTypesFromAst :: HieAST TypeIndex -> IO ()     addTypesFromAst ast = do-      mapM_ (addTypeRef db path arr ixs (nodeSpan ast))-        $ mapMaybe (\x -> guard (any (not . isOccurrence) (identInfo x)) *> identType x)+      flip evalStateT IMap.empty+        $ mapM_ (addTypeRef db path arr ixs (nodeSpan ast))+        $ mapMaybe (\x -> guard (not (all isOccurrence (identInfo x))) *> identType x)         $ M.elems         $ nodeIdentifiers         $ nodeInfo' ast       mapM_ addTypesFromAst $ nodeChildren ast +-- | Options to skip indexing phases+data SkipOptions =+  SkipOptions+    { skipRefs :: Bool+    , skipDecls :: Bool+    , skipDefs :: Bool+    , skipExports :: Bool+    , skipImports :: Bool+    , skipTypes :: Bool+    -- ^ Note skip types will also skip type refs since it is dependent+    , skipTypeRefs :: Bool+    }+    deriving Show++defaultSkipOptions :: SkipOptions+defaultSkipOptions =+  SkipOptions+    { skipRefs = False+    , skipDecls = False+    , skipDefs = False+    , skipExports = False+    , skipImports = False+    , skipTypes = False+    -- ^ Note skip types will also skip type refs since it is dependent+    , skipTypeRefs = False+    }+ {-| Adds all references from given @.hie@ file to 'HieDb'. 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 -> Maybe FilePath -> FilePath -> m Bool-addRefsFrom c@(getConn -> conn) mSrcBaseDir path = do+addRefsFrom :: (MonadIO m, NameCacheMonad m) => HieDb -> Maybe FilePath -> SkipOptions -> FilePath ->  m Bool+addRefsFrom c@(getConn -> conn) mSrcBaseDir skipOptions path = do   hash <- liftIO $ getFileHash path   mods <- liftIO $ query conn "SELECT * FROM mods WHERE hieFile = ? AND hash = ?" (path, hash)   case mods of@@ -229,10 +273,10 @@                 (\srcBaseDir ->  do                     srcFullPath <- makeAbsolute (srcBaseDir </> hie_hs_file hieFile)                     fileExists <- doesFileExist srcFullPath-                    pure $ if fileExists then RealFile srcFullPath else (FakeFile Nothing)+                    pure $ if fileExists then RealFile srcFullPath else FakeFile Nothing                 )                 mSrcBaseDir-        addRefsFromLoaded c path srcfile hash hieFile+        addRefsFromLoadedInternal c path srcfile hash skipOptions hieFile  addRefsFromLoaded   :: MonadIO m@@ -244,11 +288,25 @@   -> Fingerprint -- ^ The hash of the @.hie@ file   -> HieFile -- ^ Data loaded from the @.hie@ file   -> m ()-addRefsFromLoaded-  db@(getConn -> conn) path sourceFile hash hf =+addRefsFromLoaded db path sourceFile hash hf =+    addRefsFromLoadedInternal db path sourceFile hash defaultSkipOptions hf++addRefsFromLoadedInternal+  :: MonadIO m+  => HieDb -- ^ HieDb into which we're adding the file+  -> FilePath -- ^ Path to @.hie@ file+  -> SourceFile -- ^ Path to .hs file from which @.hie@ file was created+                -- Also tells us if this is a real source file?+                -- i.e. does it come from user's project (as opposed to from project's dependency)?+  -> Fingerprint -- ^ The hash of the @.hie@ file+  -> SkipOptions -- ^ Skip indexing certain tables+  -> HieFile -- ^ Data loaded from the @.hie@ file+  -> m ()+addRefsFromLoadedInternal+  db@(getConn -> conn) path sourceFile hash skipOptions hf =     liftIO $ withTransaction conn $ do       deleteInternalTables conn path-      addRefsFromLoaded_unsafe db path sourceFile hash hf+      addRefsFromLoaded_unsafe db path sourceFile hash skipOptions hf  -- | Like 'addRefsFromLoaded' but without: --   1) using a transaction@@ -263,10 +321,11 @@                 -- Also tells us if this is a real source file?                 -- i.e. does it come from user's project (as opposed to from project's dependency)?   -> Fingerprint -- ^ The hash of the @.hie@ file+  -> SkipOptions -- ^ Skip indexing certain tables   -> HieFile -- ^ Data loaded from the @.hie@ file   -> m () addRefsFromLoaded_unsafe- db@(getConn -> conn) path sourceFile hash hf = liftIO $ do+ db@(getConn -> conn) path sourceFile hash skipOptions hf = liftIO $ do    let isBoot = "boot" `isSuffixOf` path       mod    = moduleName smod@@ -280,19 +339,28 @@    execute conn "INSERT INTO mods VALUES (?,?,?,?,?,?,?)" modrow -  let (rows,decls) = genRefsAndDecls path smod refmap-  executeMany conn "INSERT INTO refs  VALUES (?,?,?,?,?,?,?,?)" rows-  executeMany conn "INSERT INTO decls VALUES (?,?,?,?,?,?,?)" decls+  let AstInfo rows decls imports = genAstInfo path smod refmap +  unless (skipRefs skipOptions) $+    executeMany conn "INSERT INTO refs  VALUES (?,?,?,?,?,?,?,?)" rows+  unless (skipDecls skipOptions) $+    executeMany conn "INSERT INTO decls VALUES (?,?,?,?,?,?,?)" decls+  unless (skipImports skipOptions) $+    executeMany conn "INSERT INTO imports VALUES (?,?,?,?,?,?)" imports+   let defs = genDefRow path smod refmap-  forM defs $ \def -> do-    execute conn "INSERT INTO defs VALUES (?,?,?,?,?,?)" def+  unless (skipDefs skipOptions) $+    forM_ defs $ \def ->+      execute conn "INSERT INTO defs VALUES (?,?,?,?,?,?)" def    let exports = generateExports path $ hie_exports hf-  executeMany conn "INSERT INTO exports VALUES (?,?,?,?,?,?,?,?)" exports+  unless (skipExports skipOptions) $+    executeMany conn "INSERT INTO exports VALUES (?,?,?,?,?,?,?,?)" exports -  ixs <- addArr db (hie_types hf)-  addTypeRefs db path hf ixs+  unless (skipTypes skipOptions) $ do+    ixs <- addArr db (hie_types hf)+    unless (skipTypeRefs skipOptions) $ do+      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.

@@ -40,7 +40,7 @@ getAllIndexedMods (getConn -> conn) = query_ conn "SELECT * FROM mods"  {-| List all module exports -}-getAllIndexedExports :: HieDb -> IO [(ExportRow)]+getAllIndexedExports :: HieDb -> IO [ExportRow] getAllIndexedExports (getConn -> conn) = query_ conn "SELECT * FROM exports"  {-| List all exports of the given module -}@@ -152,7 +152,7 @@   = 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++"%")+                         \LIMIT 200" (Only $ '_':':':cs++"%")  {-| @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

@@ -5,6 +5,7 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ApplicativeDo #-} module HieDb.Run where  import Prelude hiding (mod)@@ -80,6 +81,7 @@   , reindex :: Bool   , keepMissing :: Bool   , srcBaseDir :: Maybe FilePath+  , skipIndexingOptions :: SkipOptions   }  data Command@@ -127,10 +129,28 @@   <*> 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"))+  <*> skipFlags   where     colourFlag = flag' True (long "colour" <> long "color" <> help "Force coloured output")             <|> flag' False (long "no-colour" <> long "no-color" <> help "Force uncoloured ouput")             <|> pure colr+    skipFlags = do+        refs <- switch (long "skip-refs" <> help "Skip refs table when indexing")+        decls <- switch (long "skip-decls" <> help "Skip decls table when indexing")+        defs <- switch (long "skip-defs" <> help "Skip defs table when indexing")+        exports <- switch (long "skip-exports" <> help "Skip exports table when indexing")+        imports <- switch (long "skip-imports" <> help "Skip imports table when indexing")+        types <- switch (long "skip-types" <> help "Skip types and typerefs table when indexing")+        typeRefs <- switch (long "skip-typerefs" <> help "Skip typerefs table when indexing")+        pure $ SkipOptions+          { skipRefs = refs+          , skipDecls = decls+          , skipDefs = defs+          , skipExports = exports+          , skipImports = imports+          , skipTypes = types+          , skipTypeRefs = typeRefs+          }  cmdParser :: Parser Command cmdParser@@ -222,7 +242,7 @@     Just w -> do       hPutStr hndl $ replicate w ' '       hPutStr hndl "\r"-      pure $ take (w-8) $ msg'+      pure $ take (w-8) msg'   liftIO $ hPutStr hndl msg   x <- act f   if x@@ -238,7 +258,7 @@    istart <- offsetTime   (length -> done, length -> skipped)<- runDbM nc $ partition id <$>-    zipWithM (\f n -> progress' h (length files) n (addRefsFrom conn (srcBaseDir opts)) f) files [0..]+    zipWithM (\f n -> progress' h (length files) n (addRefsFrom conn (srcBaseDir opts) (skipIndexingOptions opts)) f) files [0..]   indexTime <- istart    start <- offsetTime@@ -372,11 +392,7 @@         reportAmbiguousErr opts (Left $ NoNameAtPoint target sp)       forM_ names $ \name -> do         case nameSrcSpan name of-#if __GLASGOW_HASKELL__ >= 900           RealSrcSpan dsp _ -> do-#else-          RealSrcSpan dsp -> do-#endif             unless (quiet opts) $               hPutStrLn stderr $ unwords ["Name", ppName opts (nameOccName name),"at",ppSpan opts sp,"is defined at:"]             contents <- case nameModule_maybe name of@@ -510,7 +526,7 @@                   beforeLines = takeEnd n beforeLines'                   afterLines  = take    n afterLines' -                  (beforeChars,during') = BS.splitAt (sc-1) $ BS.concat $ intersperse "\n" $ duringLines+                  (beforeChars,during') = BS.splitAt (sc-1) $ BS.concat $ intersperse "\n" duringLines                   (during,afterChars) = BS.splitAt (BS.length during' - (BS.length (last duringLines) - ec) - 1) during'                    before = BS.unlines beforeLines <> beforeChars

@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE BlockArguments #-}@@ -178,6 +177,25 @@ instance FromRow DeclRow where   fromRow = DeclRow <$> field <*> field <*> field <*> field                     <*> field <*> field <*> field++data ImportRow +  = ImportRow +    { importSrc :: FilePath+    , importModuleName :: ModuleName+    , importSLine :: Int +    , importSCol :: Int +    , importELine :: Int +    , importECol :: Int +    }++instance FromRow ImportRow where +  fromRow = +    ImportRow +      <$> field <*> field <*> field <*> field +      <*> field <*> field++instance ToRow ImportRow where +  toRow (ImportRow a b c d e f) = toRow ((a,b,c,d):.(e,f))  data TypeName = TypeName   { typeName :: OccName

@@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} module HieDb.Utils where@@ -19,13 +18,11 @@ import qualified Compat.HieTypes as HieTypes import Compat.HieUtils import qualified Data.Map as M-+import qualified Data.Set as S  import System.Directory import System.FilePath -import Control.Arrow ( (&&&) )-import Data.Bifunctor ( bimap ) import Data.List (find) import Control.Monad.IO.Class import qualified Data.Array as A@@ -39,40 +36,59 @@ import HieDb.Types import HieDb.Compat import Database.SQLite.Simple-import Control.Concurrent+import Control.Monad.State.Strict (StateT, get, put)+import qualified Data.IntSet as ISet+import qualified Data.IntMap.Strict as IMap+import Data.IntMap.Strict (IntMap)+import Data.IntSet (IntSet)+import Control.Monad (guard, unless) -addTypeRef :: HieDb -> FilePath -> A.Array TypeIndex HieTypeFlat -> A.Array TypeIndex (Maybe Int64) -> RealSrcSpan -> TypeIndex -> IO ()+#if __GLASGOW_HASKELL__ >= 903+import Control.Concurrent.MVar (readMVar)+#endif++-- Each AST Node can have a lot of repetitive type information,+-- esp. when deriving is involved.+-- This StateT state keeps track of which types in AST we already indexed+-- to avoid having repeated (Depth, Type) inserted under the same RealSrcSpan.+--+-- This `IntMap IntSet` is morally `Map Depth (Set TypeIndex)` mapping+-- the depth (of a type within tree structure of types - ends up as typerefs.depth)+-- to a list of type IDs (identifiers of types assigned as id within typenames table)+-- that we already indexed.+type TypeIndexing a = StateT (IntMap IntSet) IO a++addTypeRef :: HieDb -> FilePath -> A.Array TypeIndex HieTypeFlat -> A.Array TypeIndex (Maybe Int64) -> RealSrcSpan -> TypeIndex -> TypeIndexing () addTypeRef (getConn -> conn) hf arr ixs sp = go 0   where     sl = srcSpanStartLine sp     sc = srcSpanStartCol sp     el = srcSpanEndLine sp     ec = srcSpanEndCol sp-    go :: TypeIndex -> Int -> IO ()-    go d i = do+    go :: Int -> TypeIndex -> TypeIndexing ()+    go depth i = do       case ixs A.! i of         Nothing -> pure ()         Just occ -> do-          let ref = TypeRef occ hf d sl sc el ec-          execute conn "INSERT INTO typerefs VALUES (?,?,?,?,?,?,?)" ref-      let next = go (d+1)+          let ref = TypeRef occ hf depth sl sc el ec+          indexed <- get+          let isTypeIndexed = ISet.member (fromIntegral occ) (IMap.findWithDefault ISet.empty depth indexed)+          unless isTypeIndexed $ do+            liftIO $ execute conn "INSERT INTO typerefs VALUES (?,?,?,?,?,?,?)" ref+            put $ IMap.alter (\case+                  Nothing -> Just $ ISet.singleton (fromIntegral occ)+                  Just s -> Just $ ISet.insert (fromIntegral occ) s+                ) depth indexed+      let next = go (depth + 1)       case arr A.! i of         HTyVarTy _ -> pure ()-#if __GLASGOW_HASKELL__ >= 808         HAppTy x (HieArgs xs) -> mapM_ next (x:map snd xs)-#else-        HAppTy x y -> mapM_ next [x,y]-#endif         HTyConApp _ (HieArgs xs) -> mapM_ (next . snd) xs         HForAllTy ((_ , a),_) b -> mapM_ next [a,b]-#if __GLASGOW_HASKELL__ >= 900         HFunTy a b c -> mapM_ next [a,b,c]-#else-        HFunTy a b -> mapM_ next [a,b]-#endif         HQualTy a b -> mapM_ next [a,b]         HLitTy _ -> pure ()-        HCastTy a -> go d a+        HCastTy a -> go depth a         HCoercionTy -> pure ()  makeNc :: IO NameCache@@ -122,11 +138,7 @@ #endif   return $ case lookupOrigNameCache nsns mdl occ of     Just name -> case nameSrcSpan name of-#if __GLASGOW_HASKELL__ >= 900       RealSrcSpan sp _ -> Right (sp, mdl)-#else-      RealSrcSpan sp -> Right (sp, mdl)-#endif       UnhelpfulSpan msg -> Left $ NameUnhelpfulSpan name (unpackFS $ unhelpfulSpanFS msg)     Nothing -> Left $ NameNotFound occ (Just $ moduleName mdl) (Just $ moduleUnit mdl) @@ -143,18 +155,10 @@  dynFlagsForPrinting :: LibDir -> IO DynFlags dynFlagsForPrinting (LibDir libdir) = do-  systemSettings <- initSysTools-#if __GLASGOW_HASKELL__ >= 808-                    libdir-#else-                    (Just libdir)-#endif-#if __GLASGOW_HASKELL__ >= 905+  systemSettings <- initSysTools libdir   return $ defaultDynFlags systemSettings-#elif __GLASGOW_HASKELL__ >= 810-  return $ defaultDynFlags systemSettings $ LlvmConfig [] []-#else-  return $ defaultDynFlags systemSettings ([], [])+#if __GLASGOW_HASKELL__ < 905+    (LlvmConfig [] []) #endif  isCons :: String -> Bool@@ -162,13 +166,28 @@ isCons (x:_) | isUpper x = True isCons _ = False -genRefsAndDecls :: FilePath -> Module -> M.Map Identifier [(Span, IdentifierDetails a)] -> ([RefRow],[DeclRow])-genRefsAndDecls path smdl refmap = genRows $ flat $ M.toList refmap+data AstInfo =+  AstInfo+    { astInfoRefs :: [RefRow]+    , astInfoDecls :: [DeclRow]+    , astInfoImports :: [ImportRow]+    }++instance Semigroup AstInfo where+  AstInfo r1 d1 i1 <> AstInfo r2 d2 i2 = AstInfo (r1 <> r2) (d1 <> d2) (i1 <> i2)++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   where     flat = concatMap (\(a,xs) -> map (a,) xs)     genRows = foldMap go-    go = bimap maybeToList maybeToList . (goRef &&& goDec)+    go = 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@@ -180,6 +199,16 @@             ec = srcSpanEndCol sp     goRef _ = Nothing +    goImport (Left modName, (sp, IdentifierDetails _ contextInfos)) = do+          _ <- guard $ not $ S.disjoint contextInfos $ S.fromList [IEThing Import, IEThing ImportAs, IEThing ImportHiding]+          let+            sl = srcSpanStartLine sp+            sc = srcSpanStartCol sp+            el = srcSpanEndLine sp+            ec = srcSpanEndCol sp+          Just $ ImportRow path modName sl sc el ec+    goImport _ = Nothing+     goDec (Right name,(_,dets))       | Just mod <- nameModule_maybe name       , mod == smdl@@ -211,11 +240,7 @@   where     genRows = mapMaybe go     getSpan name dets-#if __GLASGOW_HASKELL__ >= 900       | RealSrcSpan sp _ <- nameSrcSpan name = Just sp-#else-      | RealSrcSpan sp <- nameSrcSpan name = Just sp-#endif       | otherwise = do           (sp, _dets) <- find defSpan dets           pure sp

@@ -2,7 +2,7 @@ module Main where  import GHC.Paths (libdir, ghc)-import HieDb (HieDb, HieModuleRow (..), LibDir (..), ModuleInfo (..), withHieDb, withHieFile, addRefsFromLoaded, deleteMissingRealFiles)+import HieDb (HieDb, HieModuleRow (..), LibDir (..), ModuleInfo (..), withHieDb, withHieFile, addRefsFromLoaded, deleteMissingRealFiles, defaultSkipOptions) import HieDb.Query (getAllIndexedMods, lookupHieFile, resolveUnitId, lookupHieFileFromSource) import HieDb.Run (Command (..), Options (..), runCommand) import HieDb.Types (HieDbErr (..), SourceFile(..), runDbM)@@ -88,6 +88,7 @@             -- Index a new real file, and delete it             let contents = unlines                   [ "module Test123 where"+                  , "import Prelude"                   , "foobarbaz :: Int"                   , "foobarbaz = 1"                   ]@@ -124,7 +125,6 @@             afterMods <- getAllIndexedMods conn             originalMods `shouldBe` afterMods - cliSpec :: Spec cliSpec =   -- TODO commands not covered: init, type-refs, ref-graph, dump, reachable, unreachable, html@@ -143,7 +143,7 @@               ]         (exitCode, actualStdin, _actualStdErr) <- runHieDbCli ["ls"]         exitCode `shouldBe` ExitSuccess-        (sort $ lines actualStdin) `shouldBe` (sort expectedOutput)+        sort (lines actualStdin) `shouldBe` sort expectedOutput      describe "name-refs" $       it "lists all references of given function" $ do@@ -167,8 +167,7 @@       it "Prints types of symbol under cursor" $         runHieDbCli ["point-types", "Module1", "10", "10" ]           `succeedsWithStdin` unlines-            [ "Int -> Bool" {- types of `even` function under cursor -}-            , "forall a. Integral a => a -> Bool"+            [ "Bool -> Bool" {- type of `not` function under cursor -}             ]       it "Fails for symbols that don't have type associated" $ do         (exitCode, actualStdout, actualStderr) <- runHieDbCli ["point-types", "Module1", "8", "21"]@@ -201,56 +200,22 @@             [ "Span: test/data/Sub/Module2.hs:11:7-23"             , "Constructors: {(ConDeclH98, ConDecl)}"             , "Identifiers:"-            , "Symbol:c::Data1Constructor1:Sub.Module2:main"+            , "Symbol:c:Data1Constructor1:Sub.Module2:main"             , "Data1Constructor1 defined at test/data/Sub/Module2.hs:11:7-23"-#if __GLASGOW_HASKELL__ >= 900             , "    Details:  Nothing {declaration of constructor bound at: test/data/Sub/Module2.hs:11:7-23}"-#else-            , "    IdentifierDetails Nothing {Decl ConDec (Just SrcSpanOneLine \"test/data/Sub/Module2.hs\" 11 7 24)}"-#endif             , "Types:\n"             ]       it "correctly prints type signatures" $         runHieDbCli ["point-info", "Module1", "10", "10"]           `succeedsWithStdin` unlines-#if __GLASGOW_HASKELL__ >= 904-            [ "Span: test/data/Module1.hs:10:8-11"-            , "Constructors: {(HsVar, HsExpr), (XExpr, HsExpr)}"-            , "Identifiers:"-            , "$dIntegral defined at <no location info>"-            , "    Details:  Just Integral Int {usage of evidence variable}"-            , "Symbol:v::even:GHC.Real:base"-            , "even defined at <no location info>"-            , "    Details:  Just forall a. Integral a => a -> Bool {usage}"-#elif __GLASGOW_HASKELL__ >= 902-            [ "Span: test/data/Module1.hs:10:8-11"-            , "Constructors: {(XExpr, HsExpr), (HsVar, HsExpr)}"-            , "Identifiers:"-            , "Symbol:v::even:GHC.Real:base"-            , "even defined at <no location info>"-            , "    Details:  Just forall a. Integral a => a -> Bool {usage}"-            , "$dIntegral defined at <no location info>"-            , "    Details:  Just Integral Int {usage of evidence variable}"-#elif __GLASGOW_HASKELL__ >= 900-            [ "Span: test/data/Module1.hs:10:8-11"-            , "Constructors: {(HsVar, HsExpr), (XExpr, HsExpr)}"-            , "Identifiers:"-            , "Symbol:v::even:GHC.Real:base"-            , "even defined at <no location info>"-            , "    Details:  Just forall a. Integral a => a -> Bool {usage}"-            , "$dIntegral defined at <no location info>"-            , "    Details:  Just Integral Int {usage of evidence variable}"-#else-            [ "Span: test/data/Module1.hs:10:8-11"-            , "Constructors: {(HsVar, HsExpr), (HsWrap, HsExpr)}"+            [ "Span: test/data/Module1.hs:10:8-10"+            , "Constructors: {(HsVar, HsExpr)}"             , "Identifiers:"-            , "Symbol:v::even:GHC.Real:base"-            , "even defined at <no location info>"-            , "    IdentifierDetails Just forall a. Integral a => a -> Bool {Use}"-#endif+            , "Symbol:v:not:GHC.Classes:ghc-prim"+            , "not defined at <no location info>"+            , "    Details:  Just Bool -> Bool {usage}"             , "Types:"-            , "Int -> Bool"-            , "forall a. Integral a => a -> Bool"+            , "Bool -> Bool"             , ""             ] @@ -388,4 +353,5 @@   , reindex = False   , keepMissing = False   , srcBaseDir = Nothing+  , skipIndexingOptions = defaultSkipOptions   }

@@ -5,9 +5,9 @@  import Sub.Module2 (showInt) -function1 :: Int -> String-function1 i =-    if even i then "It's even" else "It's odd"+function1 :: Bool -> String+function1 b =+    if not b then "It's false" else "It's true"  function2 :: Int -> IO () function2 i = putStrLn $ showInt i