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

module HsDev.Inspect.Resolve (
	-- * Prepare
	loadEnv, saveEnv,
	loadEnvironment, loadFixities, withEnv,
	-- * Resolving
	resolveModule, resolvePreloaded, resolve,
	-- * Saving results
	updateResolveds
	) where

import Control.Lens hiding ((.=))
import Control.Monad.Catch
import Data.Aeson
import Data.Generics.Uniplate.Operations
import Data.Functor
import Data.Function
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Ord
import Data.String
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Language.Haskell.Exts as H
import qualified Language.Haskell.Names as N
import qualified Language.Haskell.Names.Open as N
import qualified Language.Haskell.Names.Annotated as N
import qualified Language.Haskell.Names.Imports as N
import qualified Language.Haskell.Names.Exports as N
import qualified Language.Haskell.Names.ModuleSymbols as N
import qualified Language.Haskell.Names.SyntaxUtils as N
import System.Log.Simple
import Text.Format

import Data.LookupTable
import System.Directory.Paths
import HsDev.Database.SQLite as SQLite
import qualified HsDev.Display as Display
import HsDev.Error
import HsDev.Inspect.Definitions
import HsDev.Inspect.Types
import HsDev.Symbols
import qualified HsDev.Symbols.HaskellNames as HN
import HsDev.Symbols.Parsed as P
import HsDev.Server.Types
import HsDev.Util

-- | Try resolve module symbols
resolveModule :: MonadThrow m => Environment -> FixitiesTable -> Preloaded -> InspectM ModuleLocation ModuleTag m Resolved
resolveModule :: Environment
-> FixitiesTable
-> Preloaded
-> InspectM ModuleLocation ModuleTag m Resolved
resolveModule Environment
env FixitiesTable
fixities Preloaded
p = ModuleTag
-> InspectM ModuleLocation ModuleTag m Resolved
-> InspectM ModuleLocation ModuleTag m Resolved
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
t -> InspectM k t m a -> InspectM k t m a
inspectTag ModuleTag
ResolvedNamesTag (InspectM ModuleLocation ModuleTag m Resolved
 -> InspectM ModuleLocation ModuleTag m Resolved)
-> InspectM ModuleLocation ModuleTag m Resolved
-> InspectM ModuleLocation ModuleTag m Resolved
forall a b. (a -> b) -> a -> b
$ ModuleTag
-> InspectM ModuleLocation ModuleTag m Resolved
-> InspectM ModuleLocation ModuleTag m Resolved
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
t -> InspectM k t m a -> InspectM k t m a
inspectUntag ModuleTag
OnlyHeaderTag (InspectM ModuleLocation ModuleTag m Resolved
 -> InspectM ModuleLocation ModuleTag m Resolved)
-> InspectM ModuleLocation ModuleTag m Resolved
-> InspectM ModuleLocation ModuleTag m Resolved
forall a b. (a -> b) -> a -> b
$ case ParseMode -> String -> ParseResult (Module SrcSpanInfo)
H.parseFileContentsWithMode (Preloaded
p' Preloaded -> Getting ParseMode Preloaded ParseMode -> ParseMode
forall s a. s -> Getting a s a -> a
^. Getting ParseMode Preloaded ParseMode
Lens' Preloaded ParseMode
preloadedMode) (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Preloaded
p Preloaded -> Getting Text Preloaded Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Preloaded Text
Lens' Preloaded Text
preloaded) of
	H.ParseFailed SrcLoc
loc String
reason -> HsDevError -> InspectM ModuleLocation ModuleTag m Resolved
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> InspectM ModuleLocation ModuleTag m Resolved)
-> HsDevError -> InspectM ModuleLocation ModuleTag m Resolved
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
InspectError (String -> HsDevError) -> String -> HsDevError
forall a b. (a -> b) -> a -> b
$ String
"Parse failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Show a => a -> String
show SrcLoc
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reason
	H.ParseOk Module SrcSpanInfo
m -> Resolved -> InspectM ModuleLocation ModuleTag m Resolved
forall (m :: * -> *) a. Monad m => a -> m a
return (Environment -> Module SrcSpanInfo -> Resolved
resolve Environment
env Module SrcSpanInfo
m)
	where
		qimps :: [QName ()]
qimps = Map (QName ()) [Symbol] -> [QName ()]
forall k a. Map k a -> [k]
M.keys (Map (QName ()) [Symbol] -> [QName ()])
-> Map (QName ()) [Symbol] -> [QName ()]
forall a b. (a -> b) -> a -> b
$ Environment -> Module SrcSpanInfo -> Map (QName ()) [Symbol]
forall l. Environment -> Module l -> Map (QName ()) [Symbol]
N.importTable Environment
env (Preloaded
p Preloaded
-> Getting (Module SrcSpanInfo) Preloaded (Module SrcSpanInfo)
-> Module SrcSpanInfo
forall s a. s -> Getting a s a -> a
^. Getting (Module SrcSpanInfo) Preloaded (Module SrcSpanInfo)
Lens' Preloaded (Module SrcSpanInfo)
preloadedModule)
		p' :: Preloaded
