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

import Avail (AvailInfo(..))
import Control.DeepSeq (NFData)
import Data.Text (pack, Text)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import Data.HashMap.Strict (HashMap)
import GHC.Generics (Generic)
import Name
import FieldLabel (flSelector)
import qualified Data.HashMap.Strict as Map
import GhcPlugins (IfaceExport, ModGuts(..))
import Data.HashSet (HashSet)
import qualified Data.HashSet as Set
import Data.Bifunctor (Bifunctor(second))
import Data.Hashable (Hashable)
import TcRnTypes(TcGblEnv(..))

newtype ExportsMap = ExportsMap
    {ExportsMap
-> HashMap IdentifierText (HashSet (IdentInfo, IdentifierText))
getExportsMap :: HashMap IdentifierText (HashSet (IdentInfo,ModuleNameText))}
    deriving newtype (Semigroup ExportsMap
ExportsMap
Semigroup ExportsMap
-> ExportsMap
-> (ExportsMap -> ExportsMap -> ExportsMap)
-> ([ExportsMap] -> ExportsMap)
-> Monoid ExportsMap
[ExportsMap] -> ExportsMap
ExportsMap -> ExportsMap -> ExportsMap
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ExportsMap] -> ExportsMap
$cmconcat :: [ExportsMap] -> ExportsMap
mappend :: ExportsMap -> ExportsMap -> ExportsMap
$cmappend :: ExportsMap -> ExportsMap -> ExportsMap
mempty :: ExportsMap
$cmempty :: ExportsMap
$cp1Monoid :: Semigroup ExportsMap
Monoid, ExportsMap -> ()
(ExportsMap -> ()) -> NFData ExportsMap
forall a. (a -> ()) -> NFData a
rnf :: ExportsMap -> ()
$crnf :: ExportsMap -> ()
NFData, 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)

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

type IdentifierText = Text
type ModuleNameText = Text

data IdentInfo = IdentInfo
    { IdentInfo -> IdentifierText
name :: !Text
    , IdentInfo -> IdentifierText
rendered :: Text
    , IdentInfo -> Maybe IdentifierText
parent :: !(Maybe Text)
    , IdentInfo -> Bool
isDatacon :: !Bool
    }
    deriving (IdentInfo -> IdentInfo -> Bool
(IdentInfo -> IdentInfo -> Bool)
-> (IdentInfo -> IdentInfo -> Bool) -> Eq IdentInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentInfo -> IdentInfo -> Bool
$c/= :: IdentInfo -> IdentInfo -> Bool
== :: IdentInfo -> IdentInfo -> Bool
$c== :: IdentInfo -> IdentInfo -> Bool
Eq, (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 NFData IdentInfo

mkIdentInfos :: AvailInfo -> [IdentInfo]
mkIdentInfos :: AvailInfo -> [IdentInfo]
mkIdentInfos (Avail Name
n) =
    [IdentifierText
-> IdentifierText -> Maybe IdentifierText -> Bool -> IdentInfo
IdentInfo (String -> IdentifierText
pack (Name -> String
forall a. Outputable a => a -> String
prettyPrint Name
n)) (String -> IdentifierText
pack (Name -> String
printName Name
n)) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n)]
mkIdentInfos (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
    = [ IdentifierText
-> IdentifierText -> Maybe IdentifierText -> Bool -> IdentInfo
IdentInfo (String -> IdentifierText
pack (Name -> String
forall a. Outputable a => a -> String
prettyPrint Name
n)) (String -> IdentifierText
pack (Name -> String
printName 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)
        | 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]
++
      [ IdentifierText
-> IdentifierText -> Maybe IdentifierText -> Bool -> IdentInfo
IdentInfo (String -> IdentifierText
pack (Name -> String
forall a. Outputable a => a -> String
prettyPrint Name
n)) (String -> IdentifierText
pack (Name -> String
printName Name
n)) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n)]
    where
        parentP :: IdentifierText
parentP = String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
parent

mkIdentInfos (AvailTC Name
_ [Name]
nn [FieldLabel]
flds)
    = [ IdentifierText
-> IdentifierText -> Maybe IdentifierText -> Bool -> IdentInfo
IdentInfo (String -> IdentifierText
pack (Name -> String
forall a. Outputable a => a -> String
prettyPrint Name
n)) (String -> IdentifierText
pack (Name -> String
printName Name
n)) Maybe IdentifierText
forall a. Maybe a
Nothing (Name -> Bool
isDataConName Name
n)
        | 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 = HashMap IdentifierText (HashSet (IdentInfo, IdentifierText))
-> ExportsMap
ExportsMap (HashMap IdentifierText (HashSet (IdentInfo, IdentifierText))
 -> ExportsMap)
-> ([ModIface]
    -> HashMap IdentifierText (HashSet (IdentInfo, IdentifierText)))
-> [ModIface]
-> ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashSet (IdentInfo, IdentifierText)
 -> HashSet (IdentInfo, IdentifierText)
 -> HashSet (IdentInfo, IdentifierText))
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
-> HashMap IdentifierText (HashSet (IdentInfo, IdentifierText))
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith HashSet (IdentInfo, IdentifierText)
-> HashSet (IdentInfo, IdentifierText)
-> HashSet (IdentInfo, IdentifierText)
forall a. Semigroup a => a -> a -> a
(<>) ([(IdentifierText, HashSet (IdentInfo, IdentifierText))]
 -> HashMap IdentifierText (HashSet (IdentInfo, IdentifierText)))
-> ([ModIface]
    -> [(IdentifierText, HashSet (IdentInfo, IdentifierText))])
-> [ModIface]
-> HashMap IdentifierText (HashSet (IdentInfo, IdentifierText))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModIface
 -> [(IdentifierText, HashSet (IdentInfo, IdentifierText))])
-> [ModIface]
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModIface -> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
forall (phase :: ModIfacePhase).
ModIface_ phase
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
doOne
  where
    doOne :: ModIface_ phase
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
doOne ModIface_ phase
mi = (AvailInfo
 -> [(IdentifierText, HashSet (IdentInfo, IdentifierText))])
-> [AvailInfo]
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((IdentifierText, [(IdentInfo, IdentifierText)])
 -> (IdentifierText, HashSet (IdentInfo, IdentifierText)))
-> [(IdentifierText, [(IdentInfo, IdentifierText)])]
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(IdentInfo, IdentifierText)]
 -> HashSet (IdentInfo, IdentifierText))
