{-# LANGUAGE PackageImports #-}

module HsDev.Scan.Browse (
	-- * List all packages
	browsePackages, browsePackagesDeps,
	-- * Scan cabal modules
	listModules,
	browseModules, browseModules',
	-- * Helpers
	uniqueModuleLocations,
	readPackage, readPackageConfig, ghcModuleLocation,
	packageConfigs, packageDbModules,
	modulesPackages, modulesPackagesGroups, withEachPackage,

	module Control.Monad.Except
	) where

import Control.Arrow
import Control.Lens (view, preview)
import Control.Monad.Catch (MonadCatch, catch, SomeException)
import Control.Monad.Except
import Data.Function (on)
import Data.List (groupBy, sort)
import Data.Maybe
import Data.String (fromString)
import qualified Data.Set as S
import Data.Version
import Language.Haskell.Exts.Fixity
import Language.Haskell.Exts.Syntax (Assoc(..), QName(..), Name(Ident), ModuleName(..))

import Data.Deps
import Data.LookupTable
import HsDev.PackageDb
import HsDev.Symbols
import HsDev.Error
import HsDev.Tools.Ghc.Worker (GhcM, tmpSession, formatType)
import HsDev.Tools.Ghc.Compat as Compat
import HsDev.Util (ordNub, uniqueBy)
import System.Directory.Paths (fromFilePath, normalize)

import qualified "ghc" ConLike as GHC
import qualified "ghc" DataCon as GHC
import qualified "ghc" DynFlags as GHC
import qualified "ghc" GHC
import qualified "ghc-boot" GHC.PackageDb as GHC
import qualified "ghc" GhcMonad as GHC (liftIO)
import qualified "ghc" Name as GHC
import qualified "ghc" IdInfo as GHC
import qualified "ghc" Packages as GHC
import qualified "ghc" PatSyn as GHC
import qualified "ghc" TyCon as GHC
import qualified "ghc" Type as GHC
import qualified "ghc" Var as GHC

-- | Browse packages
browsePackages :: [String] -> PackageDbStack -> GhcM [PackageConfig]
browsePackages :: [String] -> PackageDbStack -> GhcM [PackageConfig]
browsePackages [String]
opts PackageDbStack
dbs = do
	PackageDbStack -> [String] -> GhcM ()
tmpSession PackageDbStack
dbs [String]
opts
	([PackageConfig] -> [PackageConfig])
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
-> GhcM [PackageConfig]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((PackageConfig -> PackageConfig)
-> [PackageConfig] -> [PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> PackageConfig
readPackageConfig) MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
packageConfigs

-- | Get packages with deps
browsePackagesDeps :: [String] -> PackageDbStack -> GhcM (Deps PackageConfig)
browsePackagesDeps :: [String] -> PackageDbStack -> GhcM (Deps PackageConfig)
browsePackagesDeps [String]
opts PackageDbStack
dbs = do
	PackageDbStack -> [String] -> GhcM ()
tmpSession PackageDbStack
dbs [String]
opts
	DynFlags
df <- MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
	[PackageConfig]
cfgs <- MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
packageConfigs
	Deps PackageConfig -> GhcM (Deps PackageConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Deps PackageConfig -> GhcM (Deps PackageConfig))
-> Deps PackageConfig -> GhcM (Deps PackageConfig)
forall a b. (a -> b) -> a -> b
$ (InstalledUnitId -> PackageConfig)
-> Deps InstalledUnitId -> Deps PackageConfig
forall b a. Ord b => (a -> b) -> Deps a -> Deps b
mapDeps (DynFlags -> InstalledUnitId -> PackageConfig
toPkg DynFlags
df) (Deps InstalledUnitId -> Deps PackageConfig)
-> Deps InstalledUnitId -> Deps PackageConfig
forall a b. (a -> b) -> a -> b
$ [Deps InstalledUnitId] -> Deps InstalledUnitId
forall a. Monoid a => [a] -> a
mconcat [InstalledUnitId -> [InstalledUnitId] -> Deps InstalledUnitId
forall a. a -> [a] -> Deps a
deps (PackageConfig -> InstalledUnitId
Compat.unitId PackageConfig
cfg) (DynFlags -> PackageConfig -> [InstalledUnitId]
Compat.depends DynFlags
df PackageConfig
cfg) | PackageConfig
cfg <- [PackageConfig]
cfgs]
	where
		toPkg :: DynFlags -> InstalledUnitId -> PackageConfig
toPkg DynFlags
df' = PackageConfig -> PackageConfig
readPackageConfig (PackageConfig -> PackageConfig)
-> (InstalledUnitId -> PackageConfig)
-> InstalledUnitId
-> PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> InstalledUnitId -> PackageConfig
getPackageDetails DynFlags
df'

-- | List modules from ghc, accepts ghc-opts, stack of package-db to get modules for
-- and list of packages to explicitely expose them with '-package' flag,
-- otherwise hidden packages won't be loaded
listModules :: [String] -> PackageDbStack -> [ModulePackage] -> GhcM [ModuleLocation]
listModules :: [String]
-> PackageDbStack -> [ModulePackage] -> GhcM [ModuleLocation]
listModules [String]
opts PackageDbStack
dbs [ModulePackage]
pkgs = do
	PackageDbStack -> [String] -> GhcM ()
tmpSession PackageDbStack
dbs ([String]
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
packagesOpts)
	[(PackageConfig, Module, Bool)]
ms <- GhcM [(PackageConfig, Module, Bool)]
packageDbModules
	[ModuleLocation] -> GhcM [ModuleLocation]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ModuleLocation] -> GhcM [ModuleLocation])
