{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
module Development.IDE.Types.Exports
(
    IdentInfo(..),
    ExportsMap(..),
    createExportsMap,
    createExportsMapMg,
    createExportsMapTc,
    buildModuleExportMapFrom,
    createExportsMapHieDb,
    size,
    ) where

import           Control.DeepSeq             (NFData (..))
import           Control.Monad
import           Data.Bifunctor              (Bifunctor (second))
import           Data.HashMap.Strict         (HashMap, elems)
import qualified Data.HashMap.Strict         as Map
import           Data.HashSet                (HashSet)
import qualified Data.HashSet                as Set
import           Data.Hashable               (Hashable)
import           Data.List                   (isSuffixOf)
import           Data.Text                   (Text, pack)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Orphans ()
import           Development.IDE.GHC.Util
import           GHC.Generics                (Generic)
import           HieDb


data ExportsMap = ExportsMap
    {ExportsMap -> HashMap IdentifierText (HashSet IdentInfo)
getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)
    , ExportsMap -> HashMap IdentifierText (HashSet IdentInfo)
getModuleExportsMap :: Map.HashMap ModuleNameText (HashSet IdentInfo)
    }
    deriving (Int -> ExportsMap -> ShowS
[ExportsMap] -> ShowS
ExportsMap -> String
(Int -> ExportsMap -> ShowS)
-> (ExportsMap -> String)
-> ([ExportsMap] -> ShowS)
-> Show ExportsMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportsMap] -> ShowS
$cshowList :: [ExportsMap] -> ShowS
show :: ExportsMap -> String
$cshow :: ExportsMap -> String
showsPrec :: Int -> ExportsMap -> ShowS
$cshowsPrec :: Int -> ExportsMap -> ShowS
Show)