-> (IdentifierText, [(IdentInfo, IdentifierText)])
-> (IdentifierText, HashSet (IdentInfo, IdentifierText))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(IdentInfo, IdentifierText)]
-> HashSet (IdentInfo, IdentifierText)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList) ([(IdentifierText, [(IdentInfo, IdentifierText)])]
 -> [(IdentifierText, HashSet (IdentInfo, IdentifierText))])
-> (AvailInfo -> [(IdentifierText, [(IdentInfo, IdentifierText)])])
-> AvailInfo
-> [(IdentifierText, HashSet (IdentInfo, IdentifierText))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName
-> AvailInfo -> [(IdentifierText, [(IdentInfo, IdentifierText)])]
unpackAvail ModuleName
mn) (ModIface_ phase -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface_ phase
mi)
      where
        mn :: ModuleName
mn = 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
mi

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

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

unpackAvail :: ModuleName -> IfaceExport -> [(Text, [(IdentInfo, Text)])]
unpackAvail :: ModuleName
-> AvailInfo -> [(IdentifierText, [(IdentInfo, IdentifierText)])]
unpackAvail ModuleName
mod =
  (IdentInfo -> (IdentifierText, [(IdentInfo, IdentifierText)]))
-> [IdentInfo] -> [(IdentifierText, [(IdentInfo, IdentifierText)])]
forall a b. (a -> b) -> [a] -> [b]
map (\id :: IdentInfo
id@IdentInfo {Bool
Maybe IdentifierText
IdentifierText
isDatacon :: Bool
parent :: Maybe IdentifierText
rendered :: IdentifierText
name :: IdentifierText
isDatacon :: IdentInfo -> Bool
parent :: IdentInfo -> Maybe IdentifierText
rendered :: IdentInfo -> IdentifierText
name :: IdentInfo -> IdentifierText
..} -> (IdentifierText
name, [(IdentInfo
id, String -> IdentifierText
pack (String -> IdentifierText) -> String -> IdentifierText
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mod)]))
    ([IdentInfo] -> [(IdentifierText, [(IdentInfo, IdentifierText)])])
-> (AvailInfo -> [IdentInfo])
-> AvailInfo
-> [(IdentifierText, [(IdentInfo, IdentifierText)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailInfo -> [IdentInfo]
mkIdentInfos