p' = Preloaded
p { _preloadedMode :: ParseMode
_preloadedMode = (Preloaded -> ParseMode
_preloadedMode Preloaded
p) { fixities :: Maybe [Fixity]
H.fixities = [Fixity] -> Maybe [Fixity]
forall a. a -> Maybe a
Just ((QName () -> Maybe Fixity) -> [QName ()] -> [Fixity]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (QName () -> FixitiesTable -> Maybe Fixity
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` FixitiesTable
fixities) [QName ()]
qimps) } }

-- | Resolve just preloaded part of module, this will give imports and scope
resolvePreloaded :: MonadThrow m => Environment -> Preloaded -> InspectM ModuleLocation ModuleTag m Resolved
resolvePreloaded :: Environment
-> Preloaded -> InspectM ModuleLocation ModuleTag m Resolved
resolvePreloaded Environment
env = ModuleTag
-> InspectM ModuleLocation ModuleTag m Resolved
-> InspectM ModuleLocation ModuleTag m Resolved
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
t -> InspectM k t m a -> InspectM k t m a
inspectTag ModuleTag
ResolvedNamesTag (InspectM ModuleLocation ModuleTag m Resolved
 -> InspectM ModuleLocation ModuleTag m Resolved)
-> (Preloaded -> InspectM ModuleLocation ModuleTag m Resolved)
-> Preloaded
-> InspectM ModuleLocation ModuleTag m Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Resolved -> InspectM ModuleLocation ModuleTag m Resolved
forall (m :: * -> *) a. Monad m => a -> m a
return (Resolved -> InspectM ModuleLocation ModuleTag m Resolved)
-> (Preloaded -> Resolved)
-> Preloaded
-> InspectM ModuleLocation ModuleTag m Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Module SrcSpanInfo -> Resolved
resolve Environment
env (Module SrcSpanInfo -> Resolved)
-> (Preloaded -> Module SrcSpanInfo) -> Preloaded -> Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Module SrcSpanInfo) Preloaded (Module SrcSpanInfo)
-> Preloaded -> Module SrcSpanInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Module SrcSpanInfo) Preloaded (Module SrcSpanInfo)
Lens' Preloaded (Module SrcSpanInfo)
preloadedModule

-- | Resolve parsed module
resolve :: Environment -> H.Module H.SrcSpanInfo -> Resolved
resolve :: Environment -> Module SrcSpanInfo -> Resolved
resolve Environment
env Module SrcSpanInfo
m = Resolved :: ModuleName ()
-> Parsed
-> [Symbol]
-> [Import]
-> [Symbol]
-> Map (QName ()) [Symbol]
-> [Fixity]
-> Resolved
Resolved {
	_resolvedModule :: ModuleName ()
_resolvedModule = ModuleName SrcSpanInfo -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ModuleName SrcSpanInfo
mn,
	_resolvedSource :: Parsed
_resolvedSource = Parsed
annotated,
	_resolvedDefs :: [Symbol]
_resolvedDefs = [Decl Ann] -> [Symbol]
getSymbols [Decl Ann]
decls',
	_resolvedImports :: [Import]
_resolvedImports = (ImportDecl Ann -> Import) -> [ImportDecl Ann] -> [Import]
forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl SrcSpanInfo -> Import
toImport (ImportDecl SrcSpanInfo -> Import)
-> (ImportDecl Ann -> ImportDecl SrcSpanInfo)
-> ImportDecl Ann
-> Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl Ann -> ImportDecl SrcSpanInfo
forall (f :: * -> *) l. Functor f => f (Scoped l) -> f l
dropScope) [ImportDecl Ann]
idecls',
	_resolvedExports :: [Symbol]
_resolvedExports = Map (QName ()) [Symbol] -> Module SrcSpanInfo -> [Symbol]
forall l.
(Data l, Eq l) =>
Map (QName ()) [Symbol] -> Module l -> [Symbol]
N.exportedSymbols Map (QName ()) [Symbol]
tbl Module SrcSpanInfo
m,
	_resolvedScope :: Map (QName ()) [Symbol]
_resolvedScope = Map (QName ()) [Symbol]
tbl,
	_resolvedFixities :: [Fixity]
_resolvedFixities = [Assoc () -> Int -> QName () -> Fixity
H.Fixity (Assoc Ann -> Assoc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Assoc Ann
assoc) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
pr) (Name Ann -> QName ()
forall a. Name a -> QName ()
fixName Name Ann
opName)
		| H.InfixDecl Ann
_ Assoc Ann
assoc Maybe Int
pr [Op Ann]
ops <- [Decl Ann]
decls', Name Ann
opName <- (Op Ann -> Name Ann) -> [Op Ann] -> [Name Ann]
forall a b. (a -> b) -> [a] -> [b]
map Op Ann -> Name Ann
forall l. Op l -> Name l
getOpName [Op Ann]
ops] }
	where
		getOpName :: Op l -> Name l
getOpName (H.VarOp l
_ Name l
nm) = Name l
nm
		getOpName (H.ConOp l
_ Name l
nm) = Name l
nm
		fixName :: Name a -> QName ()
fixName Name a
o = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
H.Qual () (ModuleName SrcSpanInfo -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ModuleName SrcSpanInfo
mn) (Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
o)
		itbl :: Map (QName ()) [Symbol]
itbl = Environment -> Module SrcSpanInfo -> Map (QName ()) [Symbol]
forall l. Environment -> Module l -> Map (QName ()) [Symbol]
N.importTable Environment
env Module SrcSpanInfo
m
		tbl :: Map (QName ()) [Symbol]
tbl = Map (QName ()) [Symbol]
-> Module SrcSpanInfo -> Map (QName ()) [Symbol]
forall l.
(Eq l, Data l) =>
Map (QName ()) [Symbol] -> Module l -> Map (QName ()) [Symbol]
N.moduleTable Map (QName ()) [Symbol]
itbl Module SrcSpanInfo
m
		-- Not using 'annotate' because we already computed needed tables
		annotated :: Parsed
annotated = Ann
-> Maybe (ModuleHead Ann)
-> [ModulePragma Ann]
-> [ImportDecl Ann]
-> [Decl Ann]
-> Parsed
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
H.Module (SrcSpanInfo -> Ann
forall l. l -> Scoped l
noScope SrcSpanInfo
l) Maybe (ModuleHead Ann)
mhead' [ModulePragma Ann]
mpragmas' [ImportDecl Ann]
idecls' [Decl Ann]
decls'
		H.Module SrcSpanInfo
l Maybe (ModuleHead SrcSpanInfo)
mhead [ModulePragma SrcSpanInfo]
mpragmas [ImportDecl SrcSpanInfo]
idecls [Decl SrcSpanInfo]
decls = Module SrcSpanInfo
m
		mhead' :: Maybe (ModuleHead Ann)
mhead' = (ModuleHead SrcSpanInfo -> ModuleHead Ann)
-> Maybe (ModuleHead SrcSpanInfo) -> Maybe (ModuleHead Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleHead SrcSpanInfo -> ModuleHead Ann
forall l. ModuleHead l -> ModuleHead (Scoped l)
scopeHead Maybe (ModuleHead SrcSpanInfo)
mhead
		mpragmas' :: [ModulePragma Ann]
mpragmas' = (ModulePragma SrcSpanInfo -> ModulePragma Ann)
-> [ModulePragma SrcSpanInfo] -> [ModulePragma Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModulePragma SrcSpanInfo -> ModulePragma Ann
forall (f :: * -> *) l. Functor f => f l -> f (Scoped l)
withNoScope [ModulePragma SrcSpanInfo]
mpragmas
		scopeHead :: ModuleHead l -> ModuleHead (Scoped l)
scopeHead (H.ModuleHead l
lh ModuleName l
mname Maybe (WarningText l)
mwarns Maybe (ExportSpecList l)
mexports) = Scoped l
-> ModuleName (Scoped l)
-> Maybe (WarningText (Scoped l))
-> Maybe (ExportSpecList (Scoped l))
-> ModuleHead (Scoped l)
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
H.ModuleHead (l -> Scoped l
forall l. l -> Scoped l
noScope l
lh) (ModuleName l -> ModuleName (Scoped l)
forall (f :: * -> *) l. Functor f => f l -> f (Scoped l)
withNoScope ModuleName l
mname) ((WarningText l -> WarningText (Scoped l))
-> Maybe (WarningText l) -> Maybe (WarningText (Scoped l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WarningText l -> WarningText (Scoped l)
forall (f :: * -> *) l. Functor f => f l -> f (Scoped l)
withNoScope Maybe (WarningText l)
mwarns) (Maybe (ExportSpecList (Scoped l)) -> ModuleHead (Scoped l))
-> Maybe (ExportSpecList (Scoped l)) -> ModuleHead (Scoped l)
forall a b. (a -> b) -> a -> b
$
			(ExportSpecList l -> ExportSpecList (Scoped l))
-> Maybe (ExportSpecList l) -> Maybe (ExportSpecList (Scoped l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map (QName ()) [Symbol]
-> ExportSpecList l -> ExportSpecList (Scoped l)
forall l.
Map (QName ()) [Symbol]
-> ExportSpecList l -> ExportSpecList (Scoped l)
N.annotateExportSpecList Map (QName ()) [Symbol]
tbl) Maybe (ExportSpecList l)
mexports
		idecls' :: [ImportDecl Ann]
idecls' = ModuleName SrcSpanInfo
-> Environment -> [ImportDecl SrcSpanInfo] -> [ImportDecl Ann]
forall l.
ModuleName l
-> Environment -> [ImportDecl l] -> [ImportDecl (Scoped l)]
N.annotateImportDecls ModuleName SrcSpanInfo
mn Environment
env [ImportDecl SrcSpanInfo]
idecls
		decls' :: [Decl Ann]
decls' = (Decl SrcSpanInfo -> Decl Ann) -> [Decl SrcSpanInfo] -> [Decl Ann]
forall a b. (a -> b) -> [a] -> [b]
map (Scope -> Decl SrcSpanInfo -> Decl Ann
forall (a :: * -> *) l.
(Resolvable (a (Scoped l)), Functor a, Typeable l) =>
Scope -> a l -> a (Scoped l)
N.annotateDecl (ModuleName () -> Map (QName ()) [Symbol] -> Scope
N.initialScope (ModuleName SrcSpanInfo -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
N.dropAnn ModuleName SrcSpanInfo
mn) Map (QName ()) [Symbol]
tbl)) [Decl SrcSpanInfo]
decls
		mn :: ModuleName SrcSpanInfo
mn = Module SrcSpanInfo -> ModuleName SrcSpanInfo
forall l. Module l -> ModuleName l
N.getModuleName Module SrcSpanInfo
m

-- | Load environment and fixities from cache or sql
loadEnv :: SessionMonad m => Maybe Path -> m (Environment, FixitiesTable)
loadEnv :: Maybe Text -> m (Environment, FixitiesTable)
loadEnv Maybe Text
mcabal = do
	LookupTable (Maybe Text) (Environment, FixitiesTable)
envTable <- (Session -> LookupTable (Maybe Text) (Environment, FixitiesTable))
-> m (LookupTable (Maybe Text) (Environment, FixitiesTable))
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> LookupTable (Maybe Text) (Environment, FixitiesTable)
sessionResolveEnvironment
	LookupTable (Maybe Text) (Environment, FixitiesTable)
-> Maybe Text
-> m (Environment, FixitiesTable)
-> m (Environment, FixitiesTable)
forall k (m :: * -> *) v.
(Ord k, MonadIO m) =>
LookupTable k v -> k -> m v -> m v
cacheInTableM LookupTable (Maybe Text) (Environment, FixitiesTable)
envTable Maybe Text
mcabal (m (Environment, FixitiesTable) -> m (Environment, FixitiesTable))
-> m (Environment, FixitiesTable) -> m (Environment, FixitiesTable)
forall a b. (a -> b) -> a -> b
$ (,) (Environment -> FixitiesTable -> (Environment, FixitiesTable))
-> m Environment
-> m (FixitiesTable -> (Environment, FixitiesTable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> m Environment
forall (m :: * -> *). SessionMonad m => Maybe Text -> m Environment
loadEnvironment Maybe Text
mcabal m (FixitiesTable -> (Environment, FixitiesTable))
-> m FixitiesTable -> m (Environment, FixitiesTable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> m FixitiesTable
forall (m :: * -> *).
SessionMonad m =>
Maybe Text -> m FixitiesTable
loadFixities Maybe Text
mcabal

-- | Save environment and fixities to cache
saveEnv :: SessionMonad m => Maybe Path -> Environment -> FixitiesTable -> m ()
saveEnv :: Maybe Text -> Environment -> FixitiesTable -> m ()
saveEnv Maybe Text
mcabal Environment
env FixitiesTable
fixities = do
	LookupTable (Maybe Text) (Environment, FixitiesTable)
envTable <- (Session -> LookupTable (Maybe Text) (Environment, FixitiesTable))
-> m (LookupTable (Maybe Text) (Environment, FixitiesTable))
forall (m :: * -> *) a. SessionMonad m => (Session -> a) -> m a
askSession Session -> LookupTable (Maybe Text) (Environment, FixitiesTable)
sessionResolveEnvironment
	m (Environment, FixitiesTable) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Environment, FixitiesTable) -> m ())
-> m (Environment, FixitiesTable) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (Environment, FixitiesTable)
-> LookupTable (Maybe Text) (Environment, FixitiesTable)
-> m (Environment, FixitiesTable)
forall k (m :: * -> *) v.
(Ord k, MonadIO m) =>
k -> v -> LookupTable k v -> m v
insertTable Maybe Text
mcabal (Environment
env, FixitiesTable
fixities) LookupTable (Maybe Text) (Environment, FixitiesTable)
envTable

-- | Load environment from sql
loadEnvironment :: SessionMonad m => Maybe Path -> m Environment
loadEnvironment :: Maybe Text -> m Environment
loadEnvironment Maybe Text
mcabal = TransactionType -> m Environment -> m Environment
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Deferred (m Environment -> m Environment) -> m Environment -> m Environment
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
"loading environment for {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"<standalone>" Maybe Text
mcabal
	[Only (ModuleName ()) :. Symbol]
env <- Query -> Only (Maybe Text) -> m [Only (ModuleName ()) :. Symbol]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(Only (H.ModuleName ()) :. N.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 [
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"em.name"],
			[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"projects_modules_scope as ps", Text
"exports as e", Text
"modules as em"],
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [
				Text
"ps.cabal is ?",
				Text
"ps.module_id = em.id",
				Text
"e.symbol_id = s.id",
				Text
"e.module_id = em.id"],
			Text -> Text -> Select Text
qNSymbol Text
"m" Text
"s"])
		(Maybe Text -> Only (Maybe Text)
forall a. a -> Only a
Only Maybe Text
mcabal)
	Environment -> m Environment
forall (m :: * -> *) a. Monad m => a -> m a
return (Environment -> m Environment) -> Environment -> m Environment
forall a b. (a -> b) -> a -> b
$ [(ModuleName (), [Symbol])] -> Environment
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ModuleName (), [Symbol])] -> Environment)
-> [(ModuleName (), [Symbol])] -> Environment
forall a b. (a -> b) -> a -> b
$ do
		[(ModuleName (), Symbol)]
group' <- ((ModuleName (), Symbol) -> (ModuleName (), Symbol) -> Bool)
-> [(ModuleName (), Symbol)] -> [[(ModuleName (), Symbol)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (ModuleName () -> ModuleName () -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModuleName () -> ModuleName () -> Bool)
-> ((ModuleName (), Symbol) -> ModuleName ())
-> (ModuleName (), Symbol)
-> (ModuleName (), Symbol)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ModuleName (), Symbol) -> ModuleName ()
forall a b. (a, b) -> a
fst) ([(ModuleName (), Symbol)] -> [[(ModuleName (), Symbol)]])
-> ([(ModuleName (), Symbol)] -> [(ModuleName (), Symbol)])
-> [(ModuleName (), Symbol)]
-> [[(ModuleName (), Symbol)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModuleName (), Symbol) -> (ModuleName (), Symbol) -> Ordering)
-> [(ModuleName (), Symbol)] -> [(ModuleName (), Symbol)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((ModuleName (), Symbol) -> ModuleName ())
-> (ModuleName (), Symbol) -> (ModuleName (), Symbol) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ModuleName (), Symbol) -> ModuleName ()
forall a b. (a, b) -> a
fst) ([(ModuleName (), Symbol)] -> [[(ModuleName (), Symbol)]])
-> [(ModuleName (), Symbol)] -> [[(ModuleName (), Symbol)]]
forall a b. (a -> b) -> a -> b
$ [(ModuleName ()
m, Symbol
s) | (Only ModuleName ()
m :. Symbol
s) <- [Only (ModuleName ()) :. Symbol]
env]
		let
			(ModuleName ()
gmod:[ModuleName ()]
_, [Symbol]
gsyms) = [(ModuleName (), Symbol)] -> ([ModuleName ()], [Symbol])
forall a b. [(a, b)] -> ([a], [b])
unzip [(ModuleName (), Symbol)]
group'
		(ModuleName (), [Symbol]) -> [(ModuleName (), [Symbol])]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName ()
gmod, [Symbol]
gsyms)

-- | Load fixities from sql
loadFixities :: SessionMonad m => Maybe Path -> m FixitiesTable
loadFixities :: Maybe Text -> m FixitiesTable
loadFixities Maybe Text
mcabal = TransactionType -> m FixitiesTable -> m FixitiesTable
forall (m :: * -> *) a.
SessionMonad m =>
TransactionType -> m a -> m a
transaction_ TransactionType
Deferred (m FixitiesTable -> m FixitiesTable)
-> m FixitiesTable -> m FixitiesTable
forall a b. (a -> b) -> a -> b
$ do
	[Only Value]
fixities' <- Query -> Only (Maybe Text) -> m [Only Value]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
query @_ @(Only Value)
		(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
"m.fixities"],
			[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"projects_modules_scope as ps", Text
"modules as m"],
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [
				Text
"ps.cabal is ?",
				Text
"ps.module_id = m.id",
				Text
"m.fixities is not null"]])
		(Maybe Text -> Only (Maybe Text)
forall a. a -> Only a
Only Maybe Text
mcabal)
	FixitiesTable -> m FixitiesTable
forall (m :: * -> *) a. Monad m => a -> m a
return (FixitiesTable -> m FixitiesTable)
-> FixitiesTable -> m FixitiesTable
forall a b. (a -> b) -> a -> b
$ [FixitiesTable] -> FixitiesTable
forall a. Monoid a => [a] -> a
mconcat [QName () -> Fixity -> FixitiesTable
forall k a. k -> a -> Map k a
M.singleton QName ()
n Fixity
f |
		f :: Fixity
f@(H.Fixity Assoc ()
_ Int
_ QName ()
n) <- [[Fixity]] -> [Fixity]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Only Value -> Maybe [Fixity]) -> [Only Value] -> [[Fixity]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Value -> Maybe [Fixity]
forall a. FromJSON a => Value -> Maybe a
fromJSON' (Value -> Maybe [Fixity])
-> (Only Value -> Value) -> Only Value -> Maybe [Fixity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Only Value -> Value
forall a. Only a -> a
fromOnly) [Only Value]
fixities')]

-- | Run with temporary table for environment
withEnv :: SessionMonad m => Maybe Path -> m a -> m a
withEnv :: Maybe Text -> m a -> m a
withEnv Maybe Text
mcabal = (m ()
initEnv m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) where
	initEnv :: m ()
initEnv = do
		Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create temporary table if not exists resolve (cabal text);"
		Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create temporary table if not exists env (module text not null, name text not null, what text not null, id integer not null);"
		Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create unique index if not exists env_id_index on env (id);"
		Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create unique index if not exists env_symbol_index on env (module, name, what);"

		[Only (Maybe Text)]
curEnv <- Query -> m [Only (Maybe Text)]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> m [r]
query_ Query
"select cabal from resolve;"
		Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Only (Maybe Text) -> Maybe Text)
-> Maybe (Only (Maybe Text)) -> Maybe (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (Maybe Text) -> Maybe Text
forall a. Only a -> a
fromOnly ([Only (Maybe Text)] -> Maybe (Only (Maybe Text))
forall a. [a] -> Maybe a
listToMaybe [Only (Maybe Text)]
curEnv) Maybe (Maybe Text) -> Maybe (Maybe Text) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
mcabal) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from resolve;"
			Query -> Only (Maybe Text) -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
execute Query
"insert into resolve values (?);" (Maybe Text -> Only (Maybe Text)
forall a. a -> Only a
Only Maybe Text
mcabal)
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"delete from env;"
			Query -> [NamedParam] -> m ()
forall (m :: * -> *).
SessionMonad m =>
Query -> [NamedParam] -> m ()
executeNamed Query
"insert into env select m.name, s.name, s.what, min(s.id) from modules as m, symbols as s where m.id = s.module_id and s.id in (select distinct e.symbol_id from exports as e where e.module_id in (select ps.module_id from projects_modules_scope as ps where ps.cabal is :cabal)) group by m.name, s.name, s.what;" [
				Text
":cabal" Text -> Maybe Text -> NamedParam
forall v. ToField v => Text -> v -> NamedParam
:= Maybe Text
mcabal]

		[Only Int
cnt] <- Query -> m [Only Int]
forall r (m :: * -> *).
(FromRow r, SessionMonad m) =>
Query -> m [r]
query_ @(Only Int) Query
"select count(*) from env;"
		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
"created env table with {} symbols" Format -> Int -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Int
cnt

-- | Save results in sql, updated temporary env table
updateResolveds :: SessionMonad m => Maybe Path -> [InspectedResolved] -> m ()
updateResolveds :: Maybe Text -> [InspectedResolved] -> m ()
updateResolveds Maybe Text
mcabal [InspectedResolved]
ims = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"update-resolveds" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m () -> m ()
forall (m :: * -> *) a. SessionMonad m => Maybe Text -> m a -> m a
withEnv Maybe Text
mcabal (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	[Int]
ids <- [InspectedResolved] -> m [Int]
forall (m :: * -> *).
SessionMonad m =>
[InspectedResolved] -> m [Int]
upsertResolveds [InspectedResolved]
ims
	[(Int, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
updateResolvedsSymbols ([Int] -> [InspectedResolved] -> [(Int, InspectedResolved)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ids [InspectedResolved]
ims)

upsertResolveds :: SessionMonad m => [InspectedResolved] -> m [Int]
upsertResolveds :: [InspectedResolved] -> m [Int]
upsertResolveds [InspectedResolved]
ims = Text -> m [Int] -> m [Int]
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"upsert-resolveds" (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 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 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 Text, Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection)]
-> m ()
forall a b. (a -> b) -> a -> b
$ (InspectedResolved
 -> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
     Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
    :. ((Maybe Text, Maybe Text, Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection))
-> [InspectedResolved]
-> [(Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
     Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
    :. ((Maybe Text, Maybe Text, Maybe ByteString, ByteString,
         Maybe String)
        :. Inspection)]
forall a b. (a -> b) -> [a] -> [b]
map InspectedResolved
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe Text, Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
forall a.
Display a =>
Inspected ModuleLocation a Resolved
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe Text, Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
moduleData [InspectedResolved]
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 Resolved
-> (Maybe String, Maybe Text, Maybe ByteString, Maybe Text,
    Maybe Text, Maybe Text, Maybe Bool, Maybe Text)
   :. ((Maybe Text, Maybe Text, Maybe ByteString, ByteString,
        Maybe String)
       :. Inspection)
moduleData Inspected ModuleLocation a Resolved
im = (
			Inspected ModuleLocation a Resolved
im Inspected ModuleLocation a Resolved
-> Getting
     (First String) (Inspected ModuleLocation a Resolved) String
-> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First String) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First String) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First String) (Inspected ModuleLocation a Resolved))
-> ((String -> Const (First String) String)
    -> ModuleLocation -> Const (First String) ModuleLocation)
-> Getting
     (First String) (Inspected ModuleLocation a Resolved) 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) 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 (Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path)) (Inspected ModuleLocation a Resolved
im Inspected ModuleLocation a Resolved
-> Getting
     (First [Text]) (Inspected ModuleLocation a Resolved) [Text]
-> Maybe [Text]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First [Text]) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First [Text]) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First [Text]) (Inspected ModuleLocation a Resolved))
-> (([Text] -> Const (First [Text]) [Text])
    -> ModuleLocation -> Const (First [Text]) ModuleLocation)
-> Getting
     (First [Text]) (Inspected ModuleLocation a Resolved) [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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Bool) (Inspected ModuleLocation a Resolved) Bool
-> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Bool) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Bool) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Bool) (Inspected ModuleLocation a Resolved))
-> ((Bool -> Const (First Bool) Bool)
    -> ModuleLocation -> Const (First Bool) ModuleLocation)
-> Getting (First Bool) (Inspected ModuleLocation a Resolved) 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) 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 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 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Resolved -> Const (First Text) Resolved)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (First Text) Resolved)
 -> Inspected ModuleLocation a Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> Resolved -> Const (First Text) Resolved)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName () -> Const (First Text) (ModuleName ()))
-> Resolved -> Const (First Text) Resolved
Lens' Resolved (ModuleName ())
resolvedModule ((ModuleName () -> Const (First Text) (ModuleName ()))
 -> Resolved -> Const (First Text) Resolved)
-> ((Text -> Const (First Text) Text)
    -> ModuleName () -> Const (First Text) (ModuleName ()))
-> (Text -> Const (First Text) Text)
-> Resolved
-> Const (First Text) Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleName () -> Const (First Text) (ModuleName ())
Iso' (ModuleName ()) Text
moduleName_, Inspected ModuleLocation a Resolved
im Inspected ModuleLocation a Resolved
-> Getting (First Text) (Inspected ModuleLocation a Resolved) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> Inspected ModuleLocation a Resolved
-> Const (First Text) (Inspected ModuleLocation a Resolved)
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 Resolved
 -> Const (First Text) (Inspected ModuleLocation a Resolved))
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) (Inspected ModuleLocation a Resolved) 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],
			Maybe Text
forall a. Maybe a
Nothing @Text,
			([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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting
     (First [Fixity]) (Inspected ModuleLocation a Resolved) [Fixity]
-> Maybe [Fixity]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Resolved -> Const (First [Fixity]) Resolved)
-> Inspected ModuleLocation a Resolved
-> Const (First [Fixity]) (Inspected ModuleLocation a Resolved)
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (First [Fixity]) Resolved)
 -> Inspected ModuleLocation a Resolved
 -> Const (First [Fixity]) (Inspected ModuleLocation a Resolved))
-> (([Fixity] -> Const (First [Fixity]) [Fixity])
    -> Resolved -> Const (First [Fixity]) Resolved)
-> Getting
     (First [Fixity]) (Inspected ModuleLocation a Resolved) [Fixity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Fixity] -> Const (First [Fixity]) [Fixity])
-> Resolved -> Const (First [Fixity]) Resolved
Lens' Resolved [Fixity]
resolvedFixities,
			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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting (Set a) (Inspected ModuleLocation a Resolved) (Set a)
-> Set a
forall s a. s -> Getting a s a -> a
^. Getting (Set a) (Inspected ModuleLocation a Resolved) (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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting
     (First HsDevError) (Inspected ModuleLocation a Resolved) HsDevError
-> Maybe HsDevError
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Either HsDevError Resolved
 -> Const (First HsDevError) (Either HsDevError Resolved))
-> Inspected ModuleLocation a Resolved
-> Const (First HsDevError) (Inspected ModuleLocation a Resolved)
forall k1 t a a2.
Lens
  (Inspected k1 t a)
  (Inspected k1 t a2)
  (Either HsDevError a)
  (Either HsDevError a2)
inspectionResult ((Either HsDevError Resolved
  -> Const (First HsDevError) (Either HsDevError Resolved))
 -> Inspected ModuleLocation a Resolved
 -> Const (First HsDevError) (Inspected ModuleLocation a Resolved))
-> ((HsDevError -> Const (First HsDevError) HsDevError)
    -> Either HsDevError Resolved
    -> Const (First HsDevError) (Either HsDevError Resolved))
-> Getting
     (First HsDevError) (Inspected ModuleLocation a Resolved) HsDevError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsDevError -> Const (First HsDevError) HsDevError)
-> Either HsDevError Resolved
-> Const (First HsDevError) (Either HsDevError Resolved)
forall a c b. Prism (Either a c) (Either b c) a b
_Left)
			(Maybe Text, Maybe Text, Maybe ByteString, ByteString,
 Maybe String)
-> Inspection
-> (Maybe Text, 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 Resolved
im Inspected ModuleLocation a Resolved
-> Getting
     (First Inspection) (Inspected ModuleLocation a Resolved) Inspection
-> Maybe Inspection
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First Inspection) (Inspected ModuleLocation a Resolved) Inspection
forall k1 t a. Lens' (Inspected k1 t a) Inspection
inspection)
		asDict :: Set a -> Value
asDict Set a
tags = [Pair] -> 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 -> Pair
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]

updateResolvedsSymbols :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
updateResolvedsSymbols :: [(Int, InspectedResolved)] -> m ()
updateResolvedsSymbols [(Int, InspectedResolved)]
ims = 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, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
initUpdatedIds [(Int, InspectedResolved)]
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, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
insertModulesDefs [(Int, InspectedResolved)]
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, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
insertModulesImports [(Int, InspectedResolved)]
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, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
insertExportsSymbols [(Int, InspectedResolved)]
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
$ do
		[(Int, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
insertScopesSymbols [(Int, InspectedResolved)]
ims
		[(Int, InspectedResolved)] -> m ()
forall (m :: * -> *).
SessionMonad m =>
[(Int, InspectedResolved)] -> m ()
insertResolvedsNames [(Int, InspectedResolved)]
ims
	m ()
forall (m :: * -> *). SessionMonad m => m ()
commitTemps

	where
		initTemps :: SessionMonad m => m ()
		initTemps :: m ()
initTemps = do
			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);"
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create temporary table updating_scopes as select * from scopes where 0;"
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create index updating_scopes_name_index on updating_scopes (module_id, name);"
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create temporary table updating_names as select * from names where 0;"
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"create unique index updating_names_position_index on updating_names (module_id, line, column, line_to, column_to);"

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

		commitTemps :: SessionMonad m => m ()
		commitTemps :: m ()
commitTemps = 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
$ Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"insert into scopes select * from updating_scopes;"
			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
"insert into names select * from updating_names;"

		initUpdatedIds :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
		initUpdatedIds :: [(Int, InspectedResolved)] -> m ()
initUpdatedIds [(Int, InspectedResolved)]
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, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
				(Int, Maybe Text, Text, Bool, Bool)
-> [(Int, Maybe Text, Text, Bool, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return (
					Int
mid,
					InspectedResolved
im InspectedResolved
-> Getting (First Text) InspectedResolved Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> InspectedResolved -> Const (First Text) InspectedResolved
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> InspectedResolved -> Const (First Text) InspectedResolved)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) InspectedResolved 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,
					InspectedResolved
im InspectedResolved
-> Getting (Endo Text) InspectedResolved Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Resolved -> Const (Endo Text) Resolved)
-> InspectedResolved -> Const (Endo Text) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Endo Text) Resolved)
 -> InspectedResolved -> Const (Endo Text) InspectedResolved)
-> ((Text -> Const (Endo Text) Text)
    -> Resolved -> Const (Endo Text) Resolved)
-> Getting (Endo Text) InspectedResolved Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName () -> Const (Endo Text) (ModuleName ()))
-> Resolved -> Const (Endo Text) Resolved
Lens' Resolved (ModuleName ())
resolvedModule ((ModuleName () -> Const (Endo Text) (ModuleName ()))
 -> Resolved -> Const (Endo Text) Resolved)
-> ((Text -> Const (Endo Text) Text)
    -> ModuleName () -> Const (Endo Text) (ModuleName ()))
-> (Text -> Const (Endo Text) Text)
-> Resolved
-> Const (Endo Text) Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> ModuleName () -> Const (Endo Text) (ModuleName ())
Iso' (ModuleName ()) Text
moduleName_,
					ModuleTag -> InspectedResolved -> Bool
forall t i a. Ord t => t -> Inspected i t a -> Bool
hasTag ModuleTag
OnlyHeaderTag InspectedResolved
im,
					ModuleTag -> InspectedResolved -> Bool
forall t i a. Ord t => t -> Inspected i t a -> Bool
hasTag ModuleTag
DirtyTag InspectedResolved
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);"

		insertModulesImports :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
		insertModulesImports :: [(Int, InspectedResolved)] -> m ()
insertModulesImports [(Int, InspectedResolved)]
imods = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"imports" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
			Query
-> [(Int, Int, Int, String, Bool, Maybe String, Bool,
     Maybe ByteString)]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into imports (module_id, line, column, module_name, qualified, alias, hiding, import_list) values (?, ?, ?, ?, ?, ?, ?, ?);" ([(Int, Int, Int, String, Bool, Maybe String, Bool,
   Maybe ByteString)]
 -> m ())
-> [(Int, Int, Int, String, Bool, Maybe String, Bool,
     Maybe ByteString)]
-> m ()
forall a b. (a -> b) -> a -> b
$ do
				(Int
mid, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
				let
					p :: Parsed
p = InspectedResolved
im InspectedResolved
-> Getting (Endo Parsed) InspectedResolved Parsed -> Parsed
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Resolved -> Const (Endo Parsed) Resolved)
-> InspectedResolved -> Const (Endo Parsed) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Endo Parsed) Resolved)
 -> InspectedResolved -> Const (Endo Parsed) InspectedResolved)
-> ((Parsed -> Const (Endo Parsed) Parsed)
    -> Resolved -> Const (Endo Parsed) Resolved)
-> Getting (Endo Parsed) InspectedResolved Parsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed -> Const (Endo Parsed) Parsed)
-> Resolved -> Const (Endo Parsed) Resolved
Lens' Resolved Parsed
resolvedSource
				idecl :: ImportDecl Ann
idecl@(H.ImportDecl Ann
_ ModuleName Ann
mname Bool
qual Bool
_ Bool
_ Maybe String
_ Maybe (ModuleName Ann)
alias Maybe (ImportSpecList Ann)
specList) <- Parsed -> [ImportDecl Ann]
forall from to. Biplate from to => from -> [to]
childrenBi Parsed
p :: [H.ImportDecl Ann]
				(Int, Int, Int, String, Bool, Maybe String, Bool, Maybe ByteString)
-> [(Int, Int, Int, String, Bool, Maybe String, Bool,
     Maybe ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return (
					Int
mid,
					ImportDecl Ann
idecl ImportDecl Ann -> Getting Int (ImportDecl Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Position -> Const Int Position)
-> ImportDecl Ann -> Const Int (ImportDecl Ann)
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
pos ((Position -> Const Int Position)
 -> ImportDecl Ann -> Const Int (ImportDecl Ann))
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> Getting Int (ImportDecl Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionLine,
					ImportDecl Ann
idecl ImportDecl Ann -> Getting Int (ImportDecl Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Position -> Const Int Position)
-> ImportDecl Ann -> Const Int (ImportDecl Ann)
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
pos ((Position -> Const Int Position)
 -> ImportDecl Ann -> Const Int (ImportDecl Ann))
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> Getting Int (ImportDecl Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionColumn,
					ModuleName Ann -> String
forall l. ModuleName l -> String
getModuleName ModuleName Ann
mname,
					Bool
qual,
					(ModuleName Ann -> String)
-> Maybe (ModuleName Ann) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName Ann -> String
forall l. ModuleName l -> String
getModuleName Maybe (ModuleName Ann)
alias,
					Bool
-> (ImportSpecList Ann -> Bool)
-> Maybe (ImportSpecList Ann)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ImportSpecList Ann -> Bool
forall l. ImportSpecList l -> Bool
getHiding Maybe (ImportSpecList Ann)
specList,
					(ImportSpecList Ann -> ByteString)
-> Maybe (ImportSpecList Ann) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportSpecList Ann -> ByteString
forall a. ImportSpecList a -> ByteString
makeImportList Maybe (ImportSpecList Ann)
specList)
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"update imports set import_module_id = (select im.id from updated_ids as u, modules as im, projects_modules_scope as ps where ((ps.cabal is null and u.cabal is null) or (ps.cabal == u.cabal)) and ps.module_id == im.id and im.name == imports.module_name) where module_id in (select u.id from updated_ids as u);"
			where
				getModuleName :: ModuleName l -> String
getModuleName (H.ModuleName l
_ String
s) = String
s
				getHiding :: ImportSpecList l -> Bool
getHiding (H.ImportSpecList l
_ Bool
h [ImportSpec l]
_) = Bool
h

				makeImportList :: ImportSpecList a -> ByteString
makeImportList (H.ImportSpecList a
_ Bool
_ [ImportSpec a]
specs) = [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ImportSpec a -> Value) -> [ImportSpec a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec a -> Value
forall a. ImportSpec a -> Value
asJson [ImportSpec a]
specs
				asJson :: ImportSpec a -> Value
asJson (H.IVar a
_ Name a
nm) = [Pair] -> Value
object [Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Name () -> Text
fromName_ (Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
nm), Text
"what" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> String
forall a. a -> a
id @String String
"var"]
				asJson (H.IAbs a
_ Namespace a
ns Name a
nm) = [Pair] -> Value
object [Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Name () -> Text
fromName_ (Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
nm), Text
"what" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> String
forall a. a -> a
id @String String
"abs", Text
"ns" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Namespace a -> Maybe String
forall l. Namespace l -> Maybe String
fromNamespace Namespace a
ns] where
					fromNamespace :: H.Namespace l -> Maybe String
					fromNamespace :: Namespace l -> Maybe String
fromNamespace (H.NoNamespace l
_) = Maybe String
forall a. Maybe a
Nothing
					fromNamespace (H.TypeNamespace l
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
"type"
					fromNamespace (H.PatternNamespace l
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
"pat"
				asJson (H.IThingAll a
_ Name a
nm) = [Pair] -> Value
object [Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Name () -> Text
fromName_ (Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
nm), Text
"what" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> String
forall a. a -> a
id @String String
"all"]
				asJson (H.IThingWith a
_ Name a
nm [CName a]
cs) = [Pair] -> Value
object [Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Name () -> Text
fromName_ (Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
nm), Text
"what" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> String
forall a. a -> a
id @String String
"with", Text
"list" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (CName a -> Text) -> [CName a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Name () -> Text
fromName_ (Name () -> Text) -> (CName a -> Name ()) -> CName a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Name a -> Name ()) -> (CName a -> Name a) -> CName a -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CName a -> Name a
forall l. CName l -> Name l
toName') [CName a]
cs] where
					toName' :: CName l -> Name l
toName' (H.VarName l
_ Name l
n') = Name l
n'
					toName' (H.ConName l
_ Name l
n') = Name l
n'

		insertModulesDefs :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
		insertModulesDefs :: [(Int, InspectedResolved)] -> m ()
insertModulesDefs [(Int, InspectedResolved)]
imods = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"defs" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
			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, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
				Symbol
sym <- InspectedResolved
im InspectedResolved
-> Getting (Endo [Symbol]) InspectedResolved Symbol -> [Symbol]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Resolved -> Const (Endo [Symbol]) Resolved)
-> InspectedResolved -> Const (Endo [Symbol]) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Endo [Symbol]) Resolved)
 -> InspectedResolved -> Const (Endo [Symbol]) InspectedResolved)
-> ((Symbol -> Const (Endo [Symbol]) Symbol)
    -> Resolved -> Const (Endo [Symbol]) Resolved)
-> Getting (Endo [Symbol]) InspectedResolved Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Symbol] -> Const (Endo [Symbol]) [Symbol])
-> Resolved -> Const (Endo [Symbol]) Resolved
Lens' Resolved [Symbol]
resolvedDefs (([Symbol] -> Const (Endo [Symbol]) [Symbol])
 -> Resolved -> Const (Endo [Symbol]) Resolved)
-> ((Symbol -> Const (Endo [Symbol]) Symbol)
    -> [Symbol] -> Const (Endo [Symbol]) [Symbol])
-> (Symbol -> Const (Endo [Symbol]) Symbol)
-> Resolved
-> Const (Endo [Symbol]) Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Const (Endo [Symbol]) Symbol)
-> [Symbol] -> Const (Endo [Symbol]) [Symbol]
forall s t a b. Each s t a b => Traversal s t a b
each
				((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)
-> ((Text -> Const Text Text) -> SymbolId -> Const Text SymbolId)
-> Getting Text Symbol Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> SymbolId -> Const Text SymbolId
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)
			Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"insert or replace into env (module, name, what, id) select m.name, s.name, s.what, s.id from modules as m, symbols as s where m.id in (select id from updated_ids) and s.module_id = m.id;"

		insertExportsSymbols :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
		insertExportsSymbols :: [(Int, InspectedResolved)] -> m ()
insertExportsSymbols [(Int, InspectedResolved)]
imods = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"exports" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> [(Int, ModuleName (), Name (), String)] -> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into exports (module_id, symbol_id) select ?, env.id from env where env.module = ? and env.name = ? and env.what = ?;" ([(Int, ModuleName (), Name (), String)] -> m ())
-> [(Int, ModuleName (), Name (), String)] -> m ()
forall a b. (a -> b) -> a -> b
$ do
			(Int
mid, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
			Symbol
sym <- InspectedResolved
im InspectedResolved
-> Getting (Endo [Symbol]) InspectedResolved Symbol -> [Symbol]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Resolved -> Const (Endo [Symbol]) Resolved)
-> InspectedResolved -> Const (Endo [Symbol]) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Endo [Symbol]) Resolved)
 -> InspectedResolved -> Const (Endo [Symbol]) InspectedResolved)
-> ((Symbol -> Const (Endo [Symbol]) Symbol)
    -> Resolved -> Const (Endo [Symbol]) Resolved)
-> Getting (Endo [Symbol]) InspectedResolved Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Symbol] -> Const (Endo [Symbol]) [Symbol])
-> Resolved -> Const (Endo [Symbol]) Resolved
Lens' Resolved [Symbol]
resolvedExports (([Symbol] -> Const (Endo [Symbol]) [Symbol])
 -> Resolved -> Const (Endo [Symbol]) Resolved)
-> ((Symbol -> Const (Endo [Symbol]) Symbol)
    -> [Symbol] -> Const (Endo [Symbol]) [Symbol])
-> (Symbol -> Const (Endo [Symbol]) Symbol)
-> Resolved
-> Const (Endo [Symbol]) Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Const (Endo [Symbol]) Symbol)
-> [Symbol] -> Const (Endo [Symbol]) [Symbol]
forall s t a b. Each s t a b => Traversal s t a b
each
			(Int, ModuleName (), Name (), String)
-> [(Int, ModuleName (), Name (), String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (
				Int
mid,
				Symbol -> ModuleName ()
N.symbolModule Symbol
sym,
				Symbol -> Name ()
N.symbolName Symbol
sym,
				Symbol -> String
symbolType (Symbol -> Symbol
HN.fromSymbol Symbol
sym))

		insertScopesSymbols :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
		insertScopesSymbols :: [(Int, InspectedResolved)] -> m ()
insertScopesSymbols [(Int, InspectedResolved)]
imods = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"scope" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Query
-> [(Int, Maybe Text, Text, ModuleName (), Name (), String)]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
"insert into updating_scopes (module_id, qualifier, name, symbol_id) select ?, ?, ?, env.id from env where env.module = ? and env.name = ? and env.what = ?;" ([(Int, Maybe Text, Text, ModuleName (), Name (), String)] -> m ())
-> [(Int, Maybe Text, Text, ModuleName (), Name (), String)]
-> m ()
forall a b. (a -> b) -> a -> b
$ do
			(Int
mid, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
			(QName ()
qn, [Symbol]
syms) <- Map (QName ()) [Symbol] -> [(QName (), [Symbol])]
forall k a. Map k a -> [(k, a)]
M.toList (InspectedResolved
im InspectedResolved
-> Getting
     (Map (QName ()) [Symbol])
     InspectedResolved
     (Map (QName ()) [Symbol])
-> Map (QName ()) [Symbol]
forall s a. s -> Getting a s a -> a
^. (Resolved -> Const (Map (QName ()) [Symbol]) Resolved)
-> InspectedResolved
-> Const (Map (QName ()) [Symbol]) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Map (QName ()) [Symbol]) Resolved)
 -> InspectedResolved
 -> Const (Map (QName ()) [Symbol]) InspectedResolved)
-> ((Map (QName ()) [Symbol]
     -> Const (Map (QName ()) [Symbol]) (Map (QName ()) [Symbol]))
    -> Resolved -> Const (Map (QName ()) [Symbol]) Resolved)
-> Getting
     (Map (QName ()) [Symbol])
     InspectedResolved
     (Map (QName ()) [Symbol])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (QName ()) [Symbol]
 -> Const (Map (QName ()) [Symbol]) (Map (QName ()) [Symbol]))
-> Resolved -> Const (Map (QName ()) [Symbol]) Resolved
Lens' Resolved (Map (QName ()) [Symbol])
resolvedScope)
			Symbol
sym <- [Symbol]
syms
			(Int, Maybe Text, Text, ModuleName (), Name (), String)
-> [(Int, Maybe Text, Text, ModuleName (), Name (), String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (
				Int
mid,
				QName () -> Maybe Text
nameModule QName ()
qn,
				QName () -> Text
nameIdent QName ()
qn,
				Symbol -> ModuleName ()
N.symbolModule Symbol
sym,
				Symbol -> Name ()
N.symbolName Symbol
sym,
				Symbol -> String
symbolType (Symbol -> Symbol
HN.fromSymbol Symbol
sym))

		insertResolvedsNames :: SessionMonad m => [(Int, InspectedResolved)] -> m ()
		insertResolvedsNames :: [(Int, InspectedResolved)] -> m ()
insertResolvedsNames [(Int, InspectedResolved)]
imods = Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
scope Text
"names" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
			m ()
insertNames
			m ()
replaceQNames
			m ()
resolveGlobalBinders
			m ()
setResolvedsSymbolIds
			where
				insertNames :: m ()
insertNames = Query
-> [(Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String)]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
insertQuery [(Int, Maybe Text, Text, Int, Int, Int, Int)
 :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
     Maybe String)]
namesData
				replaceQNames :: m ()
replaceQNames = Query
-> [(Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String)]
-> m ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> [q] -> m ()
executeMany Query
insertQuery [(Int, Maybe Text, Text, Int, Int, Int, Int)
 :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
     Maybe String)]
qnamesData
				resolveGlobalBinders :: m ()
resolveGlobalBinders = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"update updating_names set (resolved_module, resolved_name, resolved_what) = (select u.module, s.name, s.what from updated_ids as u, symbols as s where u.id = s.module_id and s.module_id = updating_names.module_id and s.line = updating_names.line and s.column = updating_names.column) where (line, column) = (def_line, def_column) and resolved_module is null and resolved_name is null;"
				setResolvedsSymbolIds :: m ()
setResolvedsSymbolIds = Query -> m ()
forall (m :: * -> *). SessionMonad m => Query -> m ()
execute_ Query
"update updating_names set symbol_id = (select sc.symbol_id from updating_scopes as sc, symbols as s, modules as m where updating_names.module_id == sc.module_id and ((updating_names.qualifier is null and sc.qualifier is null) or (updating_names.qualifier == sc.qualifier)) and updating_names.name == sc.name and s.id == sc.symbol_id and m.id == s.module_id and s.name == updating_names.resolved_name and s.what == updating_names.resolved_what and m.name == updating_names.resolved_module) where resolved_module is not null and resolved_name is not null and resolved_what is not null;"
				insertQuery :: Query
insertQuery = Query
"insert or replace into updating_names (module_id, qualifier, name, line, column, line_to, column_to, def_line, def_column, resolved_module, resolved_name, resolved_what, resolve_error) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"

				namesData :: [(Int, Maybe Text, Text, Int, Int, Int, Int)
 :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
     Maybe String)]
namesData = ((Int, Name Ann)
 -> (Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String))
-> [(Int, Name Ann)]
-> [(Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
 -> Name Ann
 -> (Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String))
-> (Int, Name Ann)
-> (Int, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> Name Ann
-> (Int, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
forall a.
a
-> Name Ann
-> (a, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
toData) ([(Int, Name Ann)]
 -> [(Int, Maybe Text, Text, Int, Int, Int, Int)
     :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
         Maybe String)])
-> [(Int, Name Ann)]
-> [(Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String)]
forall a b. (a -> b) -> a -> b
$ do
					(Int
mid, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
					Name Ann
n <- InspectedResolved
im InspectedResolved
-> Getting (Endo [Name Ann]) InspectedResolved (Name Ann)
-> [Name Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Resolved -> Const (Endo [Name Ann]) Resolved)
-> InspectedResolved -> Const (Endo [Name Ann]) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Endo [Name Ann]) Resolved)
 -> InspectedResolved -> Const (Endo [Name Ann]) InspectedResolved)
-> ((Name Ann -> Const (Endo [Name Ann]) (Name Ann))
    -> Resolved -> Const (Endo [Name Ann]) Resolved)
-> Getting (Endo [Name Ann]) InspectedResolved (Name Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed -> Const (Endo [Name Ann]) Parsed)
-> Resolved -> Const (Endo [Name Ann]) Resolved
Lens' Resolved Parsed
resolvedSource ((Parsed -> Const (Endo [Name Ann]) Parsed)
 -> Resolved -> Const (Endo [Name Ann]) Resolved)
-> ((Name Ann -> Const (Endo [Name Ann]) (Name Ann))
    -> Parsed -> Const (Endo [Name Ann]) Parsed)
-> (Name Ann -> Const (Endo [Name Ann]) (Name Ann))
-> Resolved
-> Const (Endo [Name Ann]) Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Ann -> Const (Endo [Name Ann]) (Name Ann))
-> Parsed -> Const (Endo [Name Ann]) Parsed
forall (ast :: * -> *).
Data (ast Ann) =>
Traversal' (ast Ann) (Name Ann)
P.names
					(Int, Name Ann) -> [(Int, Name Ann)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
mid, Name Ann
n)
				qnamesData :: [(Int, Maybe Text, Text, Int, Int, Int, Int)
 :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
     Maybe String)]
qnamesData = ((Int, QName Ann)
 -> (Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String))
-> [(Int, QName Ann)]
-> [(Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
 -> QName Ann
 -> (Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String))
-> (Int, QName Ann)
-> (Int, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> QName Ann
-> (Int, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
forall a.
a
-> QName Ann
-> (a, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
toQData) ([(Int, QName Ann)]
 -> [(Int, Maybe Text, Text, Int, Int, Int, Int)
     :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
         Maybe String)])
-> [(Int, QName Ann)]
-> [(Int, Maybe Text, Text, Int, Int, Int, Int)
    :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
        Maybe String)]
forall a b. (a -> b) -> a -> b
$ do
					(Int
mid, InspectedResolved
im) <- [(Int, InspectedResolved)]
imods
					QName Ann
n <- InspectedResolved
im InspectedResolved
-> Getting (Endo [QName Ann]) InspectedResolved (QName Ann)
-> [QName Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Resolved -> Const (Endo [QName Ann]) Resolved)
-> InspectedResolved -> Const (Endo [QName Ann]) InspectedResolved
forall k t a b. Traversal (Inspected k t a) (Inspected k t b) a b
inspected ((Resolved -> Const (Endo [QName Ann]) Resolved)
 -> InspectedResolved -> Const (Endo [QName Ann]) InspectedResolved)
-> ((QName Ann -> Const (Endo [QName Ann]) (QName Ann))
    -> Resolved -> Const (Endo [QName Ann]) Resolved)
-> Getting (Endo [QName Ann]) InspectedResolved (QName Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed -> Const (Endo [QName Ann]) Parsed)
-> Resolved -> Const (Endo [QName Ann]) Resolved
Lens' Resolved Parsed
resolvedSource ((Parsed -> Const (Endo [QName Ann]) Parsed)
 -> Resolved -> Const (Endo [QName Ann]) Resolved)
-> ((QName Ann -> Const (Endo [QName Ann]) (QName Ann))
    -> Parsed -> Const (Endo [QName Ann]) Parsed)
-> (QName Ann -> Const (Endo [QName Ann]) (QName Ann))
-> Resolved
-> Const (Endo [QName Ann]) Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName Ann -> Const (Endo [QName Ann]) (QName Ann))
-> Parsed -> Const (Endo [QName Ann]) Parsed
forall (ast :: * -> *).
Data (ast Ann) =>
Traversal' (ast Ann) (QName Ann)
P.qnames
					(Int, QName Ann) -> [(Int, QName Ann)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
mid, QName Ann
n)

				toData :: a
-> Name Ann
-> (a, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
toData a
mid Name Ann
name = (
					a
mid,
					Maybe Text
forall a. Maybe a
Nothing :: Maybe Text,
					Name () -> Text
fromName_ (Name () -> Text) -> Name () -> Text
forall a b. (a -> b) -> a -> b
$ Name Ann -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name Ann
name,
					Name Ann
name Name Ann -> Getting Int (Name Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Position -> Const Int Position)
-> Name Ann -> Const Int (Name Ann)
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
P.pos ((Position -> Const Int Position)
 -> Name Ann -> Const Int (Name Ann))
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> Getting Int (Name Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionLine,
					Name Ann
name Name Ann -> Getting Int (Name Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Position -> Const Int Position)
-> Name Ann -> Const Int (Name Ann)
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
P.pos ((Position -> Const Int Position)
 -> Name Ann -> Const Int (Name Ann))
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> Getting Int (Name Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionColumn,
					Name Ann
name Name Ann -> Getting Int (Name Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Region -> Const Int Region) -> Name Ann -> Const Int (Name Ann)
forall (ast :: * -> *). Annotated ast => Lens' (ast Ann) Region
P.regionL ((Region -> Const Int Region) -> Name Ann -> Const Int (Name Ann))
-> ((Int -> Const Int Int) -> Region -> Const Int Region)
-> Getting Int (Name Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Int Position) -> Region -> Const Int Region
Lens' Region Position
regionTo ((Position -> Const Int Position) -> Region -> Const Int Region)
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> (Int -> Const Int Int)
-> Region
-> Const Int Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionLine,
					Name Ann
name Name Ann -> Getting Int (Name Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Region -> Const Int Region) -> Name Ann -> Const Int (Name Ann)
forall (ast :: * -> *). Annotated ast => Lens' (ast Ann) Region
P.regionL ((Region -> Const Int Region) -> Name Ann -> Const Int (Name Ann))
-> ((Int -> Const Int Int) -> Region -> Const Int Region)
-> Getting Int (Name Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Int Position) -> Region -> Const Int Region
Lens' Region Position
regionTo ((Position -> Const Int Position) -> Region -> Const Int Region)
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> (Int -> Const Int Int)
-> Region
-> Const Int Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionColumn)
					(a, Maybe Text, Text, Int, Int, Int, Int)
-> (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
    Maybe String)
-> (a, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
forall h t. h -> t -> h :. t
:. (
					Name Ann
name Name Ann -> Getting (First Int) (Name Ann) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Position -> Const (First Int) Position)
-> Name Ann -> Const (First Int) (Name Ann)
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) Position
P.defPos ((Position -> Const (First Int) Position)
 -> Name Ann -> Const (First Int) (Name Ann))
-> ((Int -> Const (First Int) Int)
    -> Position -> Const (First Int) Position)
-> Getting (First Int) (Name Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Position -> Const (First Int) Position
Lens' Position Int
positionLine,
					Name Ann
name Name Ann -> Getting (First Int) (Name Ann) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Position -> Const (First Int) Position)
-> Name Ann -> Const (First Int) (Name Ann)
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) Position
P.defPos ((Position -> Const (First Int) Position)
 -> Name Ann -> Const (First Int) (Name Ann))
-> ((Int -> Const (First Int) Int)
    -> Position -> Const (First Int) Position)
-> Getting (First Int) (Name Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Position -> Const (First Int) Position
Lens' Position Int
positionColumn,
					(Name Ann
name Name Ann
-> Getting (First (QName ())) (Name Ann) (QName ())
-> Maybe (QName ())
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (QName ())) (Name Ann) (QName ())
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) (QName ())
P.resolvedName) Maybe (QName ()) -> (QName () -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName () -> Maybe Text
nameModule,
					QName () -> Text
nameIdent (QName () -> Text) -> Maybe (QName ()) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name Ann
name Name Ann
-> Getting (First (QName ())) (Name Ann) (QName ())
-> Maybe (QName ())
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (QName ())) (Name Ann) (QName ())
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) (QName ())
P.resolvedName),
					(Symbol -> String) -> Maybe Symbol -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Symbol -> String
symbolType (Symbol -> String) -> (Symbol -> Symbol) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Symbol
HN.fromSymbol) (Maybe Symbol -> Maybe String) -> Maybe Symbol -> Maybe String
forall a b. (a -> b) -> a -> b
$ Name Ann
name Name Ann
-> Getting (First Symbol) (Name Ann) Symbol -> Maybe Symbol
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Symbol) (Name Ann) Symbol
forall a. Data a => Traversal' a Symbol
P.symbolL,
					Name Ann -> Maybe String
forall (ast :: * -> *). Annotated ast => ast Ann -> Maybe String
P.resolveError Name Ann
name)
				toQData :: a
-> QName Ann
-> (a, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
toQData a
mid QName Ann
qname = (
					a
mid,
					QName () -> Maybe Text
nameModule (QName () -> Maybe Text) -> QName () -> Maybe Text
forall a b. (a -> b) -> a -> b
$ QName Ann -> QName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void QName Ann
qname,
					QName () -> Text
nameIdent (QName () -> Text) -> QName () -> Text
forall a b. (a -> b) -> a -> b
$ QName Ann -> QName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void QName Ann
qname,
					QName Ann
qname QName Ann -> Getting Int (QName Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Position -> Const Int Position)
-> QName Ann -> Const Int (QName Ann)
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
P.pos ((Position -> Const Int Position)
 -> QName Ann -> Const Int (QName Ann))
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> Getting Int (QName Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionLine,
					QName Ann
qname QName Ann -> Getting Int (QName Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Position -> Const Int Position)
-> QName Ann -> Const Int (QName Ann)
forall (ast :: * -> *) isrc.
(Annotated ast, SrcInfo isrc, Data isrc) =>
Lens' (ast isrc) Position
P.pos ((Position -> Const Int Position)
 -> QName Ann -> Const Int (QName Ann))
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> Getting Int (QName Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionColumn,
					QName Ann
qname QName Ann -> Getting Int (QName Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Region -> Const Int Region) -> QName Ann -> Const Int (QName Ann)
forall (ast :: * -> *). Annotated ast => Lens' (ast Ann) Region
P.regionL ((Region -> Const Int Region)
 -> QName Ann -> Const Int (QName Ann))
-> ((Int -> Const Int Int) -> Region -> Const Int Region)
-> Getting Int (QName Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Int Position) -> Region -> Const Int Region
Lens' Region Position
regionTo ((Position -> Const Int Position) -> Region -> Const Int Region)
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> (Int -> Const Int Int)
-> Region
-> Const Int Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionLine,
					QName Ann
qname QName Ann -> Getting Int (QName Ann) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Region -> Const Int Region) -> QName Ann -> Const Int (QName Ann)
forall (ast :: * -> *). Annotated ast => Lens' (ast Ann) Region
P.regionL ((Region -> Const Int Region)
 -> QName Ann -> Const Int (QName Ann))
-> ((Int -> Const Int Int) -> Region -> Const Int Region)
-> Getting Int (QName Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Int Position) -> Region -> Const Int Region
Lens' Region Position
regionTo ((Position -> Const Int Position) -> Region -> Const Int Region)
-> ((Int -> Const Int Int) -> Position -> Const Int Position)
-> (Int -> Const Int Int)
-> Region
-> Const Int Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Position -> Const Int Position
Lens' Position Int
positionColumn)
					(a, Maybe Text, Text, Int, Int, Int, Int)
-> (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
    Maybe String)
-> (a, Maybe Text, Text, Int, Int, Int, Int)
   :. (Maybe Int, Maybe Int, Maybe Text, Maybe Text, Maybe String,
       Maybe String)
forall h t. h -> t -> h :. t
:. (
					QName Ann
qname QName Ann -> Getting (First Int) (QName Ann) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Position -> Const (First Int) Position)
-> QName Ann -> Const (First Int) (QName Ann)
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) Position
P.defPos ((Position -> Const (First Int) Position)
 -> QName Ann -> Const (First Int) (QName Ann))
-> ((Int -> Const (First Int) Int)
    -> Position -> Const (First Int) Position)
-> Getting (First Int) (QName Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Position -> Const (First Int) Position
Lens' Position Int
positionLine,
					QName Ann
qname QName Ann -> Getting (First Int) (QName Ann) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Position -> Const (First Int) Position)
-> QName Ann -> Const (First Int) (QName Ann)
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) Position
P.defPos ((Position -> Const (First Int) Position)
 -> QName Ann -> Const (First Int) (QName Ann))
-> ((Int -> Const (First Int) Int)
    -> Position -> Const (First Int) Position)
-> Getting (First Int) (QName Ann) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Position -> Const (First Int) Position
Lens' Position Int
positionColumn,
					(QName Ann
qname QName Ann
-> Getting (First (QName ())) (QName Ann) (QName ())
-> Maybe (QName ())
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (QName ())) (QName Ann) (QName ())
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) (QName ())
P.resolvedName) Maybe (QName ()) -> (QName () -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName () -> Maybe Text
nameModule,
					QName () -> Text
nameIdent (QName () -> Text) -> Maybe (QName ()) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName Ann
qname QName Ann
-> Getting (First (QName ())) (QName Ann) (QName ())
-> Maybe (QName ())
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (QName ())) (QName Ann) (QName ())
forall (ast :: * -> *).
Annotated ast =>
Traversal' (ast Ann) (QName ())
P.resolvedName),
					(Symbol -> String) -> Maybe Symbol -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Symbol -> String
symbolType (Symbol -> String) -> (Symbol -> Symbol) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Symbol
HN.fromSymbol) (Maybe Symbol -> Maybe String) -> Maybe Symbol -> Maybe String
forall a b. (a -> b) -> a -> b
$ QName Ann
qname QName Ann
-> Getting (First Symbol) (QName Ann) Symbol -> Maybe Symbol
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Symbol) (QName Ann) Symbol
forall a. Data a => Traversal' a Symbol
P.symbolL,
					QName Ann -> Maybe String
forall (ast :: * -> *). Annotated ast => ast Ann -> Maybe String
P.resolveError QName Ann
qname)