{-# LANGUAGE OverloadedStrings, TypeOperators, TypeApplications #-}

module HsDev.Database.SQLite (
	initialize, purge,
	privateMemory, sharedMemory,
	query, query_, queryNamed, execute, execute_, executeMany, executeNamed,
	withTemporaryTable,
	updatePackageDb, removePackageDb, insertPackageDb,
	updateProject, removeProject, insertProject, insertBuildInfo,
	removeModuleContents, removeModule,
	lookupModuleLocation, lookupModule,
	lookupSymbol,
	lastRow,

	loadModule, loadModules,
	loadProject,

	updateModules, upsertModules,

	-- * Utils
	lookupId,
	escapeLike,

	-- * Reexports
	module Database.SQLite.Simple,
	module HsDev.Database.SQLite.Select,
	module HsDev.Database.SQLite.Instances,
	module HsDev.Database.SQLite.Transaction
	) where

import Control.Lens hiding ((.=))
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson hiding (Error)
import Data.List (intercalate)
import Data.Maybe
import Data.String
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Database.SQLite.Simple hiding (query, query_, queryNamed, execute, execute_, executeNamed, executeMany, withTransaction)
import qualified Database.SQLite.Simple as SQL (query, query_, queryNamed, execute, execute_, executeNamed, executeMany, withTransaction)
import Distribution.Text (display)
import Language.Haskell.Extension ()
import System.Directory
import System.Log.Simple
import Text.Format

import System.Directory.Paths

import HsDev.Database.SQLite.Instances
import HsDev.Database.SQLite.Schema
import HsDev.Database.SQLite.Select
import HsDev.Database.SQLite.Transaction
import qualified HsDev.Display as Display
import HsDev.Error
import HsDev.PackageDb.Types
import HsDev.Project.Types
import HsDev.Symbols (hasTag)
import HsDev.Symbols.Types hiding (loadProject)
import HsDev.Server.Types
import HsDev.Util

-- | Open new connection and set some pragmas
new :: String -> IO Connection
new :: String -> IO Connection
new String
p = do
	Connection
conn <- String -> IO Connection
open String
p
	Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"pragma case_sensitive_like = true;"
	Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"pragma synchronous = off;"
	Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"pragma journal_mode = memory;"
	Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

-- | Initialize database
initialize :: String -> IO Connection
initialize :: String -> IO Connection
initialize String
p = do
	Connection
conn <- String -> IO Connection
new String
p
	[Only Bool
hasTables] <- Connection -> Query -> IO [Only Bool]
forall r. FromRow r => Connection -> Query -> IO [r]
SQL.query_ Connection
conn Query
"select count(*) > 0 from sqlite_master where type == 'table';"
	Bool
goodVersion <- if Bool
hasTables
		then do
			[Only Bool
equalVersion] <- Connection -> Query -> Only Value -> IO [Only Bool]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
SQL.query Connection
conn Query
"select sum(json(value) == json(?)) > 0 from hsdev where option == 'version';" (Value -> Only Value
forall a. a -> Only a
Only (Value -> Only Value) -> Value -> Only Value
forall a b. (a -> b) -> a -> b
$ Maybe [Int] -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe [Int]
version)
			Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
equalVersion
		else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
	let
		start :: IO Connection
start
			| Bool -> Bool
not Bool
goodVersion = do
					Connection -> IO ()
close Connection
conn
					String -> IO ()
removeFile String
p
					Connection
conn' <- String -> IO Connection
new String
p
					Connection -> IO Connection
initDb Connection
conn'
			| Bool -> Bool
not Bool
hasTables = Connection -> IO Connection
initDb Connection
conn
			| Bool
otherwise = Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn
		initDb :: Connection -> IO Connection
initDb Connection
conn' = Connection -> IO Connection -> IO Connection
forall a. Connection -> IO a -> IO a
SQL.withTransaction Connection
conn' (IO Connection -> IO Connection) -> IO Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ do
			(Query -> IO ()) -> [Query] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Connection -> Query -> IO ()
SQL.execute_ Connection
conn') [Query]
commands
			Connection -> Query -> (Text, Value) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
SQL.execute @(Text, Value) Connection
conn' Query
"insert into hsdev values (?, ?);" (Text
"version", Maybe [Int] -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe [Int]
version)
			Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn'
	IO Connection
start

purge :: SessionMonad m => m ()
purge :: m ()
purge = do
	[Only String]
tables <- Query -> m [Only String]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> m [r]
query_ @(Only String) Query
"select name from sqlite_master where type == 'table';"
	[Only String] -> (Only String -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Only String]
tables ((Only String -> m ()) -> m ()) -> (Only String -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Only String
table) ->
		Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ (Query -> m ()) -> Query -> m ()
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
$ Format
"delete from {};" Format -> String -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
table

-- | Private memory for db
privateMemory :: String
privateMemory :: String
privateMemory = String
":memory:"

-- | Shared db in memory
sharedMemory :: String
sharedMemory :: String
sharedMemory = String
"file::memory:?cache=shared"

-- | Retries for simple queries
retried :: (MonadIO m, MonadCatch m) => m a -> m a
retried :: m a -> m a
retried = Retries -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
Retries -> m a -> m a
retry Retries
forall a. Default a => a
def

query :: (ToRow q, FromRow r, SessionMonad m) => Query -> q -> m [r]
query :: Query -> q -> m [r]
query Query
q' q
params = m [r] -> m [r]
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m a
retried (m [r] -> m [r]) -> m [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO [r] -> m [r]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> q -> IO [r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
SQL.query Connection
conn Query
q' q
params

query_ :: (FromRow r, SessionMonad m) => Query -> m [r]
query_ :: Query -> m [r]
query_ Query
q' = m [r] -> m [r]
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m a
retried (m [r] -> m [r]) -> m [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO [r] -> m [r]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO [r]
forall r. FromRow r => Connection -> Query -> IO [r]
SQL.query_ Connection
conn Query
q'

queryNamed :: (FromRow r, SessionMonad m) => Query -> [NamedParam] -> m [r]
queryNamed :: Query -> [NamedParam] -> m [r]
queryNamed Query
q' [NamedParam]
ps' = m [r] -> m [r]
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m a
retried (m [r] -> m [r]) -> m [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO [r] -> m [r]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> [NamedParam] -> IO [r]
forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
SQL.queryNamed Connection
conn Query
q' [NamedParam]
ps'

execute :: (ToRow q, SessionMonad m) => Query -> q -> m ()
execute :: Query -> q -> m ()
execute Query
q' q
params = m () -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m a
retried (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> q -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
SQL.execute Connection
conn Query
q' q
params

execute_ :: SessionMonad m => Query -> m ()
execute_ :: Query -> m ()
execute_ Query
q' = m () -> m ()
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m a
retried (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
q'

executeMany :: (ToRow q, SessionMonad m) => Query -> [q] -> m ()
executeMany :: Query -> [q] -> m ()
executeMany Query
q' [q]
params = do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> [q] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
SQL.executeMany Connection
conn Query
q' [q]
params

executeNamed :: SessionMonad m => Query -> [NamedParam] -> m ()
executeNamed :: Query -> [NamedParam] -> m ()
executeNamed Query
q' [NamedParam]
ps' = do
	Connection
conn <- m Connection
forall (m :: * -> *). SessionMonad m => m Connection
serverSqlDatabase
	IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> [NamedParam] -> IO ()
SQL.executeNamed Connection
conn Query
q' [NamedParam]
ps'

withTemporaryTable :: SessionMonad m => String -> [String] -> m a -> m a
withTemporaryTable :: String -> [String] -> m a -> m a
withTemporaryTable String
tableName [String]
columns = m () -> m () -> m a -> m a
forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_ m ()
createTable m ()
dropTable where
	createTable :: m ()
createTable = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ (Query -> m ()) -> Query -> m ()
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
$ Format
"create temporary table {} ({});" Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
tableName Format -> String -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
columns)
	dropTable :: m ()
dropTable = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ (Query -> m ()) -> Query -> m ()
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
$ Format
"drop table {};" Format -> String -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
tableName

updatePackageDb :: SessionMonad m => PackageDb -> [ModulePackage] -> m ()
updatePackageDb :: PackageDb -> [ModulePackage] -> m ()
updatePackageDb PackageDb
pdb [ModulePackage]
pkgs = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"update-package-db" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Trace (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"update package-db: {}" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ PackageDb -> String
forall a. Display a => a -> String
Display.display PackageDb
pdb
	PackageDb -> m ()
forall (m :: * -> *). SessionMonad m => PackageDb -> m ()
removePackageDb PackageDb
pdb
	PackageDb -> [ModulePackage] -> m ()
forall (m :: * -> *).
SessionMonad m =>
PackageDb -> [ModulePackage] -> m ()
insertPackageDb PackageDb
pdb [ModulePackage]
pkgs

removePackageDb :: SessionMonad m => PackageDb -> m ()
removePackageDb :: PackageDb -> m ()
removePackageDb PackageDb
pdb = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"remove-package-db" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
	Query -> Only PackageDb -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from package_dbs where package_db == ?;" (PackageDb -> Only PackageDb
forall a. a -> Only a
Only PackageDb
pdb)

insertPackageDb :: SessionMonad m => PackageDb -> [ModulePackage] -> m ()
insertPackageDb :: PackageDb -> [ModulePackage] -> m ()
insertPackageDb PackageDb
pdb [ModulePackage]
pkgs = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"insert-package-db" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [ModulePackage] -> (ModulePackage -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ModulePackage]
pkgs ((ModulePackage -> m ()) -> m ())
-> (ModulePackage -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ModulePackage
pkg ->
	Query -> (PackageDb, Text, Text) -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute
		Query
"insert into package_dbs (package_db, package_name, package_version) values (?, ?, ?);"
		(PackageDb
pdb, ModulePackage
pkg ModulePackage -> Getting Text ModulePackage Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ModulePackage Text
Lens' ModulePackage Text
packageName, ModulePackage
pkg ModulePackage -> Getting Text ModulePackage Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ModulePackage Text
Lens' ModulePackage Text
packageVersion)

updateProject :: SessionMonad m => Project -> m ()
updateProject :: Project -> m ()
updateProject Project
proj = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"update-project" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Trace (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"update project: {}" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Project -> String
forall a. Display a => a -> String
Display.display Project
proj
	Project -> m ()
forall (m :: * -> *). SessionMonad m => Project -> m ()
removeProject Project
proj
	Project -> m ()
forall (m :: * -> *). SessionMonad m => Project -> m ()
insertProject Project
proj

removeProject :: SessionMonad m => Project -> m ()
removeProject :: Project -> m ()
removeProject Project
proj = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"remove-project" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	[Only Int]
projId <- Query -> Only Text -> m [Only Int]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(Only Int) Query
"select id from projects where cabal == ?;" (Text -> Only Text
forall a. a -> Only a
Only (Text -> Only Text) -> Text -> Only Text
forall a b. (a -> b) -> a -> b
$ Project
proj Project -> Getting Text Project Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Project Text
Lens' Project Text
projectCabal)
	case [Only Int]
projId of
		[] -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
		[Only Int]
pids -> do
			Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Only Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Only Int]
pids Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
				Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"multiple projects for cabal {} found" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (Project
proj Project -> Getting Text Project Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Project Text
Lens' Project Text
projectCabal)
			[Only Int] -> (Only Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Only Int]
pids ((Only Int -> m ()) -> m ()) -> (Only Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Only Int
pid -> do
				[Only Int]
bids <- Query -> Only Int -> m [Only Int]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(Only Int) Query
"select build_info_id from targets where project_id == ?;" Only Int
pid
				Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from projects where id == ?;" Only Int
pid
				Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from libraries where project_id == ?;" Only Int
pid
				Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from executables where project_id == ?;" Only Int
pid
				Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from tests where project_id == ?;" Only Int
pid
				[Only Int] -> (Only Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Only Int]
bids ((Only Int -> m ()) -> m ()) -> (Only Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Only Int
bid -> Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from build_infos where id == ?;" Only Int
bid

insertProject :: SessionMonad m => Project -> m ()
insertProject :: Project -> m ()
insertProject Project
proj = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"insert-project" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Query -> Project -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"insert into projects (name, cabal, version, build_tool, package_db_stack) values (?, ?, ?, ?, ?);" Project
proj
	Int
projId <- m Int
forall (m :: * -> *). SessionMonad m => m Int
lastRow

	Maybe Library -> (Library -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Project
proj Project -> Getting (First Library) Project Library -> Maybe Library
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe ProjectDescription
 -> Const (First Library) (Maybe ProjectDescription))
-> Project -> Const (First Library) Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const (First Library) (Maybe ProjectDescription))
 -> Project -> Const (First Library) Project)
-> ((Library -> Const (First Library) Library)
    -> Maybe ProjectDescription
    -> Const (First Library) (Maybe ProjectDescription))
-> Getting (First Library) Project Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Const (First Library) ProjectDescription)
-> Maybe ProjectDescription
-> Const (First Library) (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Const (First Library) ProjectDescription)
 -> Maybe ProjectDescription
 -> Const (First Library) (Maybe ProjectDescription))
-> ((Library -> Const (First Library) Library)
    -> ProjectDescription -> Const (First Library) ProjectDescription)
-> (Library -> Const (First Library) Library)
-> Maybe ProjectDescription
-> Const (First Library) (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Library -> Const (First Library) (Maybe Library))
-> ProjectDescription -> Const (First Library) ProjectDescription
Lens' ProjectDescription (Maybe Library)
projectLibrary ((Maybe Library -> Const (First Library) (Maybe Library))
 -> ProjectDescription -> Const (First Library) ProjectDescription)
-> ((Library -> Const (First Library) Library)
    -> Maybe Library -> Const (First Library) (Maybe Library))
-> (Library -> Const (First Library) Library)
-> ProjectDescription
-> Const (First Library) ProjectDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (First Library) Library)
-> Maybe Library -> Const (First Library) (Maybe Library)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ((Library -> m ()) -> m ()) -> (Library -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Library
lib -> do
		Int
buildInfoId <- Info -> m Int
forall (m :: * -> *). SessionMonad m => Info -> m Int
insertBuildInfo (Info -> m Int) -> Info -> m Int
forall a b. (a -> b) -> a -> b
$ Library
lib Library -> Getting Info Library Info -> Info
forall s a. s -> Getting a s a -> a
^. Getting Info Library Info
Lens' Library Info
libraryBuildInfo
		Query -> (Int, ByteString, Int) -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"insert into libraries (project_id, modules, build_info_id) values (?, ?, ?);"
			(Int
projId, [[Text]] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([[Text]] -> ByteString) -> [[Text]] -> ByteString
forall a b. (a -> b) -> a -> b
$ Library
lib Library -> Getting [[Text]] Library [[Text]] -> [[Text]]
forall s a. s -> Getting a s a -> a
^. Getting [[Text]] Library [[Text]]
Lens' Library [[Text]]
libraryModules, Int
buildInfoId)

	[Executable] -> (Executable -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Project
proj Project
-> Getting (Endo [Executable]) Project Executable -> [Executable]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Maybe ProjectDescription
 -> Const (Endo [Executable]) (Maybe ProjectDescription))
-> Project -> Const (Endo [Executable]) Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const (Endo [Executable]) (Maybe ProjectDescription))
 -> Project -> Const (Endo [Executable]) Project)
-> ((Executable -> Const (Endo [Executable]) Executable)
    -> Maybe ProjectDescription
    -> Const (Endo [Executable]) (Maybe ProjectDescription))
-> Getting (Endo [Executable]) Project Executable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription
 -> Const (Endo [Executable]) ProjectDescription)
-> Maybe ProjectDescription
-> Const (Endo [Executable]) (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription
  -> Const (Endo [Executable]) ProjectDescription)
 -> Maybe ProjectDescription
 -> Const (Endo [Executable]) (Maybe ProjectDescription))
-> ((Executable -> Const (Endo [Executable]) Executable)
    -> ProjectDescription
    -> Const (Endo [Executable]) ProjectDescription)
-> (Executable -> Const (Endo [Executable]) Executable)
-> Maybe ProjectDescription
-> Const (Endo [Executable]) (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Executable] -> Const (Endo [Executable]) [Executable])
-> ProjectDescription
-> Const (Endo [Executable]) ProjectDescription
Lens' ProjectDescription [Executable]
projectExecutables (([Executable] -> Const (Endo [Executable]) [Executable])
 -> ProjectDescription
 -> Const (Endo [Executable]) ProjectDescription)
