{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RankNTypes         #-}
module Development.IDE.Types.Exports
(
    IdentInfo(..),
    ExportsMap(..),
    rendered,
    moduleNameText,
    occNameText,
    renderOcc,
    mkTypeOcc,
    mkVarOrDataOcc,
    isDatacon,
    createExportsMap,
    createExportsMapMg,
    buildModuleExportMapFrom,
    createExportsMapHieDb,
    size,
    exportsMapSize,
    updateExportsMapMg
    ) where

import           Control.DeepSeq             (NFData (..), force, ($!!))
import           Control.Monad
import           Data.Bifunctor              (Bifunctor (second))
import           Data.Char                   (isUpper)
import           Data.Hashable               (Hashable)
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.List                   (foldl', isSuffixOf)
import           Data.Text                   (Text, uncons)
import           Data.Text.Encoding          (decodeUtf8, encodeUtf8)
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 -> OccEnv (HashSet IdentInfo)
getExportsMap       :: !(OccEnv (HashSet IdentInfo))
    , ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap :: !(ModuleNameEnv (HashSet IdentInfo))
    }

instance NFData ExportsMap where
  rnf :: ExportsMap -> ()
rnf (ExportsMap OccEnv (HashSet IdentInfo)
a ModuleNameEnv (HashSet IdentInfo)
b) = forall a b. (a -> b -> b) -> b -> OccEnv a -> b
foldOccEnv (\HashSet IdentInfo
a ()
b -> forall a. NFData a => a -> ()
rnf HashSet IdentInfo
a seq :: forall a b. a -> b -> b
`seq` ()
b) (forall elt key. ([elt] -> ()) -> UniqFM key elt -> ()
seqEltsUFM forall a. NFData a => a -> ()
rnf ModuleNameEnv (HashSet IdentInfo)
b) OccEnv (HashSet IdentInfo)
a

instance Show ExportsMap where
  show :: ExportsMap -> [Char]
show (ExportsMap OccEnv (HashSet IdentInfo)
occs ModuleNameEnv (HashSet IdentInfo)
mods) =
    [[Char]] -> [Char]
unwords [ [Char]
"ExportsMap { getExportsMap ="
            , forall a. Outputable a => a -> [Char]
printWithoutUniques forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> OccEnv a -> OccEnv b
mapOccEnv ([Char] -> SDoc
textDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) OccEnv (HashSet IdentInfo)
occs
            , [Char]
"getModuleExportsMap ="
            , forall a. Outputable a => a -> [Char]
printWithoutUniques forall a b. (a -> b) -> a -> b
$ forall elt1 elt2 key.
(elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapUFM ([Char] -> SDoc
textDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) ModuleNameEnv (HashSet IdentInfo)
mods
            , [Char]
"}"
            ]

-- | `updateExportsMap old new` results in an export map containing
-- the union of old and new, but with all the module entries new overriding
-- those in old.
updateExportsMap :: ExportsMap -> ExportsMap -> ExportsMap
updateExportsMap :: ExportsMap -> ExportsMap -> ExportsMap
updateExportsMap ExportsMap
old ExportsMap
new = ExportsMap
  { getExportsMap :: OccEnv (HashSet IdentInfo)
getExportsMap = forall a. OccEnv a -> [OccName] -> OccEnv a
delListFromOccEnv (ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
old) [OccName]
old_occs forall a. OccEnv a -> OccEnv a -> OccEnv a
`plusOccEnv` ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
new -- plusOccEnv is right biased
  , getModuleExportsMap :: ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap = (ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
old) forall key elt. UniqFM key elt -> UniqFM key elt -> UniqFM key elt
`plusUFM` (ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
new) -- plusUFM is right biased
  }
  where old_occs :: [OccName]
old_occs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> OccName
name forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
Set.toList (forall key elt. UniqFM key elt -> elt -> Unique -> elt
lookupWithDefaultUFM_Directly (ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
old) forall a. Monoid a => a
mempty Unique
m_uniq)
                          | Unique
m_uniq <- forall key elt. UniqFM key elt -> [Unique]
nonDetKeysUFM (ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
new)]

size :: ExportsMap -> Int
size :: ExportsMap -> Int
size = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. HashSet a -> Int
Set.size) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OccEnv a -> [a]
nonDetOccEnvElts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap

mkVarOrDataOcc :: Text -> OccName
mkVarOrDataOcc :: Text -> OccName
mkVarOrDataOcc Text
t = FastString -> OccName
mkOcc forall a b. (a -> b) -> a -> b
$ ByteString -> FastString
mkFastStringByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
  where
    mkOcc :: FastString -> OccName
mkOcc
      | Just (Char
c,Text
_) <- Text -> Maybe (Char, Text)
uncons Text
t
      , Char
c forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
c = FastString -> OccName
mkDataOccFS
      | Bool
otherwise = FastString -> OccName
mkVarOccFS

mkTypeOcc :: Text -> OccName
mkTypeOcc :: Text -> OccName
mkTypeOcc Text
t = FastString -> OccName
mkTcOccFS forall a b. (a -> b) -> a -> b
$ ByteString -> FastString
mkFastStringByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t

exportsMapSize :: ExportsMap -> Int
exportsMapSize :: ExportsMap -> Int
exportsMapSize = forall a b. (a -> b -> b) -> b -> OccEnv a -> b
foldOccEnv (\HashSet IdentInfo
_ Int
x -> Int
xforall a. Num a => a -> a -> a
+Int
1) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap

instance Semigroup ExportsMap where
  ExportsMap OccEnv (HashSet IdentInfo)
a ModuleNameEnv (HashSet IdentInfo)
b <> :: ExportsMap -> ExportsMap -> ExportsMap
<> ExportsMap OccEnv (HashSet IdentInfo)
c ModuleNameEnv (HashSet IdentInfo)
d = OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap (forall a. (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C forall a. Semigroup a => a -> a -> a
(<>) OccEnv (HashSet IdentInfo)
a OccEnv (HashSet IdentInfo)
c) (forall elt key.
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C forall a. Semigroup a => a -> a -> a
(<>) ModuleNameEnv (HashSet IdentInfo)
b ModuleNameEnv (HashSet IdentInfo)
d)

instance Monoid ExportsMap where
  mempty :: ExportsMap
mempty = OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap forall a. OccEnv a
emptyOccEnv forall key elt. UniqFM key elt
emptyUFM

rendered :: IdentInfo -> Text
rendered :: IdentInfo -> Text
rendered = OccName -> Text
occNameText forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> OccName
name

-- | Render an identifier as imported or exported style.
-- TODO: pattern synonymoccNameText :: OccName -> Text
occNameText :: OccName -> Text
occNameText :: OccName -> Text
occNameText OccName
name
  | OccName -> Bool
isSymOcc OccName
name = Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
renderedOcc forall a. Semigroup a => a -> a -> a
<> Text
")"
  | OccName -> Bool
isTcOcc OccName
name Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
name = Text
"type (" forall a. Semigroup a => a -> a -> a
<> Text
renderedOcc forall a. Semigroup a => a -> a -> a
<> Text
")"
  | Bool
otherwise = Text
renderedOcc
  where
    renderedOcc :: Text
renderedOcc = OccName -> Text
renderOcc OccName
name

renderOcc :: OccName -> Text
renderOcc :: OccName -> Text
renderOcc = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ByteString
bytesFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS

moduleNameText :: IdentInfo -> Text
moduleNameText :: IdentInfo -> Text
moduleNameText = ModuleName -> Text
moduleNameText' forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> ModuleName
identModuleName

moduleNameText' :: ModuleName -> Text
moduleNameText' :: ModuleName -> Text
moduleNameText' = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ByteString
bytesFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FastString
moduleNameFS

data IdentInfo = IdentInfo
    { IdentInfo -> OccName
name            :: !OccName
    , IdentInfo -> Maybe OccName
parent          :: !(Maybe OccName)
    , IdentInfo -> ModuleName
identModuleName :: !ModuleName
    }
    deriving (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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IdentInfo] -> ShowS
$cshowList :: [IdentInfo] -> ShowS
show :: IdentInfo -> [Char]
$cshow :: IdentInfo -> [Char]
showsPrec :: Int -> IdentInfo -> ShowS
$cshowsPrec :: Int -> IdentInfo -> ShowS
Show)
    deriving anyclass Eq IdentInfo
