1{-# LANGUAGE DeriveAnyClass #-} 2{-# LANGUAGE DerivingStrategies #-} 3module Development.IDE.Types.Exports 4( 5 IdentInfo(..), 6 ExportsMap(..), 7 createExportsMap, 8 createExportsMapMg, 9 createExportsMapTc, 10 buildModuleExportMapFrom 11,createExportsMapHieDb,size) where 12 13import Avail (AvailInfo (..)) 14import Control.DeepSeq (NFData (..)) 15import Control.Monad 16import Data.Bifunctor (Bifunctor (second)) 17import Data.HashMap.Strict (HashMap, elems) 18import qualified Data.HashMap.Strict as Map 19import Data.HashSet (HashSet) 20import qualified Data.HashSet as Set 21import Data.Hashable (Hashable) 22import Data.List (isSuffixOf) 23import Data.Text (Text, pack) 24import Development.IDE.GHC.Compat 25import Development.IDE.GHC.Orphans () 26import Development.IDE.GHC.Util 27import FieldLabel (flSelector) 28import GHC.Generics (Generic) 29import GhcPlugins (IfaceExport, ModGuts (..)) 30import HieDb 31import Name 32import TcRnTypes (TcGblEnv (..)) 33 34 35data ExportsMap = ExportsMap 36 {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo) 37 , getModuleExportsMap :: Map.HashMap ModuleNameText (HashSet IdentInfo) 38 } 39 deriving (Show) 40 41size :: ExportsMap -> Int 42size = sum . map length . elems . getExportsMap 43 44instance Semigroup ExportsMap where 45 ExportsMap a b <> ExportsMap c d = ExportsMap (Map.unionWith (<>) a c) (Map.unionWith (<>) b d) 46 47instance Monoid ExportsMap where 48 mempty = ExportsMap Map.empty Map.empty 49 50type IdentifierText = Text 51type ModuleNameText = Text 52 53data IdentInfo = IdentInfo 54 { name :: !OccName 55 , rendered :: Text 56 , parent :: !(Maybe Text) 57 , isDatacon :: !Bool 58 , moduleNameText :: !Text 59 } 60 deriving (Generic, Show) 61 deriving anyclass Hashable 62 63instance Eq IdentInfo where 64 a == b = name a == name b 65 && parent a == parent b 66 && isDatacon a == isDatacon b 67 && moduleNameText a == moduleNameText b 68 69instance NFData IdentInfo where 70 rnf IdentInfo{..} = 71 -- deliberately skip the rendered field 72 rnf name `seq` rnf parent `seq` rnf isDatacon `seq` rnf moduleNameText 73 74-- | Render an identifier as imported or exported style. 75-- TODO: pattern synonym 76renderIEWrapped :: Name -> Text 77renderIEWrapped n 78 | isTcOcc occ && isSymOcc occ = "type " <> pack (printName n) 79 | otherwise = pack $ printName n 80 where 81 occ = occName n 82 83mkIdentInfos :: Text -> AvailInfo -> [IdentInfo] 84mkIdentInfos mod (Avail n) = 85 [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod] 86mkIdentInfos mod (AvailTC parent (n:nn) flds) 87 -- Following the GHC convention that parent == n if parent is exported 88 | n == parent 89 = [ IdentInfo (nameOccName n) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod 90 | n <- nn ++ map flSelector flds 91 ] ++ 92 [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod] 93 where 94 parentP = pack $ printName parent 95 96mkIdentInfos mod (AvailTC _ nn flds) 97 = [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod 98 | n <- nn ++ map flSelector flds 99 ] 100 101createExportsMap :: [ModIface] -> ExportsMap 102createExportsMap modIface = do 103 let exportList = concatMap doOne modIface 104 let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList 105 ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList 106 where 107 doOne modIFace = do 108 let getModDetails = unpackAvail $ moduleName $ mi_module modIFace 109 concatMap (fmap (second Set.fromList) . getModDetails) (mi_exports modIFace) 110 111createExportsMapMg :: [ModGuts] -> ExportsMap 112createExportsMapMg modGuts = do 113 let exportList = concatMap doOne modGuts 114 let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList 115 ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList 116 where 117 doOne mi = do 118 let getModuleName = moduleName $ mg_module mi 119 concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (mg_exports mi) 120 121createExportsMapTc :: [TcGblEnv] -> ExportsMap 122createExportsMapTc modIface = do 123 let exportList = concatMap doOne modIface 124 let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList 125 ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList 126 where 127 doOne mi = do 128 let getModuleName = moduleName $ tcg_mod mi 129 concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (tcg_exports mi) 130 131nonInternalModules :: ModuleName -> Bool 132nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString 133 134createExportsMapHieDb :: HieDb -> IO ExportsMap 135createExportsMapHieDb hiedb = do 136 mods <- getAllIndexedMods hiedb 137 idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do 138 let mn = modInfoName $ hieModInfo m 139 mText = pack $ moduleNameString mn 140 fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn 141 let exportsMap = Map.fromListWith (<>) (concat idents) 142 return $ ExportsMap exportsMap $ buildModuleExportMap (concat idents) 143 where 144 wrap identInfo = (rendered identInfo, Set.fromList [identInfo]) 145 -- unwrap :: ExportRow -> IdentInfo 146 unwrap m ExportRow{..} = IdentInfo exportName n p exportIsDatacon m 147 where 148 n = pack (occNameString exportName) 149 p = pack . occNameString <$> exportParent 150 151unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])] 152unpackAvail mn 153 | nonInternalModules mn = map f . mkIdentInfos mod 154 | otherwise = const [] 155 where 156 !mod = pack $ moduleNameString mn 157 f id@IdentInfo {..} = (pack (prettyPrint name), moduleNameText,[id]) 158 159 160identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo) 161identInfoToKeyVal identInfo = 162 (moduleNameText identInfo, identInfo) 163 164buildModuleExportMap:: [(Text, HashSet IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo) 165buildModuleExportMap exportsMap = do 166 let lst = concatMap (Set.toList. snd) exportsMap 167 let lstThree = map identInfoToKeyVal lst 168 sortAndGroup lstThree 169 170buildModuleExportMapFrom:: [ModIface] -> Map.HashMap Text (HashSet IdentInfo) 171buildModuleExportMapFrom modIfaces = do 172 let exports = map extractModuleExports modIfaces 173 Map.fromListWith (<>) exports 174 175extractModuleExports :: ModIface -> (Text, HashSet IdentInfo) 176extractModuleExports modIFace = do 177 let modName = pack $ moduleNameString $ moduleName $ mi_module modIFace 178 let functionSet = Set.fromList $ concatMap (mkIdentInfos modName) $ mi_exports modIFace 179 (modName, functionSet) 180 181sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo) 182sortAndGroup assocs = Map.fromListWith (<>) [(k, Set.fromList [v]) | (k, v) <- assocs] 183