{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module HieDb.Create where

import Prelude hiding (mod)

import Compat.HieTypes
import Compat.HieUtils

import GHC

import Control.Exception
import Control.Monad
import Control.Monad.IO.Class

import qualified Data.Array as A
import qualified Data.Map as M

import Data.Int
import Data.List ( isSuffixOf )
import Data.Maybe
import Data.String

import System.Directory
import System.FilePath

import Database.SQLite.Simple

import HieDb.Compat as Compat
import HieDb.Types
import HieDb.Utils

sCHEMA_VERSION :: Integer
sCHEMA_VERSION :: Integer
sCHEMA_VERSION = Integer
6

dB_VERSION :: Integer
dB_VERSION :: Integer
dB_VERSION = forall a. Read a => FilePath -> a
read (forall a. Show a => a -> FilePath
show Integer
sCHEMA_VERSION forall a. [a] -> [a] -> [a]
++ FilePath
"999" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Integer
hieVersion)

{-| @checkVersion f db@ checks the schema version associated with given @db@.
If that version is supported by hiedb, it runs the function @f@ with the @db@.
Otherwise it throws 'IncompatibleSchemaVersion' exception.
-}
checkVersion :: (HieDb -> IO a) -> HieDb -> IO a
checkVersion :: forall a. (HieDb -> IO a) -> HieDb -> IO a
checkVersion HieDb -> IO a
k db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) = do
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA busy_timeout = 500;"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA journal_mode = WAL;"
  [Only Integer
ver] <- forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"PRAGMA user_version"
  if Integer
ver forall a. Eq a => a -> a -> Bool
== Integer
0 then do
    Connection -> Query -> IO ()
execute_ Connection
conn forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath
"PRAGMA user_version = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Integer
dB_VERSION
    HieDb -> IO a
k HieDb
db
  else if Integer
ver forall a. Eq a => a -> a -> Bool
== Integer
dB_VERSION then do
    HieDb -> IO a
k HieDb
db
  else
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> HieDbException
IncompatibleSchemaVersion Integer
dB_VERSION Integer
ver

{-| Given path to @.hiedb@ file, constructs 'HieDb' and passes it to given function. -}
withHieDb :: FilePath -> (HieDb -> IO a) -> IO a
withHieDb :: forall a. FilePath -> (HieDb -> IO a) -> IO a
withHieDb FilePath
fp HieDb -> IO a
f = forall a. FilePath -> (Connection -> IO a) -> IO a
withConnection FilePath
fp (forall a. (HieDb -> IO a) -> HieDb -> IO a
checkVersion HieDb -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> HieDb
HieDb)

{-| Given GHC LibDir and path to @.hiedb@ file,
constructs DynFlags (required for printing info from @.hie@ files)
and 'HieDb' and passes them to given function.
-}
withHieDbAndFlags :: LibDir -> FilePath -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags :: forall a. LibDir -> FilePath -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags LibDir
libdir FilePath
fp DynFlags -> HieDb -> IO a
f = do
  DynFlags
dynFlags <- LibDir -> IO DynFlags
dynFlagsForPrinting LibDir
libdir
  forall a. FilePath -> (Connection -> IO a) -> IO a
