{-# 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 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 = 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 :: (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
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)
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)
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 \
\, 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)"
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 :: Unit
uid = Module -> Unit
moduleUnit Module
m
Connection -> Query -> (OccName, ModuleName, Unit) -> IO ()
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)
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, Unit) -> 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,Unit
uid)
addTypeRefs
:: HieDb
-> FilePath
-> HieFile
-> A.Array TypeIndex (Maybe Int64)
-> 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 HiePath (HieAST TypeIndex) -> IO ()
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 = HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts (HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex))
-> HieASTs TypeIndex -> Map HiePath (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
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
addRefsFrom :: (MonadIO m, NameCacheMonad m) => HieDb -> FilePath -> m Bool
addRefsFrom :: HieDb -> String -> m Bool
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]
_) -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
[] -> do
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
$ HieDb -> String -> SourceFile -> Fingerprint -> HieFile -> m ()
forall (m :: * -> *).
MonadIO m =>
HieDb -> String -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded HieDb
c String
path (Maybe String -> SourceFile
FakeFile Maybe String
forall a. Maybe a
Nothing) Fingerprint
hash
Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
addRefsFromLoaded
:: MonadIO m
=> HieDb
-> FilePath
-> SourceFile
-> Fingerprint
-> HieFile
-> m ()
addRefsFromLoaded :: HieDb -> String -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded
db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) String
path SourceFile
sourceFile 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 -> String -> IO ()
deleteInternalTables Connection
conn String
path
HieDb -> String -> SourceFile -> Fingerprint -> HieFile -> IO ()
forall (m :: * -> *).
MonadIO m =>
HieDb -> String -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded_unsafe HieDb
db String
path SourceFile
sourceFile Fingerprint
hash HieFile
hf
addRefsFromLoaded_unsafe
:: MonadIO m
=> HieDb
-> FilePath
-> SourceFile
-> Fingerprint
-> HieFile
-> m ()
addRefsFromLoaded_unsafe :: HieDb -> String -> SourceFile -> Fingerprint -> HieFile -> m ()
addRefsFromLoaded_unsafe
db :: HieDb
db@(HieDb -> Connection
getConn -> Connection
conn) String
path SourceFile
sourceFile 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
$ do
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 :: Unit
uid = Module -> Unit
moduleUnit Module
smod
smod :: Module
smod = HieFile -> Module
hie_module HieFile
hf
refmap :: Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)]
refmap = Map HiePath (HieAST TypeIndex)
-> Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a) -> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
generateReferencesMap (Map HiePath (HieAST TypeIndex)
-> Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)])
-> Map HiePath (HieAST TypeIndex)
-> Map Identifier [(RealSrcSpan, IdentifierDetails TypeIndex)]
forall a b. (a -> b) -> a -> b
$ HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts (HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex))
-> HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex)
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs TypeIndex
hie_asts HieFile
hf
(Maybe String
srcFile, Bool
isReal) = case SourceFile
sourceFile of
RealFile String
f -> (String -> Maybe String
forall a. a -> Maybe a
Just String
f, Bool
True)
FakeFile Maybe String
mf -> (Maybe String
mf, Bool
False)
modrow :: HieModuleRow
modrow = String -> ModuleInfo -> HieModuleRow
HieModuleRow String
path (ModuleName
-> Unit
-> Bool
-> Maybe String
-> Bool
-> Fingerprint
-> ModuleInfo
ModuleInfo ModuleName
mod Unit
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
let exports :: [ExportRow]
exports = String -> [AvailInfo] -> [ExportRow]
generateExports String
path ([AvailInfo] -> [ExportRow]) -> [AvailInfo] -> [ExportRow]
forall a b. (a -> b) -> a -> b
$ HieFile -> [AvailInfo]
hie_exports HieFile
hf
Connection -> Query -> [ExportRow] -> IO ()
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
-> String -> HieFile -> Array TypeIndex (Maybe Int64) -> IO ()
addTypeRefs HieDb
db String
path HieFile
hf Array TypeIndex (Maybe Int64)
ixs
addSrcFile
:: HieDb
-> FilePath
-> FilePath
-> Bool
-> 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)
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 -> String -> IO ()
deleteInternalTables Connection
conn String
path
deleteMissingRealFiles :: HieDb -> IO ()
deleteMissingRealFiles :: HieDb -> IO ()
deleteMissingRealFiles (HieDb -> Connection
getConn -> Connection
conn) = 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
[String]
missing_file_keys <- Connection
-> Query
-> [String]
-> ([String] -> (String, String) -> IO [String])
-> IO [String]
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" [] (([String] -> (String, String) -> IO [String]) -> IO [String])
-> ([String] -> (String, String) -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$
\[String]
acc (String
path,String
src) -> do
Bool
exists <- String -> IO Bool
doesFileExist String
src
[String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ if Bool
exists then [String]
acc else String
path String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
missing_file_keys ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
path -> do
Connection -> String -> IO ()
deleteInternalTables Connection
conn String
path
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 -> String -> IO ()
deleteInternalTables Connection
conn String
path = 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)
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 exports WHERE hieFile = ?" (String -> Only String
forall a. a -> Only a
Only String
path)