-> [ModuleLocation] -> GhcM [ModuleLocation]
forall a b. (a -> b) -> a -> b
$ [ModuleLocation] -> [ModuleLocation]
forall a. Ord a => [a] -> [a]
ordNub [PackageConfig -> Module -> Bool -> ModuleLocation
ghcModuleLocation PackageConfig
p Module
m Bool
e | (PackageConfig
p, Module
m, Bool
e) <- [(PackageConfig, Module, Bool)]
ms]
	where
		packagesOpts :: [String]
packagesOpts = [String
"-package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModulePackage -> String
forall a. Show a => a -> String
show ModulePackage
p | ModulePackage
p <- [ModulePackage]
pkgs]

-- | Like @browseModules@, but groups modules by package and inspects each package separately
-- Trying to fix error: when there are several same packages (of different version), only @Module@ from
-- one of them can be lookuped and therefore modules from different version packages won't be actually inspected
browseModules :: [String] -> PackageDbStack -> [ModuleLocation] -> GhcM [InspectedModule]
browseModules :: [String]
-> PackageDbStack -> [ModuleLocation] -> GhcM [InspectedModule]
browseModules [String]
opts PackageDbStack
dbs [ModuleLocation]
mlocs = do
	PackageDbStack -> [String] -> GhcM ()
tmpSession PackageDbStack
dbs [String]
opts
	([[InspectedModule]] -> [InspectedModule])
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) [[InspectedModule]]
-> GhcM [InspectedModule]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([InspectedModule] -> [InspectedModule]
uniqueInspectedModules ([InspectedModule] -> [InspectedModule])
-> ([[InspectedModule]] -> [InspectedModule])
-> [[InspectedModule]]
-> [InspectedModule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[InspectedModule]] -> [InspectedModule]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (MGhcT SessionConfig (First DynFlags) (LogT IO) [[InspectedModule]]
 -> GhcM [InspectedModule])
-> ([ModuleLocation]
    -> MGhcT
         SessionConfig (First DynFlags) (LogT IO) [[InspectedModule]])
-> [ModuleLocation]
-> GhcM [InspectedModule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModulePackage -> [ModuleLocation] -> GhcM [InspectedModule])
-> [ModuleLocation]
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) [[InspectedModule]]
forall a.
(ModulePackage -> [ModuleLocation] -> GhcM a)
-> [ModuleLocation] -> GhcM [a]
withEachPackage (([ModuleLocation] -> GhcM [InspectedModule])
-> ModulePackage -> [ModuleLocation] -> GhcM [InspectedModule]
forall a b. a -> b -> a
const (([ModuleLocation] -> GhcM [InspectedModule])
 -> ModulePackage -> [ModuleLocation] -> GhcM [InspectedModule])
-> ([ModuleLocation] -> GhcM [InspectedModule])
-> ModulePackage
-> [ModuleLocation]
-> GhcM [InspectedModule]
forall a b. (a -> b) -> a -> b
$ [String] -> [ModuleLocation] -> GhcM [InspectedModule]
browseModules' [String]
opts) ([ModuleLocation] -> GhcM [InspectedModule])
-> [ModuleLocation] -> GhcM [InspectedModule]
forall a b. (a -> b) -> a -> b
$ [ModuleLocation] -> [ModuleLocation]
forall a. Ord a => [a] -> [a]
ordNub [ModuleLocation]
mlocs

-- | Inspect installed modules, doesn't set session and package flags!
browseModules' :: [String] -> [ModuleLocation] -> GhcM [InspectedModule]
browseModules' :: [String] -> [ModuleLocation] -> GhcM [InspectedModule]
browseModules' [String]
opts [ModuleLocation]
mlocs = do
	[(PackageConfig, Module, Bool)]
ms <- GhcM [(PackageConfig, Module, Bool)]
packageDbModules
	LookupTable ModuleLocation ModuleId
midTbl <- MGhcT
  SessionConfig
  (First DynFlags)
  (LogT IO)
  (LookupTable ModuleLocation ModuleId)
forall k (m :: * -> *) v. (Ord k, MonadIO m) => m (LookupTable k v)
newLookupTable
	LookupTable Name Symbol
sidTbl <- MGhcT
  SessionConfig (First DynFlags) (LogT IO) (LookupTable Name Symbol)
forall k (m :: * -> *) v. (Ord k, MonadIO m) => m (LookupTable k v)
newLookupTable
	let
		lookupModuleId :: PackageConfig -> Module -> Bool -> m ModuleId
lookupModuleId PackageConfig
p' Module
m' Bool
e' = ModuleLocation
-> ModuleId -> LookupTable ModuleLocation ModuleId -> m ModuleId
forall k (m :: * -> *) v.
(Ord k, MonadIO m) =>
k -> v -> LookupTable k v -> m v
lookupTable (PackageConfig -> Module -> Bool -> ModuleLocation
ghcModuleLocation PackageConfig
p' Module
m' Bool
e') (PackageConfig -> Module -> Bool -> ModuleId
ghcModuleId PackageConfig
p' Module
m' Bool
e') LookupTable ModuleLocation ModuleId
midTbl
	([Maybe InspectedModule] -> [InspectedModule])
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) [Maybe InspectedModule]
-> GhcM [InspectedModule]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Maybe InspectedModule] -> [InspectedModule]
forall a. [Maybe a] -> [a]
catMaybes (MGhcT
   SessionConfig (First DynFlags) (LogT IO) [Maybe InspectedModule]
 -> GhcM [InspectedModule])
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) [Maybe InspectedModule]
-> GhcM [InspectedModule]
forall a b. (a -> b) -> a -> b
$ [MGhcT
   SessionConfig (First DynFlags) (LogT IO) (Maybe InspectedModule)]
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) [Maybe InspectedModule]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(PackageConfig -> Module -> Bool -> GhcM ModuleId)
-> (Name -> GhcM Symbol -> GhcM Symbol)
-> PackageConfig
-> Module
-> Bool
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Maybe InspectedModule)
browseModule' PackageConfig -> Module -> Bool -> GhcM ModuleId
forall (m :: * -> *).
MonadIO m =>
PackageConfig -> Module -> Bool -> m ModuleId
lookupModuleId (LookupTable Name Symbol -> Name -> GhcM Symbol -> GhcM Symbol
forall k (m :: * -> *) v.
(Ord k, MonadIO m) =>
LookupTable k v -> k -> m v -> m v
cacheInTableM LookupTable Name Symbol
sidTbl) PackageConfig
p Module
m Bool
e | (PackageConfig
p, Module
m, Bool
e) <- [(PackageConfig, Module, Bool)]
ms, PackageConfig -> Module -> Bool -> ModuleLocation
ghcModuleLocation PackageConfig
p Module
m Bool
e ModuleLocation -> Set ModuleLocation -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set ModuleLocation
mlocs']
	where
		browseModule' :: (GHC.PackageConfig -> GHC.Module -> Bool -> GhcM ModuleId) -> (GHC.Name -> GhcM Symbol -> GhcM Symbol) -> GHC.PackageConfig -> GHC.Module -> Bool -> GhcM (Maybe InspectedModule)
		browseModule' :: (PackageConfig -> Module -> Bool -> GhcM ModuleId)