-> ((Executable -> Const (Endo [Executable]) Executable)
    -> [Executable] -> Const (Endo [Executable]) [Executable])
-> (Executable -> Const (Endo [Executable]) Executable)
-> ProjectDescription
-> Const (Endo [Executable]) ProjectDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> Const (Endo [Executable]) Executable)
-> [Executable] -> Const (Endo [Executable]) [Executable]
forall s t a b. Each s t a b => Traversal s t a b
each) ((Executable -> m ()) -> m ()) -> (Executable -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Executable
exe -> do
		Int
buildInfoId <- Info -> m Int
forall (m :: * -> *). SessionMonad m => Info -> m Int
insertBuildInfo (Info -> m Int) -> Info -> m Int
forall a b. (a -> b) -> a -> b
$ Executable
exe Executable -> Getting Info Executable Info -> Info
forall s a. s -> Getting a s a -> a
^. Getting Info Executable Info
Lens' Executable Info
executableBuildInfo
		Query -> (Int, Text, String, Int) -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"insert into executables (project_id, name, path, build_info_id) values (?, ?, ?, ?);"
			(Int
projId, Executable
exe Executable -> Getting Text Executable Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Executable Text
Lens' Executable Text
executableName, Executable
exe Executable -> Getting String Executable String -> String
forall s a. s -> Getting a s a -> a
^. (Text -> Const String Text)
-> Executable -> Const String Executable
Lens' Executable Text
executablePath ((Text -> Const String Text)
 -> Executable -> Const String Executable)
-> ((String -> Const String String) -> Text -> Const String Text)
-> Getting String Executable String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Text -> Const String Text
Lens' Text String
path, Int
buildInfoId)

	[Test] -> (Test -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Project
proj Project -> Getting (Endo [Test]) Project Test -> [Test]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Maybe ProjectDescription
 -> Const (Endo [Test]) (Maybe ProjectDescription))
-> Project -> Const (Endo [Test]) Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const (Endo [Test]) (Maybe ProjectDescription))
 -> Project -> Const (Endo [Test]) Project)