Int -> IdentInfo -> Int
IdentInfo -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: IdentInfo -> Int
$chash :: IdentInfo -> Int
hashWithSalt :: Int -> IdentInfo -> Int
$chashWithSalt :: Int -> IdentInfo -> Int
Hashable

isDatacon :: IdentInfo -> Bool
isDatacon :: IdentInfo -> Bool
isDatacon = OccName -> Bool
isDataOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> OccName
name

instance Eq IdentInfo where
    IdentInfo
a == :: IdentInfo -> IdentInfo -> Bool
== IdentInfo
b = IdentInfo -> OccName
name IdentInfo
a forall a. Eq a => a -> a -> Bool
== IdentInfo -> OccName
name IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> Maybe OccName
parent IdentInfo
a forall a. Eq a => a -> a -> Bool
== IdentInfo -> Maybe OccName
parent IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> ModuleName
identModuleName IdentInfo
a forall a. Eq a => a -> a -> Bool
== IdentInfo -> ModuleName
identModuleName IdentInfo
b

instance NFData IdentInfo where
    rnf :: IdentInfo -> ()
rnf IdentInfo{Maybe OccName
OccName
ModuleName
identModuleName :: ModuleName
parent :: Maybe OccName
name :: OccName
parent :: IdentInfo -> Maybe OccName
identModuleName :: IdentInfo -> ModuleName
name :: IdentInfo -> OccName
..} =
        -- deliberately skip the rendered field
        forall a. NFData a => a -> ()
rnf OccName
name seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe OccName
parent seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf ModuleName
identModuleName

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

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

createExportsMap :: [ModIface] -> ExportsMap
createExportsMap :: [ModIface] -> ExportsMap
createExportsMap [ModIface]
modIface = do
  let exportList :: [(OccName, ModuleName, HashSet IdentInfo)]
exportList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {phase :: ModIfacePhase}.
ModIface_ phase -> [(OccName, ModuleName, HashSet IdentInfo)]
doOne [ModIface]
modIface
  let exportsMap :: OccEnv (HashSet IdentInfo)
exportsMap = forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(OccName
a,ModuleName
_,HashSet IdentInfo
c) -> (OccName
a, HashSet IdentInfo
c)) [(OccName, ModuleName, HashSet IdentInfo)]
exportList
  forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$ OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap OccEnv (HashSet IdentInfo)
exportsMap forall a b. (a -> b) -> a -> b
$ [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(OccName
_,ModuleName
b,HashSet IdentInfo
c) -> (ModuleName
b, HashSet IdentInfo
c)) [(OccName, ModuleName, HashSet IdentInfo)]
exportList -- UFM is lazy, so need to seq
  where
    doOne :: ModIface_ phase -> [(OccName, ModuleName, HashSet IdentInfo)]
doOne ModIface_ phase
modIFace = do
      let getModDetails :: AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)]
getModDetails = ModuleName
-> AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)]
unpackAvail forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface_ phase
modIFace
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)]
getModDetails) (forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface_ phase
modIFace)

createExportsMapMg :: [ModGuts] -> ExportsMap
createExportsMapMg :: [ModGuts] -> ExportsMap
createExportsMapMg [ModGuts]
modGuts = do
  let exportList :: [(OccName, ModuleName, HashSet IdentInfo)]