withConnection FilePath
fp (forall a. (HieDb -> IO a) -> HieDb -> IO a
checkVersion (DynFlags -> HieDb -> IO a
f DynFlags
dynFlags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> HieDb
HieDb)

{-| Initialize database schema for given 'HieDb'.
-}
initConn :: HieDb -> IO ()
initConn :: HieDb -> IO ()
initConn (HieDb -> Connection
getConn -> Connection
conn) = do
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA busy_timeout = 500;"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA journal_mode = WAL;"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA foreign_keys = ON;"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA defer_foreign_keys = ON;"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS mods \
                \( hieFile TEXT NOT NULL PRIMARY KEY ON CONFLICT REPLACE \
                \, mod     TEXT NOT NULL \
                \, unit    TEXT NOT NULL \
                \, is_boot BOOL NOT NULL \
                \, hs_src  TEXT UNIQUE ON CONFLICT REPLACE \
                \, is_real BOOL NOT NULL \
                \, hash    TEXT NOT NULL UNIQUE ON CONFLICT REPLACE \
                \, CONSTRAINT modid UNIQUE (mod, unit, is_boot) ON CONFLICT REPLACE \
                \, CONSTRAINT real_has_src CHECK ( (NOT is_real) OR (hs_src IS NOT NULL) ) \
                \)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS mod_hash ON mods(hieFile,hash)"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS exports \
                \( hieFile TEXT NOT NULL \
                \, occ     TEXT NOT NULL \
                \, mod     TEXT NOT NULL \
                \, unit    TEXT NOT NULL \
                \, parent  TEXT \
                \, parentMod TEXT \
                \, parentUnit TEXT \
                \, is_datacon BOOL NOT NULL \
                \, FOREIGN KEY(hieFile) REFERENCES mods(hieFile) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED \
                \)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS exports_mod ON exports(hieFile)"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS refs \
                \( hieFile TEXT NOT NULL \
                \, occ     TEXT NOT NULL \
                \, mod     TEXT NOT NULL \
                \, unit    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 \
                \)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS refs_mod ON refs(hieFile)"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS decls \
                \( hieFile    TEXT NOT NULL \
                \, occ        TEXT NOT NULL \
                \, sl      INTEGER NOT NULL \
                \, sc      INTEGER NOT NULL \
                \, el      INTEGER NOT NULL \
                \, ec      INTEGER NOT NULL \
                \, is_root    BOOL NOT NULL \
                \, FOREIGN KEY(hieFile) REFERENCES mods(hieFile) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED \
                \)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS decls_mod ON decls(hieFile)"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS defs \
                \( hieFile    TEXT NOT NULL \
                \, occ        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 \
                \, PRIMARY KEY(hieFile,occ) \
                \)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS defs_mod ON defs(hieFile)"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS typenames \
                \( id      INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT \
                \, name       TEXT NOT NULL \
                \, mod        TEXT NOT NULL \
                \, unit       TEXT NOT NULL \
                \, CONSTRAINT uniqname UNIQUE (name, mod, unit) ON CONFLICT IGNORE \
                \)"

  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE TABLE IF NOT EXISTS typerefs \
                \( id   INTEGER NOT NULL \
                \, hieFile    TEXT NOT NULL \
                \, depth   INTEGER NOT NULL \
                \, sl      INTEGER NOT NULL \
                \, sc      INTEGER NOT NULL \
                \, el      INTEGER NOT NULL \
                \, ec      INTEGER NOT NULL \
                \, FOREIGN KEY(id) REFERENCES typenames(id) DEFERRABLE INITIALLY DEFERRED \
                \, FOREIGN KEY(hieFile) REFERENCES mods(hieFile) ON UPDATE CASCADE ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED \
                \)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS typeref_id ON typerefs(id)"
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS typerefs_mod ON typerefs(hieFile)"

{-| Add names of types from @.hie@ file to 'HieDb'.
Returns an Array mapping 'TypeIndex' to database ID assigned to the
corresponding record in DB.
-}
addArr :: HieDb -> A.Array TypeIndex HieTypeFlat -> IO (A.Array TypeIndex (Maybe Int64))
addArr :: HieDb
-> Array TypeIndex HieTypeFlat
-> IO (Array TypeIndex (Maybe Int64))
addArr (HieDb -> Connection
getConn -> Connection
conn) Array TypeIndex HieTypeFlat
arr = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Array TypeIndex HieTypeFlat
arr forall a b. (a -> b) -> a -> b
$ \case
    HTyVarTy Name
n -> Name -> IO (Maybe Int64)
addName Name
n
    HTyConApp IfaceTyCon
tc HieArgs TypeIndex
_ -> Name -> IO (Maybe Int64)
addName (IfaceTyCon -> Name
ifaceTyConName IfaceTyCon
tc)
    HieTypeFlat
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  where
    addName :: Name -> IO (Maybe Int64)
    addName :: Name -> IO (Maybe Int64)
addName Name
n = case Name -> Maybe Module
nameModule_maybe Name
n of
      Maybe Module
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Just Module
m -> do
        let occ :: OccName
occ = Name -> OccName
nameOccName Name
n
            mod :: ModuleName
mod = forall unit. GenModule unit -> ModuleName
moduleName Module
m
            uid :: Unit
uid = forall unit. GenModule unit -> unit
moduleUnit Module
m
        forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO typenames(name,mod,unit) VALUES (?,?,?)" (OccName
occ,ModuleName
mod,Unit
uid)
        forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Only a -> a
fromOnly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT id FROM typenames WHERE name = ? AND mod = ? AND unit = ?" (OccName
occ,ModuleName
mod,Unit
uid)

