{-# 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 System.Directory

import Database.SQLite.Simple
import Data.Time.Clock
import Data.List ( isSuffixOf )
import Data.String
import Data.Int

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
4

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 \
                \, time    TEXT NOT NULL \
                \, 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 -> Maybe TypeIndex
forall a. IdentifierDetails a -> Maybe a
identType ([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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HieAST TypeIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([HieAST TypeIndex] -> Bool) -> [HieAST TypeIndex] -> Bool
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> [HieAST TypeIndex]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST TypeIndex
ast) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (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
$ NodeInfo TypeIndex -> [TypeIndex]
forall a. NodeInfo a -> [a]
nodeType (NodeInfo TypeIndex -> [TypeIndex])
-> NodeInfo TypeIndex -> [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
  UTCTime
time <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime) -> IO UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime 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, UTCTime) -> IO [HieModuleRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT * FROM mods WHERE hieFile = ? AND time >= ?" (String
path, UTCTime
time)
  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 -> UTCTime -> HieFile -> m ()
forall (m :: * -> *).
MonadIO m =>
HieDb
-> String -> Maybe String -> Bool -> UTCTime -> HieFile -> m ()
addRefsFromLoaded HieDb
c String
path Maybe String
forall a. Maybe a
Nothing Bool
False UTCTime
time 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)?
  -> UTCTime -- ^ The last modification time of the @.hie@ file
  -> HieFile -- ^ Data loaded from the @.hie@ file
  -> m ()
addRefsFromLoaded :: HieDb
-> String -> Maybe String -> Bool -> UTCTime -> HieFile -> m ()
addRefsFromLoaded db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) String
path Maybe String
srcFile Bool
isReal UTCTime
time 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 -> UTCTime -> ModuleInfo
ModuleInfo ModuleName
mod UnitId
uid Bool
isBoot Maybe String
srcFile Bool
isReal UTCTime
time)

  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

  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)

  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

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isReal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    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)