-> (Name -> GhcM Symbol -> GhcM Symbol)
-> PackageConfig
-> Module
-> Bool
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Maybe InspectedModule)
browseModule' PackageConfig -> Module -> Bool -> GhcM ModuleId
modId' Name -> GhcM Symbol -> GhcM Symbol
sym' PackageConfig
p Module
m Bool
e = MGhcT SessionConfig (First DynFlags) (LogT IO) InspectedModule
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Maybe InspectedModule)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
tryT (MGhcT SessionConfig (First DynFlags) (LogT IO) InspectedModule
 -> MGhcT
      SessionConfig (First DynFlags) (LogT IO) (Maybe InspectedModule))
-> MGhcT SessionConfig (First DynFlags) (LogT IO) InspectedModule
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Maybe InspectedModule)
forall a b. (a -> b) -> a -> b
$ ModuleLocation
-> InspectM
     ModuleLocation
     ModuleTag
     (MGhcT SessionConfig (First DynFlags) (LogT IO))
     Module
-> MGhcT SessionConfig (First DynFlags) (LogT IO) InspectedModule
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
k -> InspectM k t m a -> m (Inspected k t a)
runInspect (PackageConfig -> Module -> Bool -> ModuleLocation
ghcModuleLocation PackageConfig
p Module
m Bool
e) (InspectM
   ModuleLocation
   ModuleTag
   (MGhcT SessionConfig (First DynFlags) (LogT IO))
   Module
 -> MGhcT SessionConfig (First DynFlags) (LogT IO) InspectedModule)
-> InspectM
     ModuleLocation
     ModuleTag
     (MGhcT SessionConfig (First DynFlags) (LogT IO))
     Module
-> MGhcT SessionConfig (First DynFlags) (LogT IO) InspectedModule
forall a b. (a -> b) -> a -> b
$ MGhcT SessionConfig (First DynFlags) (LogT IO) Inspection
-> MGhcT SessionConfig (First DynFlags) (LogT IO) Module
-> InspectM
     ModuleLocation
     ModuleTag
     (MGhcT SessionConfig (First DynFlags) (LogT IO))
     Module
forall (m :: * -> *) a k t.
MonadCatch m =>
m Inspection -> m a -> InspectM k t m a
inspect_ (Inspection
-> MGhcT SessionConfig (First DynFlags) (LogT IO) Inspection
forall (m :: * -> *) a. Monad m => a -> m a
return (Inspection
 -> MGhcT SessionConfig (First DynFlags) (LogT IO) Inspection)
-> Inspection
-> MGhcT SessionConfig (First DynFlags) (LogT IO) Inspection
forall a b. (a -> b) -> a -> b
$ POSIXTime -> [Text] -> Inspection
InspectionAt POSIXTime
0 ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. IsString a => String -> a
fromString [String]
opts)) ((PackageConfig -> Module -> Bool -> GhcM ModuleId)
-> (Name -> GhcM Symbol -> GhcM Symbol)
-> PackageConfig
-> Module
-> Bool
-> MGhcT SessionConfig (First DynFlags) (LogT IO) Module
browseModule PackageConfig -> Module -> Bool -> GhcM ModuleId
modId' Name -> GhcM Symbol -> GhcM Symbol
sym' PackageConfig
p Module
m Bool
e)
		mlocs' :: Set ModuleLocation
mlocs' = [ModuleLocation] -> Set ModuleLocation
forall a. Ord a => [a] -> Set a
S.fromList [ModuleLocation]
mlocs

browseModule :: (GHC.PackageConfig -> GHC.Module -> Bool -> GhcM ModuleId) -> (GHC.Name -> GhcM Symbol -> GhcM Symbol) -> GHC.PackageConfig -> GHC.Module -> Bool -> GhcM Module
browseModule :: (PackageConfig -> Module -> Bool -> GhcM ModuleId)
-> (Name -> GhcM Symbol -> GhcM Symbol)
-> PackageConfig
-> Module
-> Bool
-> MGhcT SessionConfig (First DynFlags) (LogT IO) Module
browseModule PackageConfig -> Module -> Bool -> GhcM ModuleId
modId Name -> GhcM Symbol -> GhcM Symbol
lookSym PackageConfig
package' Module
m Bool
exposed' = do
	DynFlags
df <- MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
	ModuleInfo
mi <- Module
-> MGhcT
     SessionConfig (First DynFlags) (LogT IO) (Maybe ModuleInfo)