{-| Add references to types from given @.hie@ file to DB. -}
addTypeRefs
  :: HieDb
  -> FilePath -- ^ Path to @.hie@ file
  -> HieFile -- ^ Data loaded from the @.hie@ file
  -> A.Array TypeIndex (Maybe Int64) -- ^ Maps TypeIndex to database ID assigned to record in @typenames@ table
  -> IO ()
addTypeRefs :: HieDb
-> FilePath -> HieFile -> Array TypeIndex (Maybe Int64) -> IO ()
addTypeRefs HieDb
db FilePath
path HieFile
hf Array TypeIndex (Maybe Int64)
ixs = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieAST TypeIndex -> IO ()
addTypesFromAst Map HiePath (HieAST TypeIndex)
asts
  where
    arr :: A.Array TypeIndex HieTypeFlat
    arr :: Array TypeIndex HieTypeFlat
arr = HieFile -> Array TypeIndex HieTypeFlat
hie_types HieFile
hf
    asts :: M.Map HiePath (HieAST TypeIndex)
    asts :: Map HiePath (HieAST TypeIndex)
asts = forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs TypeIndex
hie_asts HieFile
hf
    addTypesFromAst :: HieAST TypeIndex -> IO ()
    addTypesFromAst :: HieAST TypeIndex -> IO ()
addTypesFromAst HieAST TypeIndex
ast = do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HieDb
-> FilePath
-> Array TypeIndex HieTypeFlat
-> Array TypeIndex (Maybe Int64)
-> RealSrcSpan
-> TypeIndex
-> IO ()
addTypeRef HieDb
db FilePath
path Array TypeIndex HieTypeFlat
arr Array TypeIndex (Maybe Int64)
ixs (forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST TypeIndex
ast))
        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\IdentifierDetails TypeIndex
x -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextInfo -> Bool
isOccurrence) (forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails TypeIndex
x)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails TypeIndex
x)
        forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems
        forall a b. (a -> b) -> a -> b
$ forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers
        forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' HieAST TypeIndex
ast
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieAST TypeIndex -> IO ()
addTypesFromAst forall a b. (a -> b) -> a -> b
$ forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
ast

{-| 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 :: forall (m :: * -> *).
(MonadIO m, NameCacheMonad m) =>
HieDb -> Maybe FilePath -> FilePath -> m Bool
addRefsFrom c :: HieDb
c@(HieDb -> Connection
getConn -> Connection
conn) Maybe FilePath
mSrcBaseDir FilePath
path = do
  Fingerprint
hash <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Fingerprint
getFileHash FilePath
path
  [HieModuleRow]
mods <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT * FROM mods WHERE hieFile = ? AND hash = ?" (FilePath
path, Fingerprint
hash)
  case [HieModuleRow]
mods of
    (HieModuleRow{}:[HieModuleRow]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    [] -> do
      forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
FilePath -> (HieFile -> m a) -> m a
withHieFile FilePath
path forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Fingerprint -> HieFile -> m ()
addRefsWithFile  Fingerprint
hash
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  where
      addRefsWithFile :: MonadIO m => Fingerprint -> HieFile -> m ()
      addRefsWithFile :: forall (m :: * -> *). MonadIO m => Fingerprint -> HieFile -> m ()
addRefsWithFile Fingerprint
hash HieFile
hieFile = do
        SourceFile
srcfile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
              forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> SourceFile
FakeFile forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing)
                (\FilePath
srcBaseDir ->  do
                    FilePath
srcFullPath <- FilePath -> IO FilePath
makeAbsolute (FilePath
srcBaseDir FilePath -> FilePath -> FilePath
</> HieFile -> FilePath
hie_hs_file HieFile
hieFile)
                    Bool
fileExists <- FilePath -> IO Bool
doesFileExist FilePath
srcFullPath
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
fileExists then FilePath -> SourceFile
RealFile FilePath
srcFullPath else (Maybe FilePath -> SourceFile
FakeFile forall a. Maybe a
Nothing)
                )
                Maybe FilePath
mSrcBaseDir
        forall (m :: * -> *).
MonadIO m =>
HieDb -> FilePath -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded HieDb
c FilePath
path SourceFile
srcfile Fingerprint
hash HieFile
hieFile

addRefsFromLoaded
  :: 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
  -> HieFile -- ^ Data loaded from the @.hie@ file
  -> m ()