size :: ExportsMap -> Int
size :: ExportsMap -> Int
size = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (ExportsMap -> [Int]) -> ExportsMap -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashSet IdentInfo -> Int) -> [HashSet IdentInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map HashSet IdentInfo -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([HashSet IdentInfo] -> [Int])
-> (ExportsMap -> [HashSet IdentInfo]) -> ExportsMap -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap IdentifierText (HashSet IdentInfo) -> [HashSet IdentInfo]
forall k v. HashMap k v -> [v]
elems (HashMap IdentifierText (HashSet IdentInfo) -> [HashSet IdentInfo])
-> (ExportsMap -> HashMap IdentifierText (HashSet IdentInfo))
-> ExportsMap
-> [HashSet IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportsMap -> HashMap IdentifierText (HashSet IdentInfo)
getExportsMap

instance Semigroup ExportsMap where
  ExportsMap HashMap IdentifierText (HashSet IdentInfo)
a HashMap IdentifierText (HashSet IdentInfo)
b <> :: ExportsMap -> ExportsMap -> ExportsMap
<> ExportsMap HashMap IdentifierText (HashSet IdentInfo)
c HashMap IdentifierText (HashSet IdentInfo)
d = HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
ExportsMap ((HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
Map.unionWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) HashMap IdentifierText (HashSet IdentInfo)
a HashMap IdentifierText (HashSet IdentInfo)
c) ((HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
Map.unionWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) HashMap IdentifierText (HashSet IdentInfo)
b HashMap IdentifierText (HashSet IdentInfo)
d)

instance Monoid ExportsMap where
  mempty :: ExportsMap
mempty = HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
ExportsMap HashMap IdentifierText (HashSet IdentInfo)
forall k v. HashMap k v
Map.empty HashMap IdentifierText (HashSet IdentInfo)
forall k v. HashMap k v
Map.empty

type IdentifierText = Text
type ModuleNameText = Text

data IdentInfo = IdentInfo
    { IdentInfo -> OccName
name           :: !OccName
    , IdentInfo -> IdentifierText
rendered       :: Text
    , IdentInfo -> Maybe IdentifierText
parent         :: !(Maybe Text)
    , IdentInfo -> Bool
isDatacon      :: !Bool
    , IdentInfo -> IdentifierText
moduleNameText :: !Text
    }
    deriving ((forall x. IdentInfo -> Rep IdentInfo x)
-> (forall x. Rep IdentInfo x -> IdentInfo) -> Generic IdentInfo
forall x. Rep IdentInfo x -> IdentInfo
forall x. IdentInfo -> Rep IdentInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentInfo x -> IdentInfo
$cfrom :: forall x. IdentInfo -> Rep IdentInfo x
Generic, Int -> IdentInfo -> ShowS
[IdentInfo] -> ShowS
IdentInfo -> String
(Int -> IdentInfo -> ShowS)
-> (IdentInfo -> String)
-> ([IdentInfo] -> ShowS)
-> Show IdentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentInfo] -> ShowS
$cshowList :: [IdentInfo] -> ShowS
show :: IdentInfo -> String
$cshow :: IdentInfo -> String
showsPrec :: Int -> IdentInfo -> ShowS
$cshowsPrec :: Int -> IdentInfo -> ShowS
Show)
    deriving anyclass Int -> IdentInfo -> Int
IdentInfo -> Int
(Int -> IdentInfo -> Int)
-> (IdentInfo -> Int) -> Hashable IdentInfo
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: IdentInfo -> Int
$chash :: IdentInfo -> Int
hashWithSalt :: Int -> IdentInfo -> Int
$chashWithSalt :: Int -> IdentInfo -> Int
Hashable

instance Eq IdentInfo where
    IdentInfo
a == :: IdentInfo -> IdentInfo -> Bool
== IdentInfo
b = IdentInfo -> OccName
name IdentInfo
a OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> OccName
name IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> Maybe IdentifierText
parent IdentInfo
a Maybe IdentifierText -> Maybe IdentifierText -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> Maybe IdentifierText
parent IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> Bool
isDatacon IdentInfo
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> Bool
isDatacon IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> IdentifierText
moduleNameText IdentInfo
a IdentifierText -> IdentifierText -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> IdentifierText
moduleNameText IdentInfo
b

instance NFData IdentInfo where
    rnf :: IdentInfo -> ()
rnf IdentInfo{Bool
Maybe IdentifierText
IdentifierText
OccName
moduleNameText :: IdentifierText
isDatacon :: Bool
parent :: Maybe IdentifierText
rendered :: IdentifierText
name :: OccName
moduleNameText :: IdentInfo -> IdentifierText
isDatacon :: IdentInfo -> Bool
parent :: IdentInfo -> Maybe IdentifierText
rendered :: IdentInfo -> IdentifierText
name :: IdentInfo -> OccName
..} =
        -- deliberately skip the rendered field
        OccName -> ()
forall a. NFData a => a -> ()
rnf OccName
name () -> () -> ()
`seq` Maybe IdentifierText -> ()
forall a. NFData a => a -> ()
rnf Maybe IdentifierText
parent () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
isDatacon () -> () -> ()
`seq` IdentifierText -> ()
forall a. NFData a => a -> ()
rnf IdentifierText
moduleNameText

-- | Render an identifier as imported or exported style.
-- TODO: pattern synonym
renderIEWrapped :: Name -> Text
renderIEWrapped :: Name -> IdentifierText
renderIEWrapped Name
n
  | OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
occ = IdentifierText
"type " IdentifierText -> IdentifierText -> IdentifierText
forall a. Semigroup a => a -> a -> a
<> String -> IdentifierText
pack (Name -> String
printName Name
n)
  | Bool
otherwise = String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
n
  where
    occ :: OccName
occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
n

mkIdentInfos :: Text -> AvailInfo -> [IdentInfo]
mkIdentInfos :: IdentifierText -> AvailInfo -> [IdentInfo]
mkIdentInfos IdentifierText
mod (AvailName Name
n) =
    [OccName
-> IdentifierText
-> Maybe IdentifierText
-> Bool
-> IdentifierText
-> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) (Name -> IdentifierText
renderIEWrapped Name
n) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n) IdentifierText
mod]
mkIdentInfos IdentifierText
mod (AvailFL FieldLabel
fl) =
    [OccName
-> IdentifierText
-> Maybe IdentifierText
-> Bool
-> IdentifierText
-> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) (Name -> IdentifierText
renderIEWrapped Name
n) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n) IdentifierText
mod]
    where
      n :: Name
n = FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
fl
mkIdentInfos IdentifierText
mod (AvailTC Name
parent (Name
n:[Name]
nn) [FieldLabel]
flds)
    -- Following the GHC convention that parent == n if parent is exported
    | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
parent
    = [ OccName
-> IdentifierText
-> Maybe IdentifierText
-> Bool
-> IdentifierText
-> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) (Name -> IdentifierText
renderIEWrapped Name
n) (IdentifierText -> Maybe IdentifierText
forall a. a -> Maybe a
Just (IdentifierText -> Maybe IdentifierText)
-> IdentifierText -> Maybe IdentifierText
forall a b. (a -> b) -> a -> b
$! IdentifierText
parentP) (Name -> Bool
isDataConName Name
n) IdentifierText
mod
        | Name
n <- [Name]
nn [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector [FieldLabel]
flds
      ] [IdentInfo] -> [IdentInfo] -> [IdentInfo]
forall a. [a] -> [a] -> [a]
++
      [ OccName
-> IdentifierText
-> Maybe IdentifierText
-> Bool
-> IdentifierText
-> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) (Name -> IdentifierText
renderIEWrapped Name
n) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n) IdentifierText
mod]
    where
        parentP :: IdentifierText
parentP = String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
parent

mkIdentInfos IdentifierText
mod (AvailTC Name
_ [Name]
nn [FieldLabel]
flds)
    = [ OccName
-> IdentifierText
-> Maybe IdentifierText
-> Bool
-> IdentifierText
-> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) (Name -> IdentifierText
renderIEWrapped Name
n) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n) IdentifierText
mod
        | Name
n <- [Name]
nn [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector [FieldLabel]
flds
      ]

createExportsMap :: [ModIface] -> ExportsMap
createExportsMap :: [ModIface] -> ExportsMap
createExportsMap [ModIface]
modIface = do
  let exportList :: [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList = (ModIface -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> [ModIface]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModIface -> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (phase :: ModIfacePhase).
ModIface_ phase
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
doOne [ModIface]
modIface
  let exportsMap :: HashMap IdentifierText (HashSet IdentInfo)
exportsMap = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ([(IdentifierText, HashSet IdentInfo)]
 -> HashMap IdentifierText (HashSet IdentInfo))
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((IdentifierText, IdentifierText, HashSet IdentInfo)
 -> (IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
-> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IdentifierText
a,IdentifierText
_,HashSet IdentInfo
c) -> (IdentifierText
a, HashSet IdentInfo
c)) [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList
  HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
ExportsMap HashMap IdentifierText (HashSet IdentInfo)
exportsMap (HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
buildModuleExportMap ([(IdentifierText, HashSet IdentInfo)]
 -> HashMap IdentifierText (HashSet IdentInfo))
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((IdentifierText, IdentifierText, HashSet IdentInfo)
 -> (IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
-> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IdentifierText
_,IdentifierText
b,HashSet IdentInfo
c) -> (IdentifierText
b, HashSet IdentInfo
c)) [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList
  where
    doOne :: ModIface_ phase
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
doOne ModIface_ phase
modIFace = do
      let getModDetails :: AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
getModDetails = ModuleName
-> AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
unpackAvail (ModuleName
 -> AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])])
-> ModuleName
-> AvailInfo
-> [(IdentifierText, IdentifierText, [IdentInfo])]
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModIface_ phase -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface_ phase
modIFace
      (AvailInfo
 -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> [AvailInfo]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((IdentifierText, IdentifierText, [IdentInfo])
 -> (IdentifierText, IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, [IdentInfo])]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([IdentInfo] -> HashSet IdentInfo)
-> (IdentifierText, IdentifierText, [IdentInfo])
-> (IdentifierText, IdentifierText, HashSet IdentInfo)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [IdentInfo] -> HashSet IdentInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList) ([(IdentifierText, IdentifierText, [IdentInfo])]
 -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> (AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])])