-> ((Test -> Const (Endo [Test]) Test)
    -> Maybe ProjectDescription
    -> Const (Endo [Test]) (Maybe ProjectDescription))
-> Getting (Endo [Test]) Project Test
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Const (Endo [Test]) ProjectDescription)
-> Maybe ProjectDescription
-> Const (Endo [Test]) (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Const (Endo [Test]) ProjectDescription)
 -> Maybe ProjectDescription
 -> Const (Endo [Test]) (Maybe ProjectDescription))
-> ((Test -> Const (Endo [Test]) Test)
    -> ProjectDescription -> Const (Endo [Test]) ProjectDescription)
-> (Test -> Const (Endo [Test]) Test)
-> Maybe ProjectDescription
-> Const (Endo [Test]) (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Test] -> Const (Endo [Test]) [Test])
-> ProjectDescription -> Const (Endo [Test]) ProjectDescription
Lens' ProjectDescription [Test]
projectTests (([Test] -> Const (Endo [Test]) [Test])
 -> ProjectDescription -> Const (Endo [Test]) ProjectDescription)
-> ((Test -> Const (Endo [Test]) Test)
    -> [Test] -> Const (Endo [Test]) [Test])
-> (Test -> Const (Endo [Test]) Test)
-> ProjectDescription
-> Const (Endo [Test]) ProjectDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test -> Const (Endo [Test]) Test)
-> [Test] -> Const (Endo [Test]) [Test]
forall s t a b. Each s t a b => Traversal s t a b
each) ((Test -> m ()) -> m ()) -> (Test -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Test
test -> do
		Int
buildInfoId <- Info -> m Int
forall (m :: * -> *). SessionMonad m => Info -> m Int
insertBuildInfo (Info -> m Int) -> Info -> m Int
forall a b. (a -> b) -> a -> b
$ Test
test Test -> Getting Info Test Info -> Info
forall s a. s -> Getting a s a -> a
^. Getting Info Test Info
Lens' Test Info
testBuildInfo
		Query -> (Int, Text, Bool, Maybe String, Int) -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"insert into tests (project_id, name, enabled, main, build_info_id) values (?, ?, ?, ?, ?);"
			(Int
projId, Test
test Test -> Getting Text Test Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Test Text
Lens' Test Text
testName, Test
test Test -> Getting Bool Test Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Test Bool
Lens' Test Bool
testEnabled, Test
test Test -> Getting (First String) Test String -> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe Text -> Const (First String) (Maybe Text))
-> Test -> Const (First String) Test
Lens' Test (Maybe Text)
testMain ((Maybe Text -> Const (First String) (Maybe Text))
 -> Test -> Const (First String) Test)
-> ((String -> Const (First String) String)
    -> Maybe Text -> Const (First String) (Maybe Text))
-> Getting (First String) Test String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First String) Text)
-> Maybe Text -> Const (First String) (Maybe Text)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Text -> Const (First String) Text)
 -> Maybe Text -> Const (First String) (Maybe Text))
-> ((String -> Const (First String) String)
    -> Text -> Const (First String) Text)
-> (String -> Const (First String) String)
-> Maybe Text
-> Const (First String) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> Text -> Const (First String) Text
Lens' Text String
path, Int
buildInfoId)

insertBuildInfo :: SessionMonad m => Info -> m Int
insertBuildInfo :: Info -> m Int
insertBuildInfo Info
info = Text -> m Int -> m Int
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"insert-build-info" (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
	Query
-> (ByteString, Maybe String, ByteString, ByteString, ByteString,
    ByteString)
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"insert into build_infos (depends, language, extensions, ghc_options, source_dirs, other_modules) values (?, ?, ?, ?, ?, ?);" (
			[Text] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$ Info
info Info -> Getting [Text] Info [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] Info [Text]
Lens' Info [Text]
infoDepends,
			(Language -> String) -> Maybe Language -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Language -> String
forall a. Pretty a => a -> String
display (Maybe Language -> Maybe String) -> Maybe Language -> Maybe String
forall a b. (a -> b) -> a -> b
$ Info
info Info
-> Getting (Maybe Language) Info (Maybe Language) -> Maybe Language
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Language) Info (Maybe Language)
Lens' Info (Maybe Language)
infoLanguage,
			[String] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([String] -> ByteString) -> [String] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> String
forall a. Pretty a => a -> String
display ([Extension] -> [String]) -> [Extension] -> [String]
forall a b. (a -> b) -> a -> b
$ Info
info Info -> Getting [Extension] Info [Extension] -> [Extension]
forall s a. s -> Getting a s a -> a
^. Getting [Extension] Info [Extension]
Lens' Info [Extension]
infoExtensions,
			[Text] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$ Info
info Info -> Getting [Text] Info [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] Info [Text]
Lens' Info [Text]
infoGHCOptions,
			[String] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([String] -> ByteString) -> [String] -> ByteString
forall a b. (a -> b) -> a -> b
$ Info
info Info -> Getting (Endo [String]) Info String -> [String]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Text] -> Const (Endo [String]) [Text])
-> Info -> Const (Endo [String]) Info
Lens' Info [Text]
infoSourceDirs (([Text] -> Const (Endo [String]) [Text])
 -> Info -> Const (Endo [String]) Info)
-> ((String -> Const (Endo [String]) String)
    -> [Text] -> Const (Endo [String]) [Text])
-> Getting (Endo [String]) Info String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [String]) Text)
-> [Text] -> Const (Endo [String]) [Text]
forall s t a b. Each s t a b => Traversal s t a b
each ((Text -> Const (Endo [String]) Text)
 -> [Text] -> Const (Endo [String]) [Text])
-> ((String -> Const (Endo [String]) String)
    -> Text -> Const (Endo [String]) Text)
-> (String -> Const (Endo [String]) String)
-> [Text]
-> Const (Endo [String]) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (Endo [String]) String)
-> Text -> Const (Endo [String]) Text
Lens' Text String
path,
			[[Text]] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([[Text]] -> ByteString) -> [[Text]] -> ByteString
forall a b. (a -> b) -> a -> b
$ Info
info Info -> Getting [[Text]] Info [[Text]] -> [[Text]]
forall s a. s -> Getting a s a -> a
^. Getting [[Text]] Info [[Text]]
Lens' Info [[Text]]
infoOtherModules)
	m Int
forall (m :: * -> *). SessionMonad m => m Int
lastRow

removeModuleContents :: SessionMonad m => Int -> m ()
removeModuleContents :: Int -> m ()
removeModuleContents Int
mid = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"remove-module-contents" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from imports where module_id = ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from exports where module_id = ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from scopes where module_id = ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from names where module_id = ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from types where module_id = ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from symbols where module_id = ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)

removeModule :: SessionMonad m => Int -> m ()
removeModule :: Int -> m ()
removeModule Int
mid = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"remove-module" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	Int -> m ()
forall (m :: * -> *). SessionMonad m => Int -> m ()
removeModuleContents Int
mid
	Query -> Only Int -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"delete from modules where id == ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)

upsertModules :: SessionMonad m => [InspectedModule] -> m [Int]
upsertModules :: [InspectedModule] -> m [Int]
upsertModules [InspectedModule]
ims = Text -> m [Int] -> m [Int]
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"upsert-modules" (m [Int] -> m [Int]) -> m [Int] -> m [Int]
forall a b. (a -> b) -> a -> b
$ m () -> m () -> m [Int] -> m [Int]
forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_ m ()
forall (m :: * -> *). SessionMonad m => m ()
initTemp m ()
forall (m :: * -> *). SessionMonad m => m ()
removeTemp (m [Int] -> m [Int]) -> m [Int] -> m [Int]
forall a b. (a -> b) -> a -> b
$ do
	Query
-> [(Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
     Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
    :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection)]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into upserted_modules (file, cabal, install_dirs, package_name, package_version, installed_name, exposed, other_location, name, docs, fixities, tags, inspection_error, inspection_time, inspection_opts) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" ([(Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
   Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
  :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
       Maybe String)
      :. Inspection)]
 -> m ())
