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

import Prelude hiding (mod)

import GHC
import Compat.HieTypes
import Compat.HieUtils
import IfaceType
import Name

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

import Database.SQLite.Simple
import Data.List ( isSuffixOf )
import Data.String
import Data.Int
import GHC.Fingerprint

import HieDb.Types
import HieDb.Utils
import qualified Data.Array as A
import qualified Data.Map as M
import Data.Maybe

sCHEMA_VERSION :: Integer
sCHEMA_VERSION :: Integer
sCHEMA_VERSION = Integer
5

dB_VERSION :: Integer
dB_VERSION :: Integer
dB_VERSION = String -> Integer
forall a. Read a => String -> a
read (Integer -> String
forall a. Show a => a -> String
show Integer
sCHEMA_VERSION String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"999" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
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 :: (HieDb -> IO a) -> HieDb -> IO a
checkVersion HieDb -> IO a
k db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) = do
  [Only Integer
ver] <- Connection -> Query -> IO [Only Integer]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"PRAGMA user_version"
  if Integer
ver Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then do
    Connection -> Query -> IO ()
execute_ Connection
conn (Query -> IO ()) -> Query -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ String
"PRAGMA user_version = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
dB_VERSION
    HieDb -> IO a
k HieDb
db
  else if Integer
ver Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
dB_VERSION then do
    HieDb -> IO a
k HieDb
db
  else
    HieDbException -> IO a
forall e a. Exception e => e -> IO a
throwIO (HieDbException -> IO a) -> HieDbException -> IO a
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 :: String -> (HieDb -> IO a) -> IO a
withHieDb String
fp HieDb -> IO a
f = String -> (Connection -> IO a) -> IO a
forall a. String -> (Connection -> IO a) -> IO a
withConnection String
fp ((HieDb -> IO a) -> HieDb -> IO a
forall a. (HieDb -> IO a) -> HieDb -> IO a
checkVersion HieDb -> IO a
f (HieDb -> IO a) -> (Connection -> HieDb) -> Connection -> IO a
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 :: LibDir -> String -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags LibDir
libdir String
fp DynFlags -> HieDb -> IO a
f = do
  DynFlags
dynFlags <- LibDir -> IO DynFlags
dynFlagsForPrinting LibDir
libdir
  String -> (Connection -> IO a) -> IO a
forall a. String -> (Connection -> IO a) -> IO a
withConnection String
fp ((HieDb -> IO a) -> HieDb -> IO a
forall a. (HieDb -> IO a) -> HieDb -> IO a
checkVersion (DynFlags -> HieDb -> IO a
f DynFlags
dynFlags) (HieDb -> IO a) -> (Connection -> HieDb) -> Connection -> IO a
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 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 \
                \)"

  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 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 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 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 \
                \)"