exportList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModGuts -> [(OccName, ModuleName, HashSet IdentInfo)]
doOne [ModGuts]
modGuts
  let exportsMap :: OccEnv (HashSet IdentInfo)
exportsMap = forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(OccName
a,ModuleName
_,HashSet IdentInfo
c) -> (OccName
a, HashSet IdentInfo
c)) [(OccName, ModuleName, HashSet IdentInfo)]
exportList
  forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$ OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap OccEnv (HashSet IdentInfo)
exportsMap forall a b. (a -> b) -> a -> b
$ [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(OccName
_,ModuleName
b,HashSet IdentInfo
c) -> (ModuleName
b, HashSet IdentInfo
c)) [(OccName, ModuleName, HashSet IdentInfo)]
exportList -- UFM is lazy, so need to seq
  where
    doOne :: ModGuts -> [(OccName, ModuleName, HashSet IdentInfo)]
doOne ModGuts
mi = do
      let getModuleName :: ModuleName
getModuleName = forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ ModGuts -> Module
mg_module ModGuts
mi
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModuleName
-> AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)]
unpackAvail ModuleName
getModuleName) (ModGuts -> [AvailInfo]
mg_exports ModGuts
mi)

updateExportsMapMg :: [ModGuts] -> ExportsMap -> ExportsMap
updateExportsMapMg :: [ModGuts] -> ExportsMap -> ExportsMap
updateExportsMapMg [ModGuts]
modGuts ExportsMap
old = ExportsMap -> ExportsMap -> ExportsMap
updateExportsMap ExportsMap
old ExportsMap
new
    where
        new :: ExportsMap
new = [ModGuts] -> ExportsMap
createExportsMapMg [ModGuts]
modGuts

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

type WithHieDb = forall a. (HieDb -> IO a) -> IO a

createExportsMapHieDb :: WithHieDb -> IO ExportsMap
createExportsMapHieDb :: WithHieDb -> IO ExportsMap
createExportsMapHieDb WithHieDb
withHieDb = do
    [HieModuleRow]
mods <- WithHieDb
withHieDb HieDb -> IO [HieModuleRow]
getAllIndexedMods
    [[IdentInfo]]
idents' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> Bool
nonInternalModules forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> ModuleName
modInfoName forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieModuleRow -> ModuleInfo
hieModInfo) [HieModuleRow]
mods) forall a b. (a -> b) -> a -> b
$ \HieModuleRow
m -> do
        let mn :: ModuleName
mn = ModuleInfo -> ModuleName
modInfoName forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
m
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName -> ExportRow -> IdentInfo
unwrap ModuleName
mn) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithHieDb
withHieDb (\HieDb
hieDb -> HieDb -> ModuleName -> IO [ExportRow]
getExportsForModule HieDb
hieDb ModuleName
mn)
    let idents :: [IdentInfo]
idents = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[IdentInfo]]
idents'
    let exportsMap :: OccEnv (HashSet IdentInfo)
exportsMap = forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C forall a. Semigroup a => a -> a -> a
(<>) (forall {a} {a}. Hashable a => (a -> a) -> [a] -> [(a, HashSet a)]
keyWith IdentInfo -> OccName
name [IdentInfo]
idents)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. NFData a => (a -> b) -> a -> b
$!! OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap OccEnv (HashSet IdentInfo)
exportsMap forall a b. (a -> b) -> a -> b
$ [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap (forall {a} {a}. Hashable a => (a -> a) -> [a] -> [(a, HashSet a)]
keyWith IdentInfo -> ModuleName
identModuleName [IdentInfo]
idents) -- UFM is lazy so need to seq
  where
    unwrap :: ModuleName -> ExportRow -> IdentInfo
unwrap ModuleName
m ExportRow{Bool
[Char]
Maybe OccName
Maybe Unit
Maybe ModuleName
OccName
Unit
ModuleName
exportHieFile :: ExportRow -> [Char]
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 :: [Char]
..} = OccName -> Maybe OccName -> ModuleName -> IdentInfo
IdentInfo OccName
exportName Maybe OccName
exportParent ModuleName
m
    keyWith :: (a -> a) -> [a] -> [(a, HashSet a)]
keyWith a -> a
f [a]
xs = [(a -> a
f a
x, forall a. Hashable a => a -> HashSet a
Set.singleton a
x) | a
x <- [a]
xs]

unpackAvail :: ModuleName -> IfaceExport -> [(OccName, ModuleName, HashSet IdentInfo)]
unpackAvail :: ModuleName
-> AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)]
unpackAvail ModuleName
mn
  | ModuleName -> Bool