addRefsFromLoaded :: forall (m :: * -> *).
MonadIO m =>
HieDb -> FilePath -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded
  db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) FilePath
path SourceFile
sourceFile Fingerprint
hash HieFile
hf =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Connection -> IO a -> IO a
withTransaction Connection
conn forall a b. (a -> b) -> a -> b
$ do
      Connection -> FilePath -> IO ()
deleteInternalTables Connection
conn FilePath
path
      forall (m :: * -> *).
MonadIO m =>
HieDb -> FilePath -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded_unsafe HieDb
db FilePath
path SourceFile
sourceFile Fingerprint
hash HieFile
hf

-- | Like 'addRefsFromLoaded' but without:
--   1) using a transaction
--   2) cleaning up previous versions of the file
--
--   Mostly useful to index a new database from scratch as fast as possible
addRefsFromLoaded_unsafe
  :: 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
  -> HieFile -- ^ Data loaded from the @.hie@ file
  -> m ()
addRefsFromLoaded_unsafe :: forall (m :: * -> *).
MonadIO m =>
HieDb -> FilePath -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded_unsafe
 db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) FilePath
path SourceFile
sourceFile Fingerprint
hash HieFile
hf = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do

  let isBoot :: Bool
isBoot = FilePath
"boot" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
path
      mod :: ModuleName
mod    = forall unit. GenModule unit -> ModuleName
moduleName Module
smod
      uid :: Unit
uid    = forall unit. GenModule unit -> unit
moduleUnit Module
smod
      smod :: Module
smod   = HieFile -> Module
hie_module HieFile
hf
      refmap :: RefMap TypeIndex
refmap = forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
generateReferencesMap forall a b. (a -> b) -> a -> b
$ forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs TypeIndex
hie_asts HieFile
hf
      (Maybe FilePath
srcFile, Bool
isReal) = case SourceFile
sourceFile of
        RealFile FilePath
f -> (forall a. a -> Maybe a
Just FilePath
f, Bool
True)
        FakeFile Maybe FilePath
mf -> (Maybe FilePath
mf, Bool
False)
      modrow :: HieModuleRow
modrow = FilePath -> ModuleInfo -> HieModuleRow
HieModuleRow FilePath
path (ModuleName
-> Unit
-> Bool
-> Maybe FilePath
-> Bool
-> Fingerprint
-> ModuleInfo
ModuleInfo ModuleName
mod Unit
uid Bool
isBoot Maybe FilePath
srcFile Bool
isReal Fingerprint
hash)

  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO mods VALUES (?,?,?,?,?,?,?)" HieModuleRow
modrow

  let ([RefRow]
rows,[DeclRow]
decls) = forall a.
FilePath
-> Module
-> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> ([RefRow], [DeclRow])
genRefsAndDecls FilePath
path Module
smod RefMap TypeIndex
refmap
  forall q. ToRow q => Connection -> Query -> [q] -> IO ()
executeMany Connection
conn Query
"INSERT INTO refs  VALUES (?,?,?,?,?,?,?,?)" [RefRow]
rows
  forall q. ToRow q => Connection -> Query -> [q] -> IO ()
executeMany Connection
conn Query
"INSERT INTO decls VALUES (?,?,?,?,?,?,?)" [DeclRow]
decls

  let defs :: [DefRow]
defs = forall a.
FilePath
-> Module
-> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> [DefRow]
genDefRow FilePath
path Module
smod RefMap TypeIndex
refmap
  forall q. ToRow q => Connection -> Query -> [q] -> IO ()
executeMany Connection
conn Query
"INSERT INTO defs VALUES (?,?,?,?,?,?)" [DefRow]
defs

  let exports :: [ExportRow]
exports = FilePath -> [AvailInfo] -> [ExportRow]
generateExports FilePath
path forall a b. (a -> b) -> a -> b
$ HieFile -> [AvailInfo]
hie_exports HieFile
hf
  forall q. ToRow q => Connection -> Query -> [q] -> IO ()
executeMany Connection
conn Query
"INSERT INTO exports VALUES (?,?,?,?,?,?,?,?)" [ExportRow]
exports

  Array TypeIndex (Maybe Int64)
ixs <- HieDb
-> Array TypeIndex HieTypeFlat
-> IO (Array TypeIndex (Maybe Int64))
addArr HieDb
db (HieFile -> Array TypeIndex HieTypeFlat
hie_types HieFile
hf)
  HieDb