-> [(Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
     Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
    :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection)]
-> m ()
forall a b. (a -> b) -> a -> b
$ (InspectedModule
 -> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
     Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
    :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection))
-> [InspectedModule]
-> [(Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
     Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
    :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection)]
forall a b. (a -> b) -> [a] -> [b]
map InspectedModule
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
forall a.
Display a =>
Inspected ModuleLocation a Module
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
moduleData [InspectedModule]
ims
	Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"update upserted_modules set id = (select m.id from modules as m where (m.file = upserted_modules.file) or ((m.package_name = upserted_modules.package_name) and (m.package_version = upserted_modules.package_version) and (m.installed_name = upserted_modules.installed_name)) or (m.other_location = upserted_modules.other_location));"
	Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"insert or replace into modules (id, file, cabal, install_dirs, package_name, package_version, installed_name, exposed, other_location, name, docs, fixities, tags, inspection_error, inspection_time, inspection_opts) select id, file, cabal, install_dirs, package_name, package_version, installed_name, exposed, other_location, name, docs, fixities, tags, inspection_error, inspection_time, inspection_opts from upserted_modules where id is not null;"
	Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"insert into modules (file, cabal, install_dirs, package_name, package_version, installed_name, exposed, other_location, name, docs, fixities, tags, inspection_error, inspection_time, inspection_opts) select file, cabal, install_dirs, package_name, package_version, installed_name, exposed, other_location, name, docs, fixities, tags, inspection_error, inspection_time, inspection_opts from upserted_modules where id is null;"
	Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"update upserted_modules set id = (select m.id from modules as m where (m.file = upserted_modules.file) or ((m.package_name = upserted_modules.package_name) and (m.package_version = upserted_modules.package_version) and (m.installed_name = upserted_modules.installed_name)) or (m.other_location = upserted_modules.other_location)) where id is null;"

	([Only Int] -> [Int]) -> m [Only Int] -> m [Int]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Only Int -> Int) -> [Only Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Only Int -> Int
forall a. Only a -> a
fromOnly) (m [Only Int] -> m [Int]) -> m [Only Int] -> m [Int]
forall a b. (a -> b) -> a -> b
$ Query -> m [Only Int]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> m [r]
query_ Query
"select id from upserted_modules order by rowid;"
	where
		initTemp :: SessionMonad m => m ()
		initTemp :: m ()
initTemp = do
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create temporary table upserted_modules as select * from modules where 0;"
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create index upserted_modules_id_index on upserted_modules (id);"

		removeTemp :: SessionMonad m => m ()
		removeTemp :: m ()
removeTemp = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"drop table if exists upserted_modules;"

		moduleData :: Inspected ModuleLocation a Module
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
moduleData Inspected ModuleLocation a Module
im = (
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting
     (First String) (Inspected ModuleLocation a Module) String
-> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First String) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First String) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First String) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First String) (Inspected ModuleLocation a Module))
-> ((String -> Const (First String) String)
    -> ModuleLocation -> Const (First String) ModuleLocation)
-> Getting
     (First String) (Inspected ModuleLocation a Module) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First String) Text)
-> ModuleLocation -> Const (First String) ModuleLocation
Traversal' ModuleLocation Text
moduleFile ((Text -> Const (First String) Text)
 -> ModuleLocation -> Const (First String) ModuleLocation)
-> ((String -> Const (First String) String)
    -> Text -> Const (First String) Text)
-> (String -> Const (First String) String)
-> ModuleLocation
-> Const (First String) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> Text -> Const (First String) Text
Lens' Text String
path,
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Project -> Const (First Text) (Maybe Project))
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation (Maybe Project)
moduleProject ((Maybe Project -> Const (First Text) (Maybe Project))
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> Maybe Project -> Const (First Text) (Maybe Project))
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Project -> Const (First Text) Project)
-> Maybe Project -> Const (First Text) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Project -> Const (First Text) Project)
 -> Maybe Project -> Const (First Text) (Maybe Project))
-> ((Text -> Const (First Text) Text)
    -> Project -> Const (First Text) Project)
-> (Text -> Const (First Text) Text)
-> Maybe Project
-> Const (First Text) (Maybe Project)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Project -> Const (First Text) Project
Lens' Project Text
projectCabal,
			([Text] -> ByteString) -> Maybe [Text] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([String] -> ByteString)
-> ([Text] -> [String]) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (((String -> Const String String) -> Text -> Const String Text)
-> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Text -> Const String Text
Lens' Text String
path)) (Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting
     (First [Text]) (Inspected ModuleLocation a Module) [Text]
-> Maybe [Text]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First [Text]) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First [Text]) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First [Text]) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First [Text]) (Inspected ModuleLocation a Module))
-> (([Text] -> Const (First [Text]) [Text])
    -> ModuleLocation -> Const (First [Text]) ModuleLocation)
-> Getting
     (First [Text]) (Inspected ModuleLocation a Module) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const (First [Text]) [Text])
-> ModuleLocation -> Const (First [Text]) ModuleLocation
Traversal' ModuleLocation [Text]
moduleInstallDirs),
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageName,
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageVersion,
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
installedModuleName,
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Bool) (Inspected ModuleLocation a Module) Bool
-> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Bool) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Bool) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Bool) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Bool) (Inspected ModuleLocation a Module))
-> ((Bool -> Const (First Bool) Bool)
    -> ModuleLocation -> Const (First Bool) ModuleLocation)
-> Getting (First Bool) (Inspected ModuleLocation a Module) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> ModuleLocation -> Const (First Bool) ModuleLocation
Traversal' ModuleLocation Bool
installedModuleExposed,
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
otherLocationName)
			(Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
 Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
-> ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
     Maybe String)
    :. Inspection)
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
forall h t. h -> t -> h :. t
:. (
			[Maybe Text] -> Maybe Text
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Module -> Const (First Text) Module)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Module -> Const (First Text) Module)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> Module -> Const (First Text) Module)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const (First Text) ModuleId)
-> Module -> Const (First Text) Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const (First Text) ModuleId)
 -> Module -> Const (First Text) Module)
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> (Text -> Const (First Text) Text)
-> Module
-> Const (First Text) Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId Text
moduleName, Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Module
-> Const (First Text) (Inspected ModuleLocation a Module)
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> Inspected ModuleLocation a Module
 -> Const (First Text) (Inspected ModuleLocation a Module))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Module) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
installedModuleName],
			Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting
     (First (Maybe Text))
     (Inspected ModuleLocation a Module)
     (Maybe Text)
-> Maybe (Maybe Text)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Module -> Const (First (Maybe Text)) Module)
-> Inspected ModuleLocation a Module
-> Const (First (Maybe Text)) (Inspected ModuleLocation a Module)
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Module -> Const (First (Maybe Text)) Module)
 -> Inspected ModuleLocation a Module
 -> Const (First (Maybe Text)) (Inspected ModuleLocation a Module))
-> ((Maybe Text -> Const (First (Maybe Text)) (Maybe Text))
    -> Module -> Const (First (Maybe Text)) Module)
-> Getting
     (First (Maybe Text))
     (Inspected ModuleLocation a Module)
     (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (First (Maybe Text)) (Maybe Text))
-> Module -> Const (First (Maybe Text)) Module
Lens' Module (Maybe Text)
moduleDocs,
			([Fixity] -> ByteString) -> Maybe [Fixity] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Fixity] -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Maybe [Fixity] -> Maybe ByteString)
-> Maybe [Fixity] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting
     (First [Fixity]) (Inspected ModuleLocation a Module) [Fixity]
-> Maybe [Fixity]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Module -> Const (First [Fixity]) Module)
-> Inspected ModuleLocation a Module
-> Const (First [Fixity]) (Inspected ModuleLocation a Module)
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Module -> Const (First [Fixity]) Module)
 -> Inspected ModuleLocation a Module
 -> Const (First [Fixity]) (Inspected ModuleLocation a Module))
-> (([Fixity] -> Const (First [Fixity]) [Fixity])
    -> Module -> Const (First [Fixity]) Module)
-> Getting
     (First [Fixity]) (Inspected ModuleLocation a Module) [Fixity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Fixity] -> Const (First [Fixity]) [Fixity])
-> Module -> Const (First [Fixity]) Module
Lens' Module [Fixity]
moduleFixities,
			Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Set a -> Value
forall a. Display a => Set a -> Value
asDict (Set a -> Value) -> Set a -> Value
forall a b. (a -> b) -> a -> b
$ Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting (Set a) (Inspected ModuleLocation a Module) (Set a)
-> Set a
forall s a. s -> Getting a s a -> a
^. Getting (Set a) (Inspected ModuleLocation a Module) (Set a)
forall k1 t a t2.
Lens (Inspected k1 t a) (Inspected k1 t2 a) (Set t) (Set t2)
inspectionTags,
			(HsDevError -> String) -> Maybe HsDevError -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsDevError -> String