forall (m :: * -> *). GhcMonad m => Module -> m (Maybe ModuleInfo)
GHC.getModuleInfo Module
m MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe ModuleInfo)
-> (Maybe ModuleInfo
    -> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo)
-> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo
-> (ModuleInfo
    -> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo)
-> Maybe ModuleInfo
-> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HsDevError
-> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError
 -> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo)
-> HsDevError
-> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
BrowseNoModuleInfo String
thisModule) ModuleInfo
-> MGhcT SessionConfig (First DynFlags) (LogT IO) ModuleInfo
forall (m :: * -> *) a. Monad m => a -> m a
return
	[Symbol]
ds <- (Name -> GhcM Symbol)
-> [Name]
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [Symbol]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Name
n -> Name -> GhcM Symbol -> GhcM Symbol
lookSym Name
n (DynFlags -> ModuleInfo -> Name -> GhcM Symbol
toDecl DynFlags
df ModuleInfo
mi Name
n)) (ModuleInfo -> [Name]
GHC.modInfoExports ModuleInfo
mi)
	ModuleId
myModId <- PackageConfig -> Module -> Bool -> GhcM ModuleId
modId PackageConfig
package' Module
m Bool
exposed'
	let
		dirAssoc :: FixityDirection -> Assoc ()
dirAssoc FixityDirection
GHC.InfixL = () -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()
		dirAssoc FixityDirection
GHC.InfixR = () -> Assoc ()
forall l. l -> Assoc l
AssocRight ()
		dirAssoc FixityDirection
GHC.InfixN = () -> Assoc ()
forall l. l -> Assoc l
AssocNone ()
		fixName :: OccName -> QName ()
fixName OccName
o = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
thisModule) (() -> String -> Name ()
forall l. l -> String -> Name l
Ident () (OccName -> String
GHC.occNameString OccName
o))
	Module -> MGhcT SessionConfig (First DynFlags) (LogT IO) Module