-> AvailInfo
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
getModDetails) (ModIface_ phase -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface_ phase
modIFace)

createExportsMapMg :: [ModGuts] -> ExportsMap
createExportsMapMg :: [ModGuts] -> ExportsMap
createExportsMapMg [ModGuts]
modGuts = do
  let exportList :: [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList = (ModGuts -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> [ModGuts]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModGuts -> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
doOne [ModGuts]
modGuts
  let exportsMap :: HashMap IdentifierText (HashSet IdentInfo)
exportsMap = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ([(IdentifierText, HashSet IdentInfo)]
 -> HashMap IdentifierText (HashSet IdentInfo))
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((IdentifierText, IdentifierText, HashSet IdentInfo)
 -> (IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
-> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IdentifierText
a,IdentifierText
_,HashSet IdentInfo
c) -> (IdentifierText
a, HashSet IdentInfo
c)) [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList
  HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
ExportsMap HashMap IdentifierText (HashSet IdentInfo)
exportsMap (HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
buildModuleExportMap ([(IdentifierText, HashSet IdentInfo)]
 -> HashMap IdentifierText (HashSet IdentInfo))
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((IdentifierText, IdentifierText, HashSet IdentInfo)
 -> (IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
-> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IdentifierText
_,IdentifierText
b,HashSet IdentInfo
c) -> (IdentifierText
b, HashSet IdentInfo
c)) [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList
  where
    doOne :: ModGuts -> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
doOne ModGuts
mi = do
      let getModuleName :: ModuleName
getModuleName = Module -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModGuts -> Module
mg_module ModGuts
mi
      (AvailInfo
 -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> [AvailInfo]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((IdentifierText, IdentifierText, [IdentInfo])
 -> (IdentifierText, IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, [IdentInfo])]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([IdentInfo] -> HashSet IdentInfo)
-> (IdentifierText, IdentifierText, [IdentInfo])
-> (IdentifierText, IdentifierText, HashSet IdentInfo)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [IdentInfo] -> HashSet IdentInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList) ([(IdentifierText, IdentifierText, [IdentInfo])]
 -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> (AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])])
-> AvailInfo
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName
-> AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
unpackAvail ModuleName
getModuleName) (ModGuts -> [AvailInfo]
mg_exports ModGuts
mi)

createExportsMapTc :: [TcGblEnv] -> ExportsMap
createExportsMapTc :: [TcGblEnv] -> ExportsMap
createExportsMapTc [TcGblEnv]
modIface = do
  let exportList :: [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList = (TcGblEnv -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> [TcGblEnv]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TcGblEnv -> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
doOne [TcGblEnv]
modIface
  let exportsMap :: HashMap IdentifierText (HashSet IdentInfo)
exportsMap = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ([(IdentifierText, HashSet IdentInfo)]
 -> HashMap IdentifierText (HashSet IdentInfo))
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((IdentifierText, IdentifierText, HashSet IdentInfo)
 -> (IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
-> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IdentifierText
a,IdentifierText
_,HashSet IdentInfo
c) -> (IdentifierText
a, HashSet IdentInfo
c)) [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList
  HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
ExportsMap HashMap IdentifierText (HashSet IdentInfo)
exportsMap (HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
buildModuleExportMap ([(IdentifierText, HashSet IdentInfo)]
 -> HashMap IdentifierText (HashSet IdentInfo))
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((IdentifierText, IdentifierText, HashSet IdentInfo)
 -> (IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
-> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IdentifierText
_,IdentifierText
b,HashSet IdentInfo
c) -> (IdentifierText
b, HashSet IdentInfo
c)) [(IdentifierText, IdentifierText, HashSet IdentInfo)]
exportList
  where
    doOne :: TcGblEnv -> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
doOne TcGblEnv
mi = do
      let getModuleName :: ModuleName
getModuleName = Module -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> Module
tcg_mod TcGblEnv
mi
      (AvailInfo
 -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> [AvailInfo]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((IdentifierText, IdentifierText, [IdentInfo])
 -> (IdentifierText, IdentifierText, HashSet IdentInfo))
-> [(IdentifierText, IdentifierText, [IdentInfo])]
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([IdentInfo] -> HashSet IdentInfo)
-> (IdentifierText, IdentifierText, [IdentInfo])
-> (IdentifierText, IdentifierText, HashSet IdentInfo)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [IdentInfo] -> HashSet IdentInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList) ([(IdentifierText, IdentifierText, [IdentInfo])]
 -> [(IdentifierText, IdentifierText, HashSet IdentInfo)])
-> (AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])])
-> AvailInfo
-> [(IdentifierText, IdentifierText, HashSet IdentInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName
-> AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
unpackAvail ModuleName
getModuleName) (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
mi)

nonInternalModules :: ModuleName -> Bool
nonInternalModules :: ModuleName -> Bool
nonInternalModules = Bool -> Bool
not (Bool -> Bool) -> (ModuleName -> Bool) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
".Internal" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) (String -> Bool) -> (ModuleName -> String) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString

createExportsMapHieDb :: HieDb -> IO ExportsMap
createExportsMapHieDb :: HieDb -> IO ExportsMap
createExportsMapHieDb HieDb
hiedb = do
    [HieModuleRow]
mods <- HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
hiedb
    [[(IdentifierText, HashSet IdentInfo)]]
idents <- [HieModuleRow]
-> (HieModuleRow -> IO [(IdentifierText, HashSet IdentInfo)])
-> IO [[(IdentifierText, HashSet IdentInfo)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((HieModuleRow -> Bool) -> [HieModuleRow] -> [HieModuleRow]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> Bool
nonInternalModules (ModuleName -> Bool)
-> (HieModuleRow -> ModuleName) -> HieModuleRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> ModuleName
modInfoName (ModuleInfo -> ModuleName)
-> (HieModuleRow -> ModuleInfo) -> HieModuleRow -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieModuleRow -> ModuleInfo
hieModInfo) [HieModuleRow]
mods) ((HieModuleRow -> IO [(IdentifierText, HashSet IdentInfo)])
 -> IO [[(IdentifierText, HashSet IdentInfo)]])
-> (HieModuleRow -> IO [(IdentifierText, HashSet IdentInfo)])
-> IO [[(IdentifierText, HashSet IdentInfo)]]
forall a b. (a -> b) -> a -> b
$ \HieModuleRow
m -> do
        let mn :: ModuleName
mn = ModuleInfo -> ModuleName
modInfoName (ModuleInfo -> ModuleName) -> ModuleInfo -> ModuleName
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
m
            mText :: IdentifierText
mText = String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mn
        (ExportRow -> (IdentifierText, HashSet IdentInfo))
-> [ExportRow] -> [(IdentifierText, HashSet IdentInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IdentInfo -> (IdentifierText, HashSet IdentInfo)
wrap (IdentInfo -> (IdentifierText, HashSet IdentInfo))
-> (ExportRow -> IdentInfo)
-> ExportRow
-> (IdentifierText, HashSet IdentInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierText -> ExportRow -> IdentInfo
unwrap IdentifierText
mText) ([ExportRow] -> [(IdentifierText, HashSet IdentInfo)])
-> IO [ExportRow] -> IO [(IdentifierText, HashSet IdentInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieDb -> ModuleName -> IO [ExportRow]
getExportsForModule HieDb
hiedb ModuleName
mn
    let exportsMap :: HashMap IdentifierText (HashSet IdentInfo)
exportsMap = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ([[(IdentifierText, HashSet IdentInfo)]]
-> [(IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(IdentifierText, HashSet IdentInfo)]]
idents)
    ExportsMap -> IO ExportsMap
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportsMap -> IO ExportsMap) -> ExportsMap -> IO ExportsMap
forall a b. (a -> b) -> a -> b
$ HashMap IdentifierText (HashSet IdentInfo)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
ExportsMap HashMap IdentifierText (HashSet IdentInfo)
exportsMap (HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap)
-> HashMap IdentifierText (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
buildModuleExportMap ([[(IdentifierText, HashSet IdentInfo)]]
-> [(IdentifierText, HashSet IdentInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(IdentifierText, HashSet IdentInfo)]]
idents)
  where
    wrap :: IdentInfo -> (IdentifierText, HashSet IdentInfo)
wrap IdentInfo
identInfo = (IdentInfo -> IdentifierText
rendered IdentInfo
identInfo, [IdentInfo] -> HashSet IdentInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [IdentInfo
identInfo])
    -- unwrap :: ExportRow -> IdentInfo
    unwrap :: IdentifierText -> ExportRow -> IdentInfo
unwrap IdentifierText
m ExportRow{Bool
String
Maybe ModuleName
Maybe Unit
Maybe OccName
ModuleName
Unit
OccName
exportHieFile :: ExportRow -> String
exportName :: ExportRow -> OccName
exportMod :: ExportRow -> ModuleName
exportUnit :: ExportRow -> Unit
exportParent :: ExportRow -> Maybe OccName
exportParentMod :: ExportRow -> Maybe ModuleName
exportParentUnit :: ExportRow -> Maybe Unit
exportIsDatacon :: ExportRow -> Bool
exportIsDatacon :: Bool
exportParentUnit :: Maybe Unit
exportParentMod :: Maybe ModuleName
exportParent :: Maybe OccName
exportUnit :: Unit
exportMod :: ModuleName
exportName :: OccName
exportHieFile :: String
..} = OccName
-> IdentifierText
-> Maybe IdentifierText
-> Bool
-> IdentifierText
-> IdentInfo
IdentInfo OccName
exportName IdentifierText
n Maybe IdentifierText
p Bool
exportIsDatacon IdentifierText
m
      where
          n :: IdentifierText
n = String -> IdentifierText
pack (OccName -> String
occNameString OccName
exportName)
          p :: Maybe IdentifierText
p = String -> IdentifierText
pack (String -> IdentifierText)
-> (OccName -> String) -> OccName -> IdentifierText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString (OccName -> IdentifierText)
-> Maybe OccName -> Maybe IdentifierText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OccName
exportParent

unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])]
unpackAvail :: ModuleName
-> AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
unpackAvail ModuleName
mn
  | ModuleName -> Bool
nonInternalModules ModuleName
mn = (IdentInfo -> (IdentifierText, IdentifierText, [IdentInfo]))
-> [IdentInfo] -> [(IdentifierText, IdentifierText, [IdentInfo])]
forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> (IdentifierText, IdentifierText, [IdentInfo])
f ([IdentInfo] -> [(IdentifierText, IdentifierText, [IdentInfo])])
-> (AvailInfo -> [IdentInfo])
-> AvailInfo
-> [(IdentifierText, IdentifierText, [IdentInfo])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierText -> AvailInfo -> [IdentInfo]
mkIdentInfos IdentifierText
mod
  | Bool
otherwise = [(IdentifierText, IdentifierText, [IdentInfo])]
-> AvailInfo -> [(IdentifierText, IdentifierText, [IdentInfo])]
forall a b. a -> b -> a
const []
  where
    !mod :: IdentifierText
mod = String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mn
    f :: IdentInfo -> (IdentifierText, IdentifierText, [IdentInfo])
f id :: IdentInfo
id@IdentInfo {Bool
Maybe IdentifierText
IdentifierText
OccName
moduleNameText :: IdentifierText
isDatacon :: Bool
parent :: Maybe IdentifierText
rendered :: IdentifierText
name :: OccName
moduleNameText :: IdentInfo -> IdentifierText
isDatacon :: IdentInfo -> Bool
parent :: IdentInfo -> Maybe IdentifierText
rendered :: IdentInfo -> IdentifierText
name :: IdentInfo -> OccName
..} = (String -> IdentifierText
pack (OccName -> String
forall a. Outputable a => a -> String
prettyPrint OccName
name), IdentifierText
moduleNameText,[IdentInfo
id])


identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo)
identInfoToKeyVal :: IdentInfo -> (IdentifierText, IdentInfo)
identInfoToKeyVal IdentInfo
identInfo =
  (IdentInfo -> IdentifierText
moduleNameText IdentInfo
identInfo, IdentInfo
identInfo)

buildModuleExportMap:: [(Text, HashSet IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
buildModuleExportMap :: [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
buildModuleExportMap [(IdentifierText, HashSet IdentInfo)]
exportsMap = do
  let lst :: [IdentInfo]
lst = ((IdentifierText, HashSet IdentInfo) -> [IdentInfo])
-> [(IdentifierText, HashSet IdentInfo)] -> [IdentInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList(HashSet IdentInfo -> [IdentInfo])
-> ((IdentifierText, HashSet IdentInfo) -> HashSet IdentInfo)
-> (IdentifierText, HashSet IdentInfo)
-> [IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentifierText, HashSet IdentInfo) -> HashSet IdentInfo
forall a b. (a, b) -> b
snd) [(IdentifierText, HashSet IdentInfo)]
exportsMap
  let lstThree :: [(IdentifierText, IdentInfo)]
lstThree = (IdentInfo -> (IdentifierText, IdentInfo))
-> [IdentInfo] -> [(IdentifierText, IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> (IdentifierText, IdentInfo)
identInfoToKeyVal [IdentInfo]
lst
  [(IdentifierText, IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
sortAndGroup [(IdentifierText, IdentInfo)]
lstThree

buildModuleExportMapFrom:: [ModIface] -> Map.HashMap Text (HashSet IdentInfo)
buildModuleExportMapFrom :: [ModIface] -> HashMap IdentifierText (HashSet IdentInfo)
buildModuleExportMapFrom [ModIface]
modIfaces = do
  let exports :: [(IdentifierText, HashSet IdentInfo)]
exports = (ModIface -> (IdentifierText, HashSet IdentInfo))
-> [ModIface] -> [(IdentifierText, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ModIface -> (IdentifierText, HashSet IdentInfo)
extractModuleExports [ModIface]
modIfaces
  (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) [(IdentifierText, HashSet IdentInfo)]
exports

extractModuleExports :: ModIface -> (Text, HashSet IdentInfo)
extractModuleExports :: ModIface -> (IdentifierText, HashSet IdentInfo)
extractModuleExports ModIface
modIFace = do
  let modName :: IdentifierText
modName = String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
modIFace
  let functionSet :: HashSet IdentInfo
functionSet = [IdentInfo] -> HashSet IdentInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([IdentInfo] -> HashSet IdentInfo)
-> [IdentInfo] -> HashSet IdentInfo
forall a b. (a -> b) -> a -> b
$ (AvailInfo -> [IdentInfo]) -> [AvailInfo] -> [IdentInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (IdentifierText -> AvailInfo -> [IdentInfo]
mkIdentInfos IdentifierText
modName) ([AvailInfo] -> [IdentInfo]) -> [AvailInfo] -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$ ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
modIFace
  (IdentifierText
modName, HashSet IdentInfo
functionSet)

sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
sortAndGroup :: [(IdentifierText, IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
sortAndGroup [(IdentifierText, IdentInfo)]
assocs = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(IdentifierText, HashSet IdentInfo)]
-> HashMap IdentifierText (HashSet IdentInfo)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) [(IdentifierText
k, [IdentInfo] -> HashSet IdentInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [IdentInfo
v]) | (IdentifierText
k, IdentInfo
v) <- [(IdentifierText, IdentInfo)]
assocs]