forall a. Show a => a -> String
show (Maybe HsDevError -> Maybe String)
-> Maybe HsDevError -> Maybe String
forall a b. (a -> b) -> a -> b
$ Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting
     (First HsDevError) (Inspected ModuleLocation a Module) HsDevError
-> Maybe HsDevError
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Either HsDevError Module
 -> Const (First HsDevError) (Either HsDevError Module))
-> Inspected ModuleLocation a Module
-> Const (First HsDevError) (Inspected ModuleLocation a Module)
forall k1 t a a2.
Lens
  (Inspected k1 t a)
  (Inspected k1 t a2)
  (Either HsDevError a)
  (Either HsDevError a2)
inspectionResult ((Either HsDevError Module
  -> Const (First HsDevError) (Either HsDevError Module))
 -> Inspected ModuleLocation a Module
 -> Const (First HsDevError) (Inspected ModuleLocation a Module))
-> ((HsDevError -> Const (First HsDevError) HsDevError)
    -> Either HsDevError Module
    -> Const (First HsDevError) (Either HsDevError Module))
-> Getting
     (First HsDevError) (Inspected ModuleLocation a Module) HsDevError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsDevError -> Const (First HsDevError) HsDevError)
-> Either HsDevError Module
-> Const (First HsDevError) (Either HsDevError Module)
forall a c b. Prism (Either a c) (Either b c) a b
_Left)
			(Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
 Maybe String)
-> Inspection
-> (Maybe Text, Maybe (Maybe Text), Maybe ByteString, ByteString,
    Maybe String)
   :. Inspection
forall h t. h -> t -> h :. t
:.
			Inspection -> Maybe Inspection -> Inspection
forall a. a -> Maybe a -> a
fromMaybe Inspection
InspectionNone (Inspected ModuleLocation a Module
im Inspected ModuleLocation a Module
-> Getting
     (First Inspection) (Inspected ModuleLocation a Module) Inspection
-> Maybe Inspection
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First Inspection) (Inspected ModuleLocation a Module) Inspection
forall k1 t a. Lens' (Inspected k1 t a) Inspection
inspection)
		asDict :: Set a -> Value
asDict Set a
tags = [(Text, Value)] -> Value
object [String -> Text
forall a. IsString a => String -> a
fromString (a -> String
forall a. Display a => a -> String
Display.display a
t) Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True | a
t <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
tags]

lookupModuleLocation :: SessionMonad m => ModuleLocation -> m (Maybe Int)
lookupModuleLocation :: ModuleLocation -> m (Maybe Int)
lookupModuleLocation ModuleLocation
m = do
	[Only Int]
mids <- Query -> [NamedParam] -> m [Only Int]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> [NamedParam] -> m [r]
queryNamed Query
"select id from modules where (file = :file) or (package_name = :package_name and package_version = :package_version and installed_name = :installed_name) or (other_location = :other_location);" [
		Text
":file" Text -> Maybe String -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleLocation
m ModuleLocation
-> ((String -> Const (First String) String)
    -> ModuleLocation -> Const (First String) ModuleLocation)
-> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Text -> Const (First String) Text)
-> ModuleLocation -> Const (First String) ModuleLocation
Traversal' ModuleLocation Text
moduleFile ((Text -> Const (First String) Text)
 -> ModuleLocation -> Const (First String) ModuleLocation)
-> ((String -> Const (First String) String)
    -> Text -> Const (First String) Text)
-> (String -> Const (First String) String)
-> ModuleLocation
-> Const (First String) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> Text -> Const (First String) Text
Lens' Text String
path,
		Text
":package_name" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleLocation
m ModuleLocation
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageName,
		Text
":package_version" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleLocation
m ModuleLocation
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageVersion,
		Text
":installed_name" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleLocation
m ModuleLocation
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
installedModuleName,
		Text
":other_location" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleLocation
m ModuleLocation
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
otherLocationName]
	Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Only Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Only Int]
mids Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Warning  (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"different modules with location: {}" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModuleLocation -> String
forall a. Display a => a -> String
Display.display ModuleLocation
m
	Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int)) -> Maybe Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int
mid | Only Int
mid <- [Only Int]
mids]

lookupModule :: SessionMonad m => ModuleId -> m (Maybe Int)
lookupModule :: ModuleId -> m (Maybe Int)
lookupModule ModuleId
m = do
	[Only Int]
mids <- Query -> [NamedParam] -> m [Only Int]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> [NamedParam] -> m [r]
queryNamed Query
"select id from modules where ((name is null and :name is null) or name = :name) and ((file = :file) or (package_name = :package_name and package_version = :package_version and installed_name = :installed_name) or (other_location = :other_location));" [
		Text
":name" Text -> Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleId
m ModuleId -> Getting Text ModuleId Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ModuleId Text
Lens' ModuleId Text
moduleName,
		Text
":file" Text -> Maybe String -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleId
m ModuleId -> Getting (First String) ModuleId String -> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First String) ModuleLocation)
-> ModuleId -> Const (First String) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First String) ModuleLocation)
 -> ModuleId -> Const (First String) ModuleId)
-> ((String -> Const (First String) String)
    -> ModuleLocation -> Const (First String) ModuleLocation)
-> Getting (First String) ModuleId String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First String) Text)
-> ModuleLocation -> Const (First String) ModuleLocation
Traversal' ModuleLocation Text
moduleFile ((Text -> Const (First String) Text)
 -> ModuleLocation -> Const (First String) ModuleLocation)
-> ((String -> Const (First String) String)
    -> Text -> Const (First String) Text)
-> (String -> Const (First String) String)
-> ModuleLocation
-> Const (First String) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> Text -> Const (First String) Text
Lens' Text String
path,
		Text
":package_name" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleId
m ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageName,
		Text
":package_version" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleId
m ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageVersion,
		Text
":installed_name" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleId
m ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
installedModuleName,
		Text
":other_location" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= ModuleId
m ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
otherLocationName]
	Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Only Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Only Int]
mids Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Warning  (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"different modules with same name and location: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (ModuleId
m ModuleId -> Getting Text ModuleId Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ModuleId Text
Lens' ModuleId Text
moduleName)
	Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int)) -> Maybe Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int
mid | Only Int
mid <- [Only Int]
mids]

lookupSymbol :: SessionMonad m => Int -> SymbolId -> m (Maybe Int)
lookupSymbol :: Int -> SymbolId -> m (Maybe Int)
lookupSymbol Int
mid SymbolId
sym = do
	[Only Int]
sids <- Query -> (Text, Int) -> m [Only Int]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query Query
"select id from symbols where name == ? and module_id == ?;" (
		SymbolId
sym SymbolId -> Getting Text SymbolId Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SymbolId Text
Lens' SymbolId Text
symbolName,
		Int
mid)
	Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Only Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Only Int]
sids Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"different symbols with same module id: {}.{}" Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Int -> String
forall a. Show a => a -> String
show Int
mid Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (SymbolId
sym SymbolId -> Getting Text SymbolId Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SymbolId Text
Lens' SymbolId Text
symbolName)
	Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int)) -> Maybe Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int
sid | Only Int
sid <- [Only Int]
sids]

lastRow :: SessionMonad m => m Int
lastRow :: m Int
lastRow = do
	[Only Int
i] <- Query -> m [Only Int]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> m [r]
query_ Query
"select last_insert_rowid();"
	Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

loadModule :: SessionMonad m => Int -> m Module
loadModule :: Int -> m Module
loadModule Int
mid = Text -> m Module -> m Module
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"load-module" (m Module -> m Module) -> m Module -> m Module
forall a b. (a -> b) -> a -> b
$ do
	[ModuleId :. (Maybe Text, Maybe Value, Int)]
ms <- Query -> Only Int -> m [ModuleId :. (Maybe Text, Maybe Value, Int)]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(ModuleId :. (Maybe Text, Maybe Value, Int))
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
			Select Text
qModuleId,
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"mu.docs", Text
"mu.fixities", Text
"mu.id"],
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [String -> Text
forall a. IsString a => String -> a
fromString String
"mu.id == ?"]])
		(Int -> Only Int
forall a. a -> Only a
Only Int
mid)
	case [ModuleId :. (Maybe Text, Maybe Value, Int)]
ms of
		[] -> Text -> m Module
forall (m :: * -> *) a. SessionMonad m => Text -> m a
sqlFailure (Text -> m Module) -> Text -> m Module
forall a b. (a -> b) -> a -> b
$ Format
"module with id {} not found" Format -> Int -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Int
mid
		mods :: [ModuleId :. (Maybe Text, Maybe Value, Int)]
mods@((ModuleId
mid' :. (Maybe Text
mdocs, Maybe Value
mfixities, Int
_)):[ModuleId :. (Maybe Text, Maybe Value, Int)]
_) -> do
			Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ModuleId :. (Maybe Text, Maybe Value, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleId :. (Maybe Text, Maybe Value, Int)]
mods Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"multiple modules with same id = {} found" Format -> Int -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Int
mid
			[Symbol]