{-| 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
  Array TypeIndex HieTypeFlat
-> (HieTypeFlat -> IO (Maybe Int64))
-> IO (Array TypeIndex (Maybe Int64))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Array TypeIndex HieTypeFlat
arr ((HieTypeFlat -> IO (Maybe Int64))
 -> IO (Array TypeIndex (Maybe Int64)))
-> (HieTypeFlat -> IO (Maybe Int64))
-> IO (Array TypeIndex (Maybe Int64))
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
_ -> Maybe Int64 -> IO (Maybe Int64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int64
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 -> Maybe Int64 -> IO (Maybe Int64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int64
forall a. Maybe a
Nothing
      Just Module
m -> do
        let occ :: OccName
occ = Name -> OccName
nameOccName Name
n
            mod :: ModuleName
mod = Module -> ModuleName
moduleName Module
m
            uid :: UnitId
uid = Module -> UnitId
moduleUnitId Module
m
        Connection -> Query -> (OccName, ModuleName, UnitId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO typenames(name,mod,unit) VALUES (?,?,?)" (OccName
occ,ModuleName
mod,UnitId
uid)
        Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64)
-> ([Only Int64] -> Int64) -> [Only Int64] -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Only Int64 -> Int64
forall a. Only a -> a
fromOnly (Only Int64 -> Int64)
-> ([Only Int64] -> Only Int64) -> [Only Int64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int64] -> Only Int64
forall a. [a] -> a
head ([Only Int64] -> Maybe Int64)
-> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (OccName, ModuleName, UnitId) -> IO [Only Int64]
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,UnitId
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
-> String -> HieFile -> Array TypeIndex (Maybe Int64) -> IO ()
addTypeRefs HieDb
db String
path HieFile
hf Array TypeIndex (Maybe Int64)
ixs = (HieAST TypeIndex -> IO ())
-> Map FastString (HieAST TypeIndex) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieAST TypeIndex -> IO ()
addTypesFromAst Map FastString (HieAST TypeIndex)
asts
  where
    arr :: Array TypeIndex HieTypeFlat
arr = HieFile -> Array TypeIndex HieTypeFlat
hie_types HieFile
hf
    asts :: Map FastString (HieAST TypeIndex)
asts = HieASTs TypeIndex -> Map FastString (HieAST TypeIndex)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs TypeIndex -> Map FastString (HieAST TypeIndex))
-> HieASTs TypeIndex -> Map FastString (HieAST TypeIndex)
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
      (TypeIndex -> IO ()) -> [TypeIndex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HieDb
-> String
-> Array TypeIndex HieTypeFlat
-> Array TypeIndex (Maybe Int64)
-> RealSrcSpan
-> TypeIndex
-> IO ()
addTypeRef HieDb
db String
path Array TypeIndex HieTypeFlat
arr Array TypeIndex (Maybe Int64)
ixs (HieAST TypeIndex -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST TypeIndex
ast))
        ([TypeIndex] -> IO ()) -> [TypeIndex] -> IO ()
forall a b. (a -> b) -> a -> b
$ (IdentifierDetails TypeIndex -> Maybe TypeIndex)
-> [IdentifierDetails TypeIndex] -> [TypeIndex]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\IdentifierDetails TypeIndex
x -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (ContextInfo -> Bool) -> ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextInfo -> Bool
isOccurrence) (IdentifierDetails TypeIndex -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails TypeIndex
x)) Maybe () -> Maybe TypeIndex -> Maybe TypeIndex
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IdentifierDetails TypeIndex -> Maybe TypeIndex
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails TypeIndex
x)
        ([IdentifierDetails TypeIndex] -> [TypeIndex])
-> [IdentifierDetails TypeIndex] -> [TypeIndex]
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails TypeIndex)
-> [IdentifierDetails TypeIndex]
forall k a. Map k a -> [a]
M.elems
        (Map Identifier (IdentifierDetails TypeIndex)
 -> [IdentifierDetails TypeIndex])
-> Map Identifier (IdentifierDetails TypeIndex)
-> [IdentifierDetails TypeIndex]
forall a b. (a -> b) -> a -> b
$ NodeInfo TypeIndex -> Map Identifier (IdentifierDetails TypeIndex)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers
        (NodeInfo TypeIndex
 -> Map Identifier (IdentifierDetails TypeIndex))
-> NodeInfo TypeIndex
-> Map Identifier (IdentifierDetails TypeIndex)
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> NodeInfo TypeIndex
forall a. HieAST a -> NodeInfo a
nodeInfo HieAST TypeIndex
ast
      (HieAST TypeIndex -> IO ()) -> [HieAST TypeIndex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieAST TypeIndex -> IO ()
addTypesFromAst ([HieAST TypeIndex] -> IO ()) -> [HieAST TypeIndex] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> [HieAST TypeIndex]
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.
-}
addRefsFrom :: (MonadIO m, NameCacheMonad m) => HieDb -> FilePath -> m ()
addRefsFrom :: HieDb -> String -> m ()
addRefsFrom c :: HieDb
c@(HieDb -> Connection
getConn -> Connection
conn) String
path = do
  Fingerprint
hash <- IO Fingerprint -> m Fingerprint
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Fingerprint -> m Fingerprint)
-> IO Fingerprint -> m Fingerprint
forall a b. (a -> b) -> a -> b
$ String -> IO Fingerprint
getFileHash String
path
  [HieModuleRow]