-> FilePath -> HieFile -> Array TypeIndex (Maybe Int64) -> IO ()
addTypeRefs HieDb
db FilePath
path HieFile
hf Array TypeIndex (Maybe Int64)
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.
-}
addSrcFile
  :: HieDb
  -> FilePath -- ^ Path to @.hie@ file
  -> FilePath -- ^ Path to .hs file to be added to DB
  -> Bool -- ^ Is this a real source file? I.e. does it come from user's project (as opposed to from project's dependency)?
  -> IO ()
addSrcFile :: HieDb -> FilePath -> FilePath -> Bool -> IO ()
addSrcFile (HieDb -> Connection
getConn -> Connection
conn) FilePath
hie FilePath
srcFile Bool
isReal =
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"UPDATE mods SET hs_src = ? , is_real = ? WHERE hieFile = ?" (FilePath
srcFile, Bool
isReal, FilePath
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 :: HieDb -> IO ()
removeDependencySrcFiles (HieDb -> Connection
getConn -> Connection
conn) =
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"UPDATE mods SET hs_src = NULL WHERE NOT is_real" ()

{-| Delete all occurrences of given @.hie@ file from the database -}
deleteFileFromIndex :: HieDb -> FilePath -> IO ()
deleteFileFromIndex :: HieDb -> FilePath -> IO ()
deleteFileFromIndex (HieDb -> Connection
getConn -> Connection
conn) FilePath
path = forall a. Connection -> IO a -> IO a
withTransaction Connection
conn forall a b. (a -> b) -> a -> b
$ do
  Connection -> FilePath -> IO ()
deleteInternalTables Connection
conn FilePath
path

{-| Delete all entries associated with modules for which the 'modInfoSrcFile' doesn't exist
on the disk.
Doesn't delete it if there is no associated 'modInfoSrcFile'
-}
deleteMissingRealFiles :: HieDb -> IO ()
deleteMissingRealFiles :: HieDb -> IO ()
deleteMissingRealFiles (HieDb -> Connection
getConn -> Connection
conn) = forall a. Connection -> IO a -> IO a
withTransaction Connection
conn forall a b. (a -> b) -> a -> b
$ do
  [FilePath]
missing_file_keys <- forall row a.
FromRow row =>
Connection -> Query -> a -> (a -> row -> IO a) -> IO a
fold_ Connection
conn Query
"SELECT hieFile,hs_src FROM mods WHERE hs_src IS NOT NULL AND is_real" [] forall a b. (a -> b) -> a -> b
$
    \[FilePath]
acc (FilePath
path,FilePath
src) -> do
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
src
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
exists then [FilePath]
acc else FilePath
path forall a. a -> [a] -> [a]
: [FilePath]
acc
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
missing_file_keys forall a b. (a -> b) -> a -> b
$ \FilePath
path -> do
    Connection -> FilePath -> IO ()
deleteInternalTables Connection
conn FilePath
path

{-| Garbage collect typenames with no references - it is a good idea to call
this function after a sequence of database updates (inserts or deletes)
-}
garbageCollectTypeNames :: HieDb -> IO Int
garbageCollectTypeNames :: HieDb -> IO TypeIndex
garbageCollectTypeNames (HieDb -> Connection
getConn -> Connection
conn) = do
  Connection -> Query -> IO ()
execute_ Connection
conn Query
"DELETE FROM typenames WHERE NOT EXISTS ( SELECT 1 FROM typerefs WHERE typerefs.id = typenames.id LIMIT 1 )"
  Connection -> IO TypeIndex
changes Connection
conn

deleteInternalTables :: Connection -> FilePath -> IO ()
deleteInternalTables :: Connection -> FilePath -> IO ()
deleteInternalTables Connection
conn FilePath
path = do
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM refs  WHERE hieFile = ?" (forall a. a -> Only a
Only FilePath
path)
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM decls WHERE hieFile = ?" (forall a. a -> Only a
Only FilePath
path)
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM defs  WHERE hieFile = ?" (forall a. a -> Only a
Only FilePath
path)
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM typerefs WHERE hieFile = ?" (forall a. a -> Only a
Only FilePath
path)
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM mods  WHERE hieFile = ?" (forall a. a -> Only a
Only FilePath
path)
  forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM exports WHERE hieFile = ?" (forall a. a -> Only a
Only FilePath
path)