syms <- Query -> Only Int -> m [Symbol]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @Symbol
				(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
					Select Text
qSymbol,
					[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"exports as e"],
					[Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"e.module_id == ?", Text
"e.symbol_id == s.id"]])
				(Int -> Only Int
forall a. a -> Only a
Only Int
mid)
			[Import]
imps <- Query -> Only Int -> m [Import]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @Import Query
"select line, column, module_name, qualified, alias from imports where module_id == ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
			Module -> m Module
forall (m :: * -> *) a. Monad m => a -> m a
return Module :: ModuleId
-> Maybe Text
-> [Import]
-> [Symbol]
-> [Fixity]
-> Map Name [Symbol]
-> Maybe Parsed
-> Module
Module {
				_moduleId :: ModuleId
_moduleId = ModuleId
mid',
				_moduleDocs :: Maybe Text
_moduleDocs = Maybe Text
mdocs,
				_moduleImports :: [Import]
_moduleImports = [Import]
imps,
				_moduleExports :: [Symbol]
_moduleExports = [Symbol]
syms,
				_moduleFixities :: [Fixity]
_moduleFixities = [Fixity] -> Maybe [Fixity] -> [Fixity]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Value
mfixities Maybe Value -> (Value -> Maybe [Fixity]) -> Maybe [Fixity]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe [Fixity]
forall a. FromJSON a => Value -> Maybe a
fromJSON'),
				_moduleScope :: Map Name [Symbol]
_moduleScope = Map Name [Symbol]
forall a. Monoid a => a
mempty,
				_moduleSource :: Maybe Parsed
_moduleSource = Maybe Parsed
forall a. Maybe a
Nothing }

loadModules :: (SessionMonad m, ToRow q) => String -> q -> m [Module]
loadModules :: String -> q -> m [Module]
loadModules String
selectExpr q
args = Text -> m [Module] -> m [Module]
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"load-modules" (m [Module] -> m [Module]) -> m [Module] -> m [Module]
forall a b. (a -> b) -> a -> b
$ do
	[ModuleId :. (Maybe Text, Maybe Value, Int)]
ms <- Query -> q -> m [ModuleId :. (Maybe Text, Maybe Value, Int)]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(ModuleId :. (Maybe Text, Maybe Value, Int))
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
			Select Text
qModuleId,
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"mu.docs", Text
"mu.fixities", Text
"mu.id"],
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"mu.id in (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
selectExpr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"]])
		q
args
	[ModuleId :. (Maybe Text, Maybe Value, Int)]
-> ((ModuleId :. (Maybe Text, Maybe Value, Int)) -> m Module)
-> m [Module]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ModuleId :. (Maybe Text, Maybe Value, Int)]
ms (((ModuleId :. (Maybe Text, Maybe Value, Int)) -> m Module)
 -> m [Module])
-> ((ModuleId :. (Maybe Text, Maybe Value, Int)) -> m Module)
-> m [Module]
forall a b. (a -> b) -> a -> b
$ \(ModuleId
mid' :. (Maybe Text
mdocs, Maybe Value
mfixities, Int
mid)) -> do
		[Symbol]
syms <- Query -> Only Int -> m [Symbol]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @Symbol
			(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
				Select Text
qSymbol,
				[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"exports as e"],
				[Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"e.module_id == ?", Text
"e.symbol_id == s.id"]])
			(Int -> Only Int
forall a. a -> Only a
Only Int
mid)
		[Import]
imps <- Query -> Only Int -> m [Import]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @Import Query
"select line, column, module_name, qualified, alias from imports where module_id == ?;" (Int -> Only Int
forall a. a -> Only a
Only Int
mid)
		Module -> m Module
forall (m :: * -> *) a. Monad m => a -> m a
return Module :: ModuleId
-> Maybe Text
-> [Import]
-> [Symbol]
-> [Fixity]
-> Map Name [Symbol]
-> Maybe Parsed
-> Module
Module {
			_moduleId :: ModuleId
_moduleId = ModuleId
mid',
			_moduleDocs :: Maybe Text
_moduleDocs = Maybe Text
mdocs,
			_moduleImports :: [Import]
_moduleImports = [Import]
imps,
			_moduleExports :: [Symbol]
_moduleExports = [Symbol]
syms,
			_moduleFixities :: [Fixity]
_moduleFixities = [Fixity] -> Maybe [Fixity] -> [Fixity]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Value
mfixities Maybe Value -> (Value -> Maybe [Fixity]) -> Maybe [Fixity]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe [Fixity]
forall a. FromJSON a => Value -> Maybe a
fromJSON'),
			_moduleScope :: Map Name [Symbol]
_moduleScope = Map Name [Symbol]
forall a. Monoid a => a
mempty,
			_moduleSource :: Maybe Parsed
_moduleSource = Maybe Parsed
forall a. Maybe a
Nothing }

loadProject :: SessionMonad m => Path -> m Project
loadProject :: Text -> m Project
loadProject Text
cabal = Text -> m Project -> m Project
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"load-project" (m Project -> m Project) -> m Project -> m Project
forall a b. (a -> b) -> a -> b
$ do
	[Only Int :. Project]
projs <- Query -> Only String -> m [Only Int :. Project]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(Only Int :. Project) Query
"select id, name, cabal, version, build_tool, package_db_stack from projects where cabal == ?;" (String -> Only String
forall a. a -> Only a
Only (String -> Only String) -> String -> Only String
forall a b. (a -> b) -> a -> b
$ ((String -> Const String String) -> Text -> Const String Text)
-> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Text -> Const String Text
Lens' Text String
path Text
cabal)
	(Only Int
pid :. Project
proj) <- case [Only Int :. Project]
projs of
		[] -> Text -> m (Only Int :. Project)
forall (m :: * -> *) a. SessionMonad m => Text -> m a
sqlFailure (Text -> m (Only Int :. Project))
-> Text -> m (Only Int :. Project)
forall a b. (a -> b) -> a -> b
$ Format
"project with cabal {} not found" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ((String -> Const String String) -> Text -> Const String Text)
-> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Text -> Const String Text
Lens' Text String
path Text
cabal
		[Only Int :. Project]
_ -> do
			Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Only Int :. Project] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Only Int :. Project]
projs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"multiple projects with same cabal = {} found" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ((String -> Const String String) -> Text -> Const String Text)
-> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Text -> Const String Text
Lens' Text String
path Text
cabal
			(Only Int :. Project) -> m (Only Int :. Project)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Only Int :. Project) -> m (Only Int :. Project))
-> (Only Int :. Project) -> m (Only Int :. Project)
forall a b. (a -> b) -> a -> b
$ [Only Int :. Project] -> Only Int :. Project
forall a. [a] -> a
head [Only Int :. Project]
projs

	[Library]
libs <- Query -> Only Int -> m [Library]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"lib.modules"],
			[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"libraries as lib"],
			Select Text
qBuildInfo,
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [
				Text
"lib.build_info_id == bi.id",
				Text
"lib.project_id == ?"]])
			(Int -> Only Int
forall a. a -> Only a
Only Int
pid)

	[Executable]
exes <- Query -> Only Int -> m [Executable]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"exe.name", Text
"exe.path"],
			[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"executables as exe"],
			Select Text
qBuildInfo,
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [
				Text
"exe.build_info_id == bi.id",
				Text
"exe.project_id == ?"]])
			(Int -> Only Int
forall a. a -> Only a
Only Int
pid)

	[Test]
tests <- Query -> Only Int -> m [Test]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"tst.name", Text
"tst.enabled", Text
"tst.main"],
			[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"tests as tst"],
			Select Text
qBuildInfo,
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [
				Text
"tst.build_info_id == bi.id",
				Text
"tst.project_id == ?"]])
			(Int -> Only Int
forall a. a -> Only a
Only Int
pid)

	Project -> m Project
forall (m :: * -> *) a. Monad m => a -> m a
return (Project -> m Project) -> Project -> m Project
forall a b. (a -> b) -> a -> b
$
		ASetter Project Project (Maybe Library) (Maybe Library)
-> Maybe Library -> Project -> Project
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> Project -> Identity Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
 -> Project -> Identity Project)
-> ((Maybe Library -> Identity (Maybe Library))
    -> Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> ASetter Project Project (Maybe Library) (Maybe Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Identity ProjectDescription)
-> Maybe ProjectDescription -> Identity (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Identity ProjectDescription)
 -> Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> ((Maybe Library -> Identity (Maybe Library))
    -> ProjectDescription -> Identity ProjectDescription)
-> (Maybe Library -> Identity (Maybe Library))
-> Maybe ProjectDescription
-> Identity (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Library -> Identity (Maybe Library))
-> ProjectDescription -> Identity ProjectDescription
Lens' ProjectDescription (Maybe Library)
projectLibrary) ([Library] -> Maybe Library
forall a. [a] -> Maybe a
listToMaybe [Library]
libs) (Project -> Project) -> (Project -> Project) -> Project -> Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		ASetter Project Project [Executable] [Executable]
-> [Executable] -> Project -> Project
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> Project -> Identity Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
 -> Project -> Identity Project)