mods <- IO [HieModuleRow] -> m [HieModuleRow]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HieModuleRow] -> m [HieModuleRow])
-> IO [HieModuleRow] -> m [HieModuleRow]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (String, Fingerprint) -> IO [HieModuleRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT * FROM mods WHERE hieFile = ? AND hash = ?" (String
path, Fingerprint
hash)
  case [HieModuleRow]
mods of
    (HieModuleRow{}:[HieModuleRow]
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [] -> String -> (HieFile -> m ()) -> m ()
forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
String -> (HieFile -> m a) -> m a
withHieFile String
path ((HieFile -> m ()) -> m ()) -> (HieFile -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> HieDb
-> String -> Maybe String -> Bool -> Fingerprint -> HieFile -> m ()
forall (m :: * -> *).
MonadIO m =>
HieDb
-> String -> Maybe String -> Bool -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded HieDb
c String
path Maybe String
forall a. Maybe a
Nothing Bool
False Fingerprint
hash HieFile
hf

addRefsFromLoaded
  :: MonadIO m
  => HieDb -- ^ HieDb into which we're adding the file
  -> 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)?
  -> Fingerprint -- ^ The hash of the @.hie@ file
  -> HieFile -- ^ Data loaded from the @.hie@ file
  -> m ()
addRefsFromLoaded :: HieDb
-> String -> Maybe String -> Bool -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) String
path Maybe String
srcFile Bool
isReal Fingerprint
hash HieFile
hf = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO () -> IO ()
forall a. Connection -> IO a -> IO a
withTransaction Connection
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM refs  WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM decls WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM defs  WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM typerefs WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)

  let isBoot :: Bool
isBoot = String
"boot" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
path
      mod :: ModuleName
mod    = Module -> ModuleName
moduleName Module
smod
      uid :: UnitId
uid    = Module -> UnitId
moduleUnitId Module
smod
      smod :: Module
smod   = HieFile -> Module
hie_module HieFile
hf
      refmap :: Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)]
refmap = Map FastString (HieAST TypeIndex)
-> Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a) -> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
generateReferencesMap (Map FastString (HieAST TypeIndex)
 -> Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)])
-> Map FastString (HieAST TypeIndex)
-> Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)]
forall a b. (a -> b) -> a -> b
$ HieASTs TypeIndex -> Map FastString (HieAST TypeIndex)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs TypeIndex -> Map FastString (HieAST TypeIndex))
-> HieASTs TypeIndex -> Map FastString (HieAST TypeIndex)
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs TypeIndex
hie_asts HieFile
hf
      modrow :: HieModuleRow
modrow = String -> ModuleInfo -> HieModuleRow
HieModuleRow String
path (ModuleName
-> UnitId
-> Bool
-> Maybe String
-> Bool
-> Fingerprint
-> ModuleInfo
ModuleInfo ModuleName
mod UnitId
uid Bool
isBoot Maybe String
srcFile Bool
isReal Fingerprint
hash)

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

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

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

  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
-> String -> HieFile -> Array TypeIndex (Maybe Int64) -> IO ()
addTypeRefs HieDb
db String
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 -> String -> String -> Bool -> IO ()
addSrcFile (HieDb -> Connection
getConn -> Connection
conn) String
hie String
srcFile Bool
isReal =
  Connection -> Query -> (String, Bool, String) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"UPDATE mods SET hs_src = ? , is_real = ? WHERE hieFile = ?" (String
srcFile, Bool
isReal, String
hie)

{-| Delete all occurrences of given @.hie@ file from the database -}
deleteFileFromIndex :: HieDb -> FilePath -> IO ()
deleteFileFromIndex :: HieDb -> String -> IO ()
deleteFileFromIndex (HieDb -> Connection
getConn -> Connection
conn) String
path = Connection -> IO () -> IO ()
forall a. Connection -> IO a -> IO a
withTransaction Connection
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM mods  WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM refs  WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM decls WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)
  Connection -> Query -> Only String -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"DELETE FROM defs  WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)