forall (m :: * -> *) a. Monad m => a -> m a
return Module :: ModuleId
-> Maybe Text
-> [Import]
-> [Symbol]
-> [Fixity]
-> Map (QName ()) [Symbol]
-> Maybe Parsed
-> Module
Module {
		_moduleId :: ModuleId
_moduleId = ModuleId
myModId,
		_moduleDocs :: Maybe Text
_moduleDocs = Maybe Text
forall a. Maybe a
Nothing,
		_moduleImports :: [Import]
_moduleImports = [],
		_moduleExports :: [Symbol]
_moduleExports = [Symbol]
ds,
		_moduleFixities :: [Fixity]
_moduleFixities = [Assoc () -> Int -> QName () -> Fixity
Fixity (FixityDirection -> Assoc ()
dirAssoc FixityDirection
dir) Int
pr (OccName -> QName ()
fixName OccName
oname) | (OccName
oname, (Int
pr, FixityDirection
dir)) <- ((OccName, Fixity) -> (OccName, (Int, FixityDirection)))
-> [(OccName, Fixity)] -> [(OccName, (Int, FixityDirection))]
forall a b. (a -> b) -> [a] -> [b]
map ((Fixity -> (Int, FixityDirection))
-> (OccName, Fixity) -> (OccName, (Int, FixityDirection))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Fixity -> (Int, FixityDirection)
Compat.getFixity) ([(OccName, Fixity)]
-> (ModIface_ 'ModIfaceFinal -> [(OccName, Fixity)])
-> Maybe (ModIface_ 'ModIfaceFinal)
-> [(OccName, Fixity)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ModIface_ 'ModIfaceFinal -> [(OccName, Fixity)]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
GHC.mi_fixities (ModuleInfo -> Maybe (ModIface_ 'ModIfaceFinal)
GHC.modInfoIface ModuleInfo
mi))],
		_moduleScope :: Map (QName ()) [Symbol]
_moduleScope = Map (QName ()) [Symbol]
forall a. Monoid a => a
mempty,
		_moduleSource :: Maybe Parsed
_moduleSource = Maybe Parsed
forall a. Maybe a
Nothing }
	where
		thisModule :: String
thisModule = ModuleName -> String
GHC.moduleNameString (Module -> ModuleName
GHC.moduleName Module
m)
		mloc :: DynFlags -> Module -> GhcM ModuleId
mloc DynFlags
df Module
m' = do
			PackageConfig
pkg' <- MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig
-> (PackageConfig
    -> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig)
-> Maybe PackageConfig
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HsDevError
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError
 -> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig)
-> HsDevError
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
OtherError (String -> HsDevError) -> String -> HsDevError
forall a b. (a -> b) -> a -> b
$ String
"Error getting module package: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
GHC.moduleNameString (Module -> ModuleName
GHC.moduleName Module
m')) PackageConfig
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageConfig
 -> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig)
-> Maybe PackageConfig
-> MGhcT SessionConfig (First DynFlags) (LogT IO) PackageConfig
forall a b. (a -> b) -> a -> b
$
				DynFlags -> UnitId -> Maybe PackageConfig
GHC.lookupPackage DynFlags
df (Module -> UnitId
moduleUnitId Module
m')
			PackageConfig -> Module -> Bool -> GhcM ModuleId
modId PackageConfig
pkg' Module
m' (Module -> ModuleName
GHC.moduleName Module
m ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` PackageConfig -> [ModuleName]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [modulename]
GHC.hiddenModules PackageConfig
pkg')
		toDecl :: DynFlags -> ModuleInfo -> Name -> GhcM Symbol
toDecl DynFlags
df ModuleInfo
minfo Name
n = do
			Maybe TyThing
tyInfo <- ModuleInfo
-> Name
-> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing)
forall (m :: * -> *).
GhcMonad m =>
ModuleInfo -> Name -> m (Maybe TyThing)
GHC.modInfoLookupName ModuleInfo
minfo Name
n
			Maybe TyThing
tyResult <- MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing)
-> (TyThing
    -> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing))
-> Maybe TyThing
-> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name
-> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing)
forall (m :: * -> *). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName Name
n) (Maybe TyThing
-> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TyThing
 -> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing))
-> (TyThing -> Maybe TyThing)
-> TyThing
-> MGhcT SessionConfig (First DynFlags) (LogT IO) (Maybe TyThing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just) Maybe TyThing
tyInfo
			ModuleId
declModId <- DynFlags -> Module -> GhcM ModuleId
mloc DynFlags
df (HasDebugCallStack => Name -> Module
Name -> Module
GHC.nameModule Name
n)
			Symbol -> GhcM Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol :: SymbolId -> Maybe Text -> Maybe Position -> SymbolInfo -> Symbol
Symbol {
				_symbolId :: SymbolId
_symbolId = Text -> ModuleId -> SymbolId
SymbolId (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. NamedThing a => a -> String
GHC.getOccString Name
n) ModuleId
declModId,
				_symbolDocs :: Maybe Text
_symbolDocs = Maybe Text
forall a. Maybe a
Nothing,
				_symbolPosition :: Maybe Position
_symbolPosition = Maybe Position
forall a. Maybe a
Nothing,
				_symbolInfo :: SymbolInfo
_symbolInfo = SymbolInfo -> Maybe SymbolInfo -> SymbolInfo
forall a. a -> Maybe a -> a
fromMaybe (Maybe Text -> SymbolInfo
Function Maybe Text
forall a. Maybe a
Nothing) (Maybe TyThing
tyResult Maybe TyThing -> (TyThing -> Maybe SymbolInfo) -> Maybe SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DynFlags -> TyThing -> Maybe SymbolInfo
showResult DynFlags
df) }
		showResult :: GHC.DynFlags -> GHC.TyThing -> Maybe SymbolInfo
		showResult :: DynFlags -> TyThing -> Maybe SymbolInfo
showResult DynFlags
dflags (GHC.AnId Id
i) = case Id -> IdDetails
GHC.idDetails Id
i of
			GHC.RecSelId RecSelParent
p Bool
_ -> SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> [Text] -> SymbolInfo
Selector (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> Type -> String
formatType DynFlags
dflags (Type -> String) -> Type -> String
forall a b. (a -> b) -> a -> b
$ Id -> Type
GHC.varType Id
i) Text
parent [Text]
ctors where
				parent :: Text
parent = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ RecSelParent -> String
Compat.recSelParent RecSelParent
p
				ctors :: [Text]
ctors = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. IsString a => String -> a
fromString ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ RecSelParent -> [String]
Compat.recSelCtors RecSelParent
p
			GHC.ClassOpId Class
cls -> SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> SymbolInfo
Method (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> Type -> String
formatType DynFlags
dflags (Type -> String) -> Type -> String
forall a b. (a -> b) -> a -> b
$ Id -> Type
GHC.varType Id
i) (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Class -> String
forall a. NamedThing a => a -> String
GHC.getOccString Class
cls)
			IdDetails
_ -> SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text -> SymbolInfo
Function (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> Type -> String
formatType DynFlags
dflags (Type -> String) -> Type -> String
forall a b. (a -> b) -> a -> b
$Id -> Type
GHC.varType Id
i)
		showResult DynFlags
dflags (GHC.AConLike ConLike
c) = case ConLike
c of
			GHC.RealDataCon DataCon
d -> SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> SymbolInfo
Constructor
				((Type -> Text) -> [Type] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Type -> String) -> Type -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Type -> String
formatType DynFlags
dflags) ([Type] -> [Text]) -> [Type] -> [Text]
forall a b. (a -> b) -> a -> b
$ DataCon -> [Type]
GHC.dataConOrigArgTys DataCon
d)
				(String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TyCon -> String
forall a. NamedThing a => a -> String
GHC.getOccString (DataCon -> TyCon
GHC.dataConTyCon DataCon
d))
			GHC.PatSynCon PatSyn
p -> SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text -> SymbolInfo
PatConstructor
				((Type -> Text) -> [Type] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Type -> String) -> Type -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Type -> String
formatType DynFlags
dflags) ([Type] -> [Text]) -> [Type] -> [Text]
forall a b. (a -> b) -> a -> b
$ PatSyn -> [Type]
GHC.patSynArgs PatSyn
p)
				Maybe Text
forall a. Maybe a
Nothing
			-- TODO: Deal with `patSynFieldLabels` and `patSynFieldType`
		showResult DynFlags
dflags (GHC.ATyCon TyCon
t)
			| TyCon -> Bool
GHC.isTypeSynonymTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> SymbolInfo
Type [Text]
args [Text]
ctx
			| TyCon -> Bool
GHC.isPrimTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> SymbolInfo
Type [] []
			| TyCon -> Bool
GHC.isNewTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> SymbolInfo
NewType [Text]
args [Text]
ctx
			| TyCon -> Bool
GHC.isDataTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> SymbolInfo
Data [Text]
args [Text]
ctx
			| TyCon -> Bool
GHC.isClassTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> SymbolInfo
Class [Text]
args [Text]
ctx
			| TyCon -> Bool
GHC.isTypeFamilyTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> Maybe Text -> SymbolInfo
TypeFam [Text]
args [Text]
ctx Maybe Text
forall a. Maybe a
Nothing
			| TyCon -> Bool
GHC.isDataFamilyTyCon TyCon
t = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> Maybe Text -> SymbolInfo
DataFam [Text]
args [Text]
ctx Maybe Text
forall a. Maybe a
Nothing
			| Bool
otherwise = SymbolInfo -> Maybe SymbolInfo
forall a. a -> Maybe a
Just (SymbolInfo -> Maybe SymbolInfo) -> SymbolInfo -> Maybe SymbolInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> SymbolInfo
Type [] []
			where
				args :: [Text]
args = (Id -> Text) -> [Id] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Id -> String) -> Id -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Type -> String
formatType DynFlags
dflags (Type -> String) -> (Id -> Type) -> Id -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Type
GHC.mkTyVarTy) ([Id] -> [Text]) -> [Id] -> [Text]
forall a b. (a -> b) -> a -> b
$ TyCon -> [Id]
GHC.tyConTyVars TyCon
t
				ctx :: [Text]
ctx = case TyCon -> Maybe Class
GHC.tyConClass_maybe TyCon
t of
					Maybe Class
Nothing -> []
					Just Class
cls -> (Type -> Text) -> [Type] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Type -> String) -> Type -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Type -> String
formatType DynFlags
dflags) ([Type] -> [Text]) -> [Type] -> [Text]
forall a b. (a -> b) -> a -> b
$ Class -> [Type]
GHC.classSCTheta Class
cls
		showResult DynFlags
_ TyThing
_ = Maybe SymbolInfo
forall a. Maybe a
Nothing

tryT :: MonadCatch m => m a -> m (Maybe a)
tryT :: m a -> m (Maybe a)
tryT m a
act = m (Maybe a) -> (SomeException -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just m a
act) (m (Maybe a) -> SomeException -> m (Maybe a)
forall a b. a -> b -> a
const (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (SomeException -> m (Maybe a))
-> (SomeException -> SomeException) -> SomeException -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> SomeException
forall a. a -> a
id :: SomeException -> SomeException))

-- | There can be same modules (same package name, version and module name) installed in different locations
-- Select first one of such modules
uniqueModuleLocations :: [ModuleLocation] -> [ModuleLocation]
uniqueModuleLocations :: [ModuleLocation] -> [ModuleLocation]
uniqueModuleLocations = (ModuleLocation -> Maybe (ModulePackage, Text))
-> [ModuleLocation] -> [ModuleLocation]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqueBy ModuleLocation -> Maybe (ModulePackage, Text)
nameId' where
	nameId' :: ModuleLocation -> Maybe (ModulePackage, Text)
nameId' ModuleLocation
mloc = (,) (ModulePackage -> Text -> (ModulePackage, Text))
-> Maybe ModulePackage -> Maybe (Text -> (ModulePackage, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting (First ModulePackage) ModuleLocation ModulePackage
-> ModuleLocation -> Maybe ModulePackage
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ModulePackage) ModuleLocation ModulePackage
Traversal' ModuleLocation ModulePackage
modulePackage ModuleLocation
mloc) Maybe (Text -> (ModulePackage, Text))
-> Maybe Text -> Maybe (ModulePackage, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Getting (First Text) ModuleLocation Text
-> ModuleLocation -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) ModuleLocation Text
Traversal' ModuleLocation Text
installedModuleName ModuleLocation
mloc)

-- | There can be one module inspected via different packages, we can leave only one of them
uniqueInspectedModules :: [InspectedModule] -> [InspectedModule]
uniqueInspectedModules :: [InspectedModule] -> [InspectedModule]
uniqueInspectedModules = (InspectedModule -> Maybe (ModulePackage, Text))
-> [InspectedModule] -> [InspectedModule]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqueBy (ModuleLocation -> Maybe (ModulePackage, Text)
nameId' (ModuleLocation -> Maybe (ModulePackage, Text))
-> (InspectedModule -> ModuleLocation)
-> InspectedModule
-> Maybe (ModulePackage, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ModuleLocation InspectedModule ModuleLocation
-> InspectedModule -> ModuleLocation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModuleLocation InspectedModule ModuleLocation
forall k1 t a k2. Lens (Inspected k1 t a) (Inspected k2 t a) k1 k2
inspectedKey) where
	nameId' :: ModuleLocation -> Maybe (ModulePackage, Text)
nameId' ModuleLocation
mloc = (,) (ModulePackage -> Text -> (ModulePackage, Text))
-> Maybe ModulePackage -> Maybe (Text -> (ModulePackage, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting (First ModulePackage) ModuleLocation ModulePackage
-> ModuleLocation -> Maybe ModulePackage
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ModulePackage) ModuleLocation ModulePackage
Traversal' ModuleLocation ModulePackage
modulePackage ModuleLocation
mloc) Maybe (Text -> (ModulePackage, Text))
-> Maybe Text -> Maybe (ModulePackage, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Getting (First Text) ModuleLocation Text
-> ModuleLocation -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) ModuleLocation Text
Traversal' ModuleLocation Text
installedModuleName ModuleLocation
mloc)

readPackage :: GHC.PackageConfig -> ModulePackage
readPackage :: PackageConfig -> ModulePackage
readPackage PackageConfig
pc = Text -> Text -> ModulePackage
ModulePackage (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageConfig -> String
GHC.packageNameString PackageConfig
pc) (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion (PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
GHC.packageVersion PackageConfig
pc))

readPackageConfig :: GHC.PackageConfig -> PackageConfig
readPackageConfig :: PackageConfig -> PackageConfig
readPackageConfig PackageConfig
pc = ModulePackage -> [Text] -> Bool -> PackageConfig
PackageConfig
	(PackageConfig -> ModulePackage
readPackage PackageConfig
pc)
	(((ModuleName, Maybe Module) -> Text)
-> [(ModuleName, Maybe Module)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> ((ModuleName, Maybe Module) -> String)
-> (ModuleName, Maybe Module)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString (ModuleName -> String)
-> ((ModuleName, Maybe Module) -> ModuleName)
-> (ModuleName, Maybe Module)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, Maybe Module) -> ModuleName
forall a b. (a, Maybe b) -> a
Compat.exposedModuleName) ([(ModuleName, Maybe Module)] -> [Text])
-> [(ModuleName, Maybe Module)] -> [Text]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
GHC.exposedModules PackageConfig
pc)
	(PackageConfig -> Bool
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
GHC.exposed PackageConfig
pc)

ghcModuleLocation :: GHC.PackageConfig -> GHC.Module -> Bool -> ModuleLocation
ghcModuleLocation :: PackageConfig -> Module -> Bool -> ModuleLocation
ghcModuleLocation PackageConfig
p Module
m = [Text] -> ModulePackage -> Text -> Bool -> ModuleLocation
InstalledModule ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
forall a. Paths a => a -> a
normalize (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
fromFilePath) ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
GHC.libraryDirs PackageConfig
p) (PackageConfig -> ModulePackage
readPackage PackageConfig
p) (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
GHC.moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
GHC.moduleName Module
m)

ghcModuleId :: GHC.PackageConfig -> GHC.Module -> Bool -> ModuleId
ghcModuleId :: PackageConfig -> Module -> Bool -> ModuleId
ghcModuleId PackageConfig
p Module
m Bool
e = Text -> ModuleLocation -> ModuleId
ModuleId (String -> Text
forall a. IsString a => String -> a
fromString String
mname') (PackageConfig -> Module -> Bool -> ModuleLocation
ghcModuleLocation PackageConfig
p Module
m Bool
e) where
	mname' :: String
mname' = ModuleName -> String
GHC.moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
GHC.moduleName Module
m

packageConfigs :: GhcM [GHC.PackageConfig]
packageConfigs :: MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
packageConfigs = (DynFlags -> [PackageConfig])
-> MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([PackageConfig] -> Maybe [PackageConfig] -> [PackageConfig]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [PackageConfig] -> [PackageConfig])
-> (DynFlags -> Maybe [PackageConfig])
-> DynFlags
-> [PackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Maybe [PackageConfig]
pkgDatabase) MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags

packageDbModules :: GhcM [(GHC.PackageConfig, GHC.Module, Bool)]
packageDbModules :: GhcM [(PackageConfig, Module, Bool)]
packageDbModules = do
	[PackageConfig]
pkgs <- MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
packageConfigs
	DynFlags
dflags <- MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
	[(PackageConfig, Module, Bool)]
-> GhcM [(PackageConfig, Module, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(PackageConfig
p, Module
m, Bool
exposed') |
		PackageConfig
p <- [PackageConfig]
pkgs,
		(ModuleName
mn, Bool
exposed') <- [ModuleName] -> [Bool] -> [(ModuleName, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((ModuleName, Maybe Module) -> ModuleName)
-> [(ModuleName, Maybe Module)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Maybe Module) -> ModuleName
forall a b. (a, Maybe b) -> a
Compat.exposedModuleName (PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
GHC.exposedModules PackageConfig
p)) (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True) [(ModuleName, Bool)]
-> [(ModuleName, Bool)] -> [(ModuleName, Bool)]
forall a. [a] -> [a] -> [a]
++ [ModuleName] -> [Bool] -> [(ModuleName, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (PackageConfig -> [ModuleName]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [modulename]
GHC.hiddenModules PackageConfig
p) (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False),
		Module
m <- DynFlags -> ModuleName -> [Module]
Compat.lookupModule DynFlags
dflags ModuleName
mn]

-- | Get modules packages
modulesPackages :: [ModuleLocation] -> [ModulePackage]
modulesPackages :: [ModuleLocation] -> [ModulePackage]
modulesPackages = [ModulePackage] -> [ModulePackage]
forall a. Ord a => [a] -> [a]
ordNub ([ModulePackage] -> [ModulePackage])
-> ([ModuleLocation] -> [ModulePackage])
-> [ModuleLocation]
-> [ModulePackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Maybe ModulePackage)
-> [ModuleLocation] -> [ModulePackage]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Getting (First ModulePackage) ModuleLocation ModulePackage
-> ModuleLocation -> Maybe ModulePackage
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ModulePackage) ModuleLocation ModulePackage
Traversal' ModuleLocation ModulePackage
modulePackage)

-- | Group modules by packages
modulesPackagesGroups :: [ModuleLocation] -> [(ModulePackage, [ModuleLocation])]
modulesPackagesGroups :: [ModuleLocation] -> [(ModulePackage, [ModuleLocation])]
modulesPackagesGroups = ([(ModulePackage, ModuleLocation)]
 -> (ModulePackage, [ModuleLocation]))
-> [[(ModulePackage, ModuleLocation)]]
-> [(ModulePackage, [ModuleLocation])]
forall a b. (a -> b) -> [a] -> [b]
map (([ModulePackage] -> ModulePackage)
-> ([ModulePackage], [ModuleLocation])
-> (ModulePackage, [ModuleLocation])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [ModulePackage] -> ModulePackage
forall a. [a] -> a
head (([ModulePackage], [ModuleLocation])
 -> (ModulePackage, [ModuleLocation]))
-> ([(ModulePackage, ModuleLocation)]
    -> ([ModulePackage], [ModuleLocation]))
-> [(ModulePackage, ModuleLocation)]
-> (ModulePackage, [ModuleLocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ModulePackage, ModuleLocation)]
-> ([ModulePackage], [ModuleLocation])
forall a b. [(a, b)] -> ([a], [b])
unzip) ([[(ModulePackage, ModuleLocation)]]
 -> [(ModulePackage, [ModuleLocation])])
-> ([ModuleLocation] -> [[(ModulePackage, ModuleLocation)]])
-> [ModuleLocation]
-> [(ModulePackage, [ModuleLocation])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModulePackage, ModuleLocation)
 -> (ModulePackage, ModuleLocation) -> Bool)
-> [(ModulePackage, ModuleLocation)]
-> [[(ModulePackage, ModuleLocation)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (ModulePackage -> ModulePackage -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModulePackage -> ModulePackage -> Bool)
-> ((ModulePackage, ModuleLocation) -> ModulePackage)
-> (ModulePackage, ModuleLocation)
-> (ModulePackage, ModuleLocation)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ModulePackage, ModuleLocation) -> ModulePackage
forall a b. (a, b) -> a
fst) ([(ModulePackage, ModuleLocation)]
 -> [[(ModulePackage, ModuleLocation)]])
-> ([ModuleLocation] -> [(ModulePackage, ModuleLocation)])
-> [ModuleLocation]
-> [[(ModulePackage, ModuleLocation)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ModulePackage, ModuleLocation)]
-> [(ModulePackage, ModuleLocation)]
forall a. Ord a => [a] -> [a]
sort ([(ModulePackage, ModuleLocation)]
 -> [(ModulePackage, ModuleLocation)])
-> ([ModuleLocation] -> [(ModulePackage, ModuleLocation)])
-> [ModuleLocation]
-> [(ModulePackage, ModuleLocation)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Maybe (ModulePackage, ModuleLocation))
-> [ModuleLocation] -> [(ModulePackage, ModuleLocation)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ModuleLocation
m -> (,) (ModulePackage
 -> ModuleLocation -> (ModulePackage, ModuleLocation))
-> Maybe ModulePackage
-> Maybe (ModuleLocation -> (ModulePackage, ModuleLocation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First ModulePackage) ModuleLocation ModulePackage
-> ModuleLocation -> Maybe ModulePackage
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ModulePackage) ModuleLocation ModulePackage
Traversal' ModuleLocation ModulePackage
modulePackage ModuleLocation
m Maybe (ModuleLocation -> (ModulePackage, ModuleLocation))
-> Maybe ModuleLocation -> Maybe (ModulePackage, ModuleLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModuleLocation -> Maybe ModuleLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleLocation
m)

-- | Run action for each package with prepared '-package' flags
withEachPackage :: (ModulePackage -> [ModuleLocation] -> GhcM a) -> [ModuleLocation] -> GhcM [a]
withEachPackage :: (ModulePackage -> [ModuleLocation] -> GhcM a)
-> [ModuleLocation] -> GhcM [a]
withEachPackage ModulePackage -> [ModuleLocation] -> GhcM a
act = ((ModulePackage, [ModuleLocation]) -> GhcM a)
-> [(ModulePackage, [ModuleLocation])] -> GhcM [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ModulePackage -> [ModuleLocation] -> GhcM a)
-> (ModulePackage, [ModuleLocation]) -> GhcM a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ModulePackage -> [ModuleLocation] -> GhcM a
act') ([(ModulePackage, [ModuleLocation])] -> GhcM [a])
-> ([ModuleLocation] -> [(ModulePackage, [ModuleLocation])])
-> [ModuleLocation]
-> GhcM [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleLocation] -> [(ModulePackage, [ModuleLocation])]
modulesPackagesGroups where
	act' :: ModulePackage -> [ModuleLocation] -> GhcM a
act' ModulePackage
mpkg [ModuleLocation]
mlocs = GhcM ()
setPackagesOpts GhcM () -> GhcM a -> GhcM a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModulePackage -> [ModuleLocation] -> GhcM a
act ModulePackage
mpkg [ModuleLocation]
mlocs where
		packagesOpts :: [String]
packagesOpts = String
"-hide-all-packages" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
"-package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModulePackage -> String
forall a. Show a => a -> String
show ModulePackage
p | ModulePackage
p <- [ModuleLocation] -> [ModulePackage]
modulesPackages [ModuleLocation]
mlocs]
		setPackagesOpts :: GhcM ()
setPackagesOpts = MGhcT SessionConfig (First DynFlags) (LogT IO) [InstalledUnitId]
-> GhcM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MGhcT SessionConfig (First DynFlags) (LogT IO) [InstalledUnitId]
 -> GhcM ())
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [InstalledUnitId]
-> GhcM ()
forall a b. (a -> b) -> a -> b
$ do
			DynFlags
fs <- MGhcT SessionConfig (First DynFlags) (LogT IO) DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
			(DynFlags
fs', [Located String]
_, [Warn]
_) <- DynFlags
-> [Located String]
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (DynFlags, [Located String], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
GHC.parseDynamicFlags (DynFlags
fs { packageFlags :: [PackageFlag]
GHC.packageFlags = [] }) ((String -> Located String) -> [String] -> [Located String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Located String
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc [String]
packagesOpts)
			(DynFlags
fs'', [InstalledUnitId]
_) <- IO (DynFlags, [InstalledUnitId])
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (DynFlags, [InstalledUnitId])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GHC.liftIO (IO (DynFlags, [InstalledUnitId])
 -> MGhcT
      SessionConfig
      (First DynFlags)
      (LogT IO)
      (DynFlags, [InstalledUnitId]))
-> IO (DynFlags, [InstalledUnitId])
-> MGhcT
     SessionConfig
     (First DynFlags)
     (LogT IO)
     (DynFlags, [InstalledUnitId])
forall a b. (a -> b) -> a -> b
$ DynFlags -> IO (DynFlags, [InstalledUnitId])
GHC.initPackages DynFlags
fs'
			DynFlags
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [InstalledUnitId]
forall (m :: * -> *). GhcMonad m => DynFlags -> m [InstalledUnitId]
GHC.setSessionDynFlags DynFlags
fs''