nonInternalModules ModuleName
mn = forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> (OccName, ModuleName, HashSet IdentInfo)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> AvailInfo -> [IdentInfo]
mkIdentInfos ModuleName
mn
  | Bool
otherwise = forall a b. a -> b -> a
const []
  where
    f :: IdentInfo -> (OccName, ModuleName, HashSet IdentInfo)
f id :: IdentInfo
id@IdentInfo {Maybe OccName
OccName
ModuleName
identModuleName :: ModuleName
parent :: Maybe OccName
name :: OccName
parent :: IdentInfo -> Maybe OccName
identModuleName :: IdentInfo -> ModuleName
name :: IdentInfo -> OccName
..} = (OccName
name, ModuleName
mn, forall a. Hashable a => a -> HashSet a
Set.singleton IdentInfo
id)


identInfoToKeyVal :: IdentInfo -> (ModuleName, IdentInfo)
identInfoToKeyVal :: IdentInfo -> (ModuleName, IdentInfo)
identInfoToKeyVal IdentInfo
identInfo =
  (IdentInfo -> ModuleName
identModuleName IdentInfo
identInfo, IdentInfo
identInfo)

buildModuleExportMap:: [(ModuleName, HashSet IdentInfo)] -> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap :: [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap [(ModuleName, HashSet IdentInfo)]
exportsMap = do
  let lst :: [IdentInfo]
lst = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. HashSet a -> [a]
Set.toListforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ModuleName, HashSet IdentInfo)]
exportsMap
  let lstThree :: [(ModuleName, IdentInfo)]
lstThree = forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> (ModuleName, IdentInfo)
identInfoToKeyVal [IdentInfo]
lst
  [(ModuleName, IdentInfo)] -> ModuleNameEnv (HashSet IdentInfo)
sortAndGroup [(ModuleName, IdentInfo)]
lstThree

buildModuleExportMapFrom:: [ModIface] -> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMapFrom :: [ModIface] -> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMapFrom [ModIface]
modIfaces = do
  let exports :: [(ModuleName, HashSet IdentInfo)]
exports = forall a b. (a -> b) -> [a] -> [b]
map ModIface -> (ModuleName, HashSet IdentInfo)
extractModuleExports [ModIface]
modIfaces
  forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> [(key, elt)] -> UniqFM key elt
listToUFM_C forall a. Semigroup a => a -> a -> a
(<>) [(ModuleName, HashSet IdentInfo)]
exports

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

sortAndGroup :: [(ModuleName, IdentInfo)] -> ModuleNameEnv (HashSet IdentInfo)
sortAndGroup :: [(ModuleName, IdentInfo)] -> ModuleNameEnv (HashSet IdentInfo)
sortAndGroup [(ModuleName, IdentInfo)]
assocs = forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> [(key, elt)] -> UniqFM key elt
listToUFM_C forall a. Semigroup a => a -> a -> a
(<>) [(ModuleName
k, forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [IdentInfo
v]) | (ModuleName
k, IdentInfo
v) <- [(ModuleName, IdentInfo)]
assocs]