-> (([Executable] -> Identity [Executable])
    -> Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> ASetter Project Project [Executable] [Executable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Identity ProjectDescription)
-> Maybe ProjectDescription -> Identity (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Identity ProjectDescription)
 -> Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> (([Executable] -> Identity [Executable])
    -> ProjectDescription -> Identity ProjectDescription)
-> ([Executable] -> Identity [Executable])
-> Maybe ProjectDescription
-> Identity (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Executable] -> Identity [Executable])
-> ProjectDescription -> Identity ProjectDescription
Lens' ProjectDescription [Executable]
projectExecutables) [Executable]
exes (Project -> Project) -> (Project -> Project) -> Project -> Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		ASetter Project Project [Test] [Test]
-> [Test] -> Project -> Project
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> Project -> Identity Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
 -> Project -> Identity Project)
-> (([Test] -> Identity [Test])
    -> Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> ASetter Project Project [Test] [Test]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Identity ProjectDescription)
-> Maybe ProjectDescription -> Identity (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Identity ProjectDescription)
 -> Maybe ProjectDescription -> Identity (Maybe ProjectDescription))
-> (([Test] -> Identity [Test])
    -> ProjectDescription -> Identity ProjectDescription)
-> ([Test] -> Identity [Test])
-> Maybe ProjectDescription
-> Identity (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Test] -> Identity [Test])
-> ProjectDescription -> Identity ProjectDescription
Lens' ProjectDescription [Test]
projectTests) [Test]
tests (Project -> Project) -> Project -> Project
forall a b. (a -> b) -> a -> b
$
		Project
proj

-- | Update a bunch of modules
updateModules :: SessionMonad m => [InspectedModule] -> m ()
updateModules :: [InspectedModule] -> m ()
updateModules [InspectedModule]
ims = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"update-modules" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	[Int]
ids <- [InspectedModule] -> m [Int]
forall (m :: * -> *).
SessionMonad m =>
[InspectedModule] -> m [Int]
upsertModules [InspectedModule]
ims
	[(Int, InspectedModule)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedModule)] -> m ()
updateModulesSymbols ([(Int, InspectedModule)] -> m ())
-> [(Int, InspectedModule)] -> m ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [InspectedModule] -> [(Int, InspectedModule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ids [InspectedModule]
ims

-- | Update symbols of bunch of modules
updateModulesSymbols :: SessionMonad m => [(Int, InspectedModule)] -> m ()
updateModulesSymbols :: [(Int, InspectedModule)] -> m ()
updateModulesSymbols [(Int, InspectedModule)]
ims = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"update-modules" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m () -> m ()
forall (m :: * -> *) a. MonadLog m => Text -> m a -> m a
timer Text
"updated modules" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m () -> m () -> m ()
forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_ m ()
forall (m :: * -> *). SessionMonad m => m ()
initTemps m ()
forall (m :: * -> *). SessionMonad m => m ()
dropTemps (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	[(Int, InspectedModule)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedModule)] -> m ()
initUpdatedIds [(Int, InspectedModule)]
ims

	m ()
forall (m :: * -> *). SessionMonad m => m ()
removeModulesContents
	TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [(Int, InspectedModule)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedModule)] -> m ()
insertModulesDefs [(Int, InspectedModule)]
ims
	TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [(Int, InspectedModule)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedModule)] -> m ()
insertModulesExports [(Int, InspectedModule)]
ims
	where
		initTemps :: SessionMonad m => m ()
		initTemps :: m ()
initTemps = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create temporary table updated_ids (id integer not null, cabal text, module text not null, only_header int not null, dirty int not null);"

		dropTemps :: SessionMonad m => m ()
		dropTemps :: m ()
dropTemps = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"drop table if exists updated_ids;" 

		initUpdatedIds :: SessionMonad m => [(Int, InspectedModule)] -> m ()
		initUpdatedIds :: [(Int, InspectedModule)] -> m ()
initUpdatedIds [(Int, InspectedModule)]
imods = TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create unique index updated_ids_id_index on updated_ids (id);"
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create index updated_ids_module_index on updated_ids (module);"
			Query -> [(Int, Maybe Text, Text, Bool, Bool)] -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into updated_ids (id, cabal, module, only_header, dirty) values (?, ?, ?, ?, ?);" ([(Int, Maybe Text, Text, Bool, Bool)] -> m ())
-> [(Int, Maybe Text, Text, Bool, Bool)] -> m ()
forall a b. (a -> b) -> a -> b
$ do
				(Int
mid, InspectedModule
im) <- [(Int, InspectedModule)]
imods
				(Int, Maybe Text, Text, Bool, Bool)
-> [(Int, Maybe Text, Text, Bool, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return (
					Int
mid,
					InspectedModule
im InspectedModule
-> Getting (First Text) InspectedModule Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> InspectedModule -> Const (First Text) InspectedModule
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> InspectedModule -> Const (First Text) InspectedModule)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) InspectedModule Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Project -> Const (First Text) (Maybe Project))
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation (Maybe Project)
moduleProject ((Maybe Project -> Const (First Text) (Maybe Project))
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> Maybe Project -> Const (First Text) (Maybe Project))
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Project -> Const (First Text) Project)
-> Maybe Project -> Const (First Text) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Project -> Const (First Text) Project)
 -> Maybe Project -> Const (First Text) (Maybe Project))
-> ((Text -> Const (First Text) Text)
    -> Project -> Const (First Text) Project)
-> (Text -> Const (First Text) Text)
-> Maybe Project
-> Const (First Text) (Maybe Project)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Project -> Const (First Text) Project
Lens' Project Text
projectCabal,
					InspectedModule
im InspectedModule -> Getting (Endo Text) InspectedModule Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Module -> Const (Endo Text) Module)
-> InspectedModule -> Const (Endo Text) InspectedModule
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Module -> Const (Endo Text) Module)
 -> InspectedModule -> Const (Endo Text) InspectedModule)
-> ((Text -> Const (Endo Text) Text)
    -> Module -> Const (Endo Text) Module)
-> Getting (Endo Text) InspectedModule Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const (Endo Text) ModuleId)
-> Module -> Const (Endo Text) Module
Lens' Module ModuleId
moduleId ((ModuleId -> Const (Endo Text) ModuleId)
 -> Module -> Const (Endo Text) Module)
-> ((Text -> Const (Endo Text) Text)
    -> ModuleId -> Const (Endo Text) ModuleId)
-> (Text -> Const (Endo Text) Text)
-> Module
-> Const (Endo Text) Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> ModuleId -> Const (Endo Text) ModuleId
Lens' ModuleId Text
moduleName,
					ModuleTag -> InspectedModule -> Bool
forall t i a. Ord t => t -> Inspected i t a -> Bool
hasTag ModuleTag
OnlyHeaderTag InspectedModule
im,
					ModuleTag -> InspectedModule -> Bool
forall t i a. Ord t => t -> Inspected i t a -> Bool
hasTag ModuleTag
DirtyTag InspectedModule
im)

		removeModulesContents :: SessionMonad m => m ()
		removeModulesContents :: m ()
removeModulesContents = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"remove-modules-contents" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
			TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
				Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from symbols where module_id in (select id from updated_ids where not only_header or not dirty);"
				Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"update symbols set line = null, column = null where module_id in (select id from updated_ids where only_header and dirty);"
				Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from imports where module_id in (select id from updated_ids);"
				Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from exports where module_id in (select id from updated_ids);"

			TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from scopes where module_id in (select id from updated_ids);"
			TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from names where module_id in (select id from updated_ids);"
			TransactionType -> m () -> m ()
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Immediate (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from types where module_id in (select id from updated_ids);"

		insertModulesDefs :: SessionMonad m => [(Int, InspectedModule)] -> m ()
		insertModulesDefs :: [(Int, InspectedModule)] -> m ()
insertModulesDefs [(Int, InspectedModule)]
imods = Query
-> [(Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into symbols (name, module_id, docs, line, column, what, type, parent, constructors, args, context, associate, pat_type, pat_constructor) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" ([(Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo]
 -> m ())
-> [(Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo]
-> m ()
forall a b. (a -> b) -> a -> b
$ do
			(Int
mid, InspectedModule
im) <- [(Int, InspectedModule)]
imods
			Module
m <- InspectedModule
im InspectedModule
-> Getting (Endo [Module]) InspectedModule Module -> [Module]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Module]) InspectedModule Module
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected
			Symbol
sym <- Module
m Module -> Getting [Symbol] Module [Symbol] -> [Symbol]
forall s a. s -> Getting a s a -> a
^. Getting [Symbol] Module [Symbol]
Lens' Module [Symbol]
moduleExports
			Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Symbol
sym Symbol -> Getting ModuleId Symbol ModuleId -> ModuleId
forall s a. s -> Getting a s a -> a
^. (SymbolId -> Const ModuleId SymbolId)
-> Symbol -> Const ModuleId Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const ModuleId SymbolId)
 -> Symbol -> Const ModuleId Symbol)
-> ((ModuleId -> Const ModuleId ModuleId)
    -> SymbolId -> Const ModuleId SymbolId)
-> Getting ModuleId Symbol ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const ModuleId ModuleId)
-> SymbolId -> Const ModuleId SymbolId
Lens' SymbolId ModuleId
symbolModule ModuleId -> ModuleId -> Bool
forall a. Eq a => a -> a -> Bool
== Module
m Module -> Getting ModuleId Module ModuleId -> ModuleId
forall s a. s -> Getting a s a -> a
^. Getting ModuleId Module ModuleId
Lens' Module ModuleId
moduleId)
			((Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo)
-> [(Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return (((Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo)
 -> [(Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo])
-> ((Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo)
-> [(Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo]
forall a b. (a -> b) -> a -> b
$ (
				Symbol
sym Symbol -> Getting Text Symbol Text -> Text
forall s a. s -> Getting a s a -> a
^. (SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol)
-> Getting Text SymbolId Text -> Getting Text Symbol Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text SymbolId Text
Lens' SymbolId Text
symbolName,
				Int
mid,
				Symbol
sym Symbol -> Getting (Maybe Text) Symbol (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Symbol (Maybe Text)
Lens' Symbol (Maybe Text)
symbolDocs,
				Symbol
sym Symbol -> Getting (First Int) Symbol Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe Position -> Const (First Int) (Maybe Position))
-> Symbol -> Const (First Int) Symbol
Lens' Symbol (Maybe Position)
symbolPosition ((Maybe Position -> Const (First Int) (Maybe Position))
 -> Symbol -> Const (First Int) Symbol)
-> ((Int -> Const (First Int) Int)
    -> Maybe Position -> Const (First Int) (Maybe Position))
-> Getting (First Int) Symbol Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const (First Int) Position)
-> Maybe Position -> Const (First Int) (Maybe Position)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Position -> Const (First Int) Position)
 -> Maybe Position -> Const (First Int) (Maybe Position))
-> ((Int -> Const (First Int) Int)
    -> Position -> Const (First Int) Position)
-> (Int -> Const (First Int) Int)
-> Maybe Position
-> Const (First Int) (Maybe Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Position -> Const (First Int) Position
Lens' Position Int
positionLine,
				Symbol
sym Symbol -> Getting (First Int) Symbol Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe Position -> Const (First Int) (Maybe Position))
-> Symbol -> Const (First Int) Symbol
Lens' Symbol (Maybe Position)
symbolPosition ((Maybe Position -> Const (First Int) (Maybe Position))
 -> Symbol -> Const (First Int) Symbol)
-> ((Int -> Const (First Int) Int)
    -> Maybe Position -> Const (First Int) (Maybe Position))
-> Getting (First Int) Symbol Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const (First Int) Position)
-> Maybe Position -> Const (First Int) (Maybe Position)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Position -> Const (First Int) Position)
 -> Maybe Position -> Const (First Int) (Maybe Position))
-> ((Int -> Const (First Int) Int)
    -> Position -> Const (First Int) Position)
-> (Int -> Const (First Int) Int)
-> Maybe Position
-> Const (First Int) (Maybe Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Position -> Const (First Int) Position
Lens' Position Int
positionColumn)
				(Text, Int, Maybe Text, Maybe Int, Maybe Int)
-> SymbolInfo
-> (Text, Int, Maybe Text, Maybe Int, Maybe Int) :. SymbolInfo
forall h t. h -> t -> h :. t
:. (Symbol
sym Symbol -> Getting SymbolInfo Symbol SymbolInfo -> SymbolInfo
forall s a. s -> Getting a s a -> a
^. Getting SymbolInfo Symbol SymbolInfo
Lens' Symbol SymbolInfo
symbolInfo)

		insertModulesExports :: SessionMonad m => [(Int, InspectedModule)] -> m ()
		insertModulesExports :: [(Int, InspectedModule)] -> m ()
insertModulesExports [(Int, InspectedModule)]
imods = Query
-> [Only Int
    :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
        :. (Text, String))]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into exports (module_id, symbol_id) select ?, s.id from modules as m, symbols as s where ((? = m.file) or (? = m.package_name and ? = m.package_version and ? = m.installed_name) or (? = m.other_location)) and s.module_id = m.id and ? = s.name and ? = s.what;" ([Only Int
  :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
      :. (Text, String))]
 -> m ())
-> [Only Int
    :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
        :. (Text, String))]
-> m ()
forall a b. (a -> b) -> a -> b
$ do
			(Int
mid, InspectedModule
im) <- [(Int, InspectedModule)]
imods
			Module
m <- InspectedModule
im InspectedModule
-> Getting (Endo [Module]) InspectedModule Module -> [Module]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Module]) InspectedModule Module
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected
			Symbol
sym <- Module
m Module -> Getting [Symbol] Module [Symbol] -> [Symbol]
forall s a. s -> Getting a s a -> a
^. Getting [Symbol] Module [Symbol]
Lens' Module [Symbol]
moduleExports
			(Only Int
 :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
     :. (Text, String)))
-> [Only Int
    :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
        :. (Text, String))]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Only Int
  :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
      :. (Text, String)))
 -> [Only Int
     :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
         :. (Text, String))])
-> (Only Int
    :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
        :. (Text, String)))
-> [Only Int
    :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
        :. (Text, String))]
forall a b. (a -> b) -> a -> b
$
				(Int -> Only Int
forall a. a -> Only a
Only Int
mid) Only Int
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    :. (Text, String))
-> Only Int
   :. ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
       :. (Text, String))
forall h t. h -> t -> h :. t
:.
				ModuleId
-> (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
mkLocationId (Symbol
sym Symbol -> Getting ModuleId Symbol ModuleId -> ModuleId
forall s a. s -> Getting a s a -> a
^. (SymbolId -> Const ModuleId SymbolId)
-> Symbol -> Const ModuleId Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const ModuleId SymbolId)
 -> Symbol -> Const ModuleId Symbol)
-> ((ModuleId -> Const ModuleId ModuleId)
    -> SymbolId -> Const ModuleId SymbolId)
-> Getting ModuleId Symbol ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const ModuleId ModuleId)
-> SymbolId -> Const ModuleId SymbolId
Lens' SymbolId ModuleId
symbolModule) (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> (Text, String)
-> (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
   :. (Text, String)
forall h t. h -> t -> h :. t
:.
				(Symbol
sym Symbol -> Getting Text Symbol Text -> Text
forall s a. s -> Getting a s a -> a
^. (SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol)
-> Getting Text SymbolId Text -> Getting Text Symbol Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text SymbolId Text
Lens' SymbolId Text
symbolName, Symbol -> String
symbolType Symbol
sym)

		mkLocationId :: ModuleId
-> (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
mkLocationId ModuleId
m' = (
			ModuleId
m' ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
moduleFile,
			ModuleId
m' ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageName,
			ModuleId
m' ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> Const (First Text) ModulePackage)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation ModulePackage
modulePackage ((ModulePackage -> Const (First Text) ModulePackage)
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> ModulePackage -> Const (First Text) ModulePackage)
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModulePackage -> Const (First Text) ModulePackage
Lens' ModulePackage Text
packageVersion,
			ModuleId
m' ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
installedModuleName,
			ModuleId
m' ModuleId
-> ((Text -> Const (First Text) Text)
    -> ModuleId -> Const (First Text) ModuleId)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> (Text -> Const (First Text) Text)
-> ModuleId
-> Const (First Text) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
otherLocationName)


escapeLike :: Text -> Text
escapeLike :: Text -> Text
escapeLike = Text -> Text -> Text -> Text
T.replace Text
"%" Text
"\\%" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"_" Text
"\\_" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"

-- Util

sqlFailure :: SessionMonad m => Text -> m a
sqlFailure :: Text -> m a
sqlFailure Text
msg = do
	Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
sendLog Level
Error Text
msg
	HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a) -> HsDevError -> m a
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
SQLiteError (String -> HsDevError) -> String -> HsDevError
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
msg

lookupId :: SessionMonad m => ModuleLocation -> m Int
lookupId :: ModuleLocation -> m Int
lookupId = ModuleLocation -> m (Maybe Int)
forall (m :: * -> *).
SessionMonad m =>
ModuleLocation -> m (Maybe Int)
lookupModuleLocation (ModuleLocation -> m (Maybe Int))
-> (Maybe Int -> m Int) -> ModuleLocation -> m Int
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> m Int -> (Int -> m Int) -> Maybe Int -> m Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Int
forall a. m a
err Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return where
	err :: m a
err = HsDevError -> m a
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m a) -> HsDevError -> m a
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
SQLiteError String
"module not exist in db"