{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
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.Char                   (isUpper)
import           Data.Hashable               (Hashable)
import           Data.HashSet                (HashSet)
import qualified Data.HashSet                as Set
import           Data.List                   (isSuffixOf)
import           Data.Text                   (Text, uncons)
import           Data.Text.Encoding          (decodeUtf8, encodeUtf8)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Orphans ()
import           GHC.Generics                (Generic)
import           HieDb                       hiding (withHieDb)
import           Prelude                     hiding (mod)


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) = (HashSet IdentInfo -> () -> ())
-> () -> OccEnv (HashSet IdentInfo) -> ()
forall a b. (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv (\HashSet IdentInfo
c ()
d -> HashSet IdentInfo -> ()
forall a. NFData a => a -> ()
rnf HashSet IdentInfo
c () -> () -> ()
forall a b. a -> b -> b
`seq` ()
d) ((HashSet IdentInfo -> ())
-> ModuleNameEnv (HashSet IdentInfo) -> ()
forall elt key. (elt -> ()) -> UniqFM key elt -> ()
seqEltsUFM HashSet IdentInfo -> ()
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 ="
            , OccEnv SDoc -> [Char]
forall a. Outputable a => a -> [Char]
printWithoutUniques (OccEnv SDoc -> [Char]) -> OccEnv SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$ (HashSet IdentInfo -> SDoc)
-> OccEnv (HashSet IdentInfo) -> OccEnv SDoc
forall a b. (a -> b) -> OccEnv a -> OccEnv b
mapOccEnv ([Char] -> SDoc
textDoc ([Char] -> SDoc)
-> (HashSet IdentInfo -> [Char]) -> HashSet IdentInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet IdentInfo -> [Char]
forall a. Show a => a -> [Char]
show) OccEnv (HashSet IdentInfo)
occs
            , [Char]
"getModuleExportsMap ="
            , UniqFM ModuleName SDoc -> [Char]
forall a. Outputable a => a -> [Char]
printWithoutUniques (UniqFM ModuleName SDoc -> [Char])
-> UniqFM ModuleName SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$ (HashSet IdentInfo -> SDoc)
-> ModuleNameEnv (HashSet IdentInfo) -> UniqFM ModuleName SDoc
forall elt1 elt2 key.
(elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapUFM ([Char] -> SDoc
textDoc ([Char] -> SDoc)
-> (HashSet IdentInfo -> [Char]) -> HashSet IdentInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet IdentInfo -> [Char]
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 = OccEnv (HashSet IdentInfo)
-> [OccName] -> OccEnv (HashSet IdentInfo)
forall a. OccEnv a -> [OccName] -> OccEnv a
delListFromOccEnv (ExportsMap -> OccEnv (HashSet IdentInfo)
getExportsMap ExportsMap
old) [OccName]
old_occs OccEnv (HashSet IdentInfo)
-> OccEnv (HashSet IdentInfo) -> OccEnv (HashSet IdentInfo)
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 ModuleNameEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo)
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 = [[OccName]] -> [OccName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(IdentInfo -> OccName) -> [IdentInfo] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> OccName
name ([IdentInfo] -> [OccName]) -> [IdentInfo] -> [OccName]
forall a b. (a -> b) -> a -> b
$ HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList (ModuleNameEnv (HashSet IdentInfo)
-> HashSet IdentInfo -> Unique -> HashSet IdentInfo
forall key elt. UniqFM key elt -> elt -> Unique -> elt
lookupWithDefaultUFM_Directly (ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
old) HashSet IdentInfo
forall a. Monoid a => a
mempty Unique
m_uniq)
                          | Unique
m_uniq <- ModuleNameEnv (HashSet IdentInfo) -> [Unique]
forall key elt. UniqFM key elt -> [Unique]
nonDetKeysUFM (ExportsMap -> ModuleNameEnv (HashSet IdentInfo)
getModuleExportsMap ExportsMap
new)]

size :: ExportsMap -> Int
size :: ExportsMap -> Int
size = [Int] -> Int
forall a. Num a => [a] -> a
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 a. HashSet a -> Int
Set.size ([HashSet IdentInfo] -> [Int])
-> (ExportsMap -> [HashSet IdentInfo]) -> ExportsMap -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccEnv (HashSet IdentInfo) -> [HashSet IdentInfo]
forall a. OccEnv a -> [a]
nonDetOccEnvElts (OccEnv (HashSet IdentInfo) -> [HashSet IdentInfo])
-> (ExportsMap -> OccEnv (HashSet IdentInfo))
-> ExportsMap
-> [HashSet IdentInfo]
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 (FastString -> OccName) -> FastString -> OccName
forall a b. (a -> b) -> a -> b
$ ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
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 Char -> Char -> Bool
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 (FastString -> OccName) -> FastString -> OccName
forall a b. (a -> b) -> a -> b
$ ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t

exportsMapSize :: ExportsMap -> Int
exportsMapSize :: ExportsMap -> Int
exportsMapSize = (HashSet IdentInfo -> Int -> Int)
-> Int -> OccEnv (HashSet IdentInfo) -> Int
forall a b. (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv (\HashSet IdentInfo
_ Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
0 (OccEnv (HashSet IdentInfo) -> Int)
-> (ExportsMap -> OccEnv (HashSet IdentInfo)) -> ExportsMap -> Int
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 ((HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> OccEnv (HashSet IdentInfo)
-> OccEnv (HashSet IdentInfo)
-> OccEnv (HashSet IdentInfo)
forall a. (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) OccEnv (HashSet IdentInfo)
a OccEnv (HashSet IdentInfo)
c) ((HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo)
forall elt key.
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
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 OccEnv (HashSet IdentInfo)
forall a. OccEnv a
emptyOccEnv ModuleNameEnv (HashSet IdentInfo)
forall key elt. UniqFM key elt
emptyUFM

rendered :: IdentInfo -> Text
rendered :: IdentInfo -> Text
rendered = OccName -> Text
occNameText (OccName -> Text) -> (IdentInfo -> OccName) -> IdentInfo -> Text
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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
renderedOcc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  | OccName -> Bool
isTcOcc OccName
name Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
name = Text
"type (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
renderedOcc Text -> Text -> Text
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 (ByteString -> Text) -> (OccName -> ByteString) -> OccName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ByteString
bytesFS (FastString -> ByteString)
-> (OccName -> FastString) -> OccName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS

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

moduleNameText' :: ModuleName -> Text
moduleNameText' :: ModuleName -> Text
moduleNameText' = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ModuleName -> ByteString) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ByteString
bytesFS (FastString -> ByteString)
-> (ModuleName -> FastString) -> ModuleName -> ByteString
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. 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
$cfrom :: forall x. IdentInfo -> Rep IdentInfo x
from :: forall x. IdentInfo -> Rep IdentInfo x
$cto :: forall x. Rep IdentInfo x -> IdentInfo
to :: forall x. Rep IdentInfo x -> IdentInfo
Generic, Int -> IdentInfo -> ShowS
[IdentInfo] -> ShowS
IdentInfo -> [Char]
(Int -> IdentInfo -> ShowS)
-> (IdentInfo -> [Char])
-> ([IdentInfo] -> ShowS)
-> Show IdentInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentInfo -> ShowS
showsPrec :: Int -> IdentInfo -> ShowS
$cshow :: IdentInfo -> [Char]
show :: IdentInfo -> [Char]
$cshowList :: [IdentInfo] -> ShowS
showList :: [IdentInfo] -> ShowS
Show)
    deriving anyclass Eq IdentInfo
Eq IdentInfo =>
(Int -> IdentInfo -> Int)
-> (IdentInfo -> Int) -> Hashable IdentInfo
Int -> IdentInfo -> Int
IdentInfo -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> IdentInfo -> Int
hashWithSalt :: Int -> IdentInfo -> Int
$chash :: IdentInfo -> Int
hash :: IdentInfo -> Int
Hashable

isDatacon :: IdentInfo -> Bool
isDatacon :: IdentInfo -> Bool
isDatacon = OccName -> Bool
isDataOcc (OccName -> Bool) -> (IdentInfo -> OccName) -> IdentInfo -> Bool
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 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> OccName
name IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> Maybe OccName
parent IdentInfo
a Maybe OccName -> Maybe OccName -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> Maybe OccName
parent IdentInfo
b
          Bool -> Bool -> Bool
&& IdentInfo -> ModuleName
identModuleName IdentInfo
a ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== IdentInfo -> ModuleName
identModuleName IdentInfo
b

instance NFData IdentInfo where
    rnf :: IdentInfo -> ()
rnf IdentInfo{Maybe OccName
ModuleName
OccName
name :: IdentInfo -> OccName
identModuleName :: IdentInfo -> ModuleName
parent :: IdentInfo -> Maybe OccName
name :: OccName
parent :: Maybe OccName
identModuleName :: ModuleName
..} =
        -- deliberately skip the rendered field
        OccName -> ()
forall a. NFData a => a -> ()
rnf OccName
name () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe OccName -> ()
forall a. NFData a => a -> ()
rnf Maybe OccName
parent () -> () -> ()
forall a b. a -> b -> b
`seq` ModuleName -> ()
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) Maybe OccName
forall a. Maybe a
Nothing ModuleName
mod]
mkIdentInfos ModuleName
mod (AvailFL FieldLabel
fl) =
    [OccName -> Maybe OccName -> ModuleName -> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) Maybe OccName
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 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
parent
    = [ OccName -> Maybe OccName -> ModuleName -> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
name) (OccName -> Maybe OccName
forall a. a -> Maybe a
Just (OccName -> Maybe OccName) -> OccName -> Maybe OccName
forall a b. (a -> b) -> a -> b
$! Name -> OccName
nameOccName Name
parent) ModuleName
mod
        | Name
name <- [Name]
nn [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
flSelector [FieldLabel]
flds
      ] [IdentInfo] -> [IdentInfo] -> [IdentInfo]
forall a. [a] -> [a] -> [a]
++
      [ OccName -> Maybe OccName -> ModuleName -> IdentInfo
IdentInfo (Name -> OccName
nameOccName Name
n) Maybe OccName
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) Maybe OccName
forall a. Maybe a
Nothing ModuleName
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
flSelector [FieldLabel]
flds
      ]

createExportsMap :: [ModIface] -> ExportsMap
createExportsMap :: [ModIface] -> ExportsMap
createExportsMap [ModIface]
modIface = do
  let exportList :: [(OccName, ModuleName, HashSet IdentInfo)]
exportList = (ModIface -> [(OccName, ModuleName, HashSet IdentInfo)])
-> [ModIface] -> [(OccName, ModuleName, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModIface -> [(OccName, ModuleName, HashSet IdentInfo)]
forall {phase :: ModIfacePhase}.
ModIface_ phase -> [(OccName, ModuleName, HashSet IdentInfo)]
doOne [ModIface]
modIface
  let exportsMap :: OccEnv (HashSet IdentInfo)
exportsMap = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo)
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ([(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo))
-> [(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((OccName, ModuleName, HashSet IdentInfo)
 -> (OccName, HashSet IdentInfo))
-> [(OccName, ModuleName, HashSet IdentInfo)]
-> [(OccName, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(OccName
a,ModuleName
_,HashSet IdentInfo
c) -> (OccName
a, HashSet IdentInfo
c)) [(OccName, ModuleName, HashSet IdentInfo)]
exportList
  ExportsMap -> ExportsMap
forall a. NFData a => a -> a
force (ExportsMap -> ExportsMap) -> ExportsMap -> ExportsMap
forall a b. (a -> b) -> a -> b
$ OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap OccEnv (HashSet IdentInfo)
exportsMap (ModuleNameEnv (HashSet IdentInfo) -> ExportsMap)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap ([(ModuleName, HashSet IdentInfo)]
 -> ModuleNameEnv (HashSet IdentInfo))
-> [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((OccName, ModuleName, HashSet IdentInfo)
 -> (ModuleName, HashSet IdentInfo))
-> [(OccName, ModuleName, HashSet IdentInfo)]
-> [(ModuleName, HashSet IdentInfo)]
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 (ModuleName
 -> AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)])
-> ModuleName
-> AvailInfo
-> [(OccName, ModuleName, HashSet IdentInfo)]
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModIface_ phase -> GenModule Unit
forall (phase :: ModIfacePhase). ModIface_ phase -> GenModule Unit
mi_module ModIface_ phase
modIFace
      (AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)])
-> [AvailInfo] -> [(OccName, ModuleName, HashSet IdentInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [(OccName, ModuleName, HashSet 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 :: [(OccName, ModuleName, HashSet IdentInfo)]
exportList = (ModGuts -> [(OccName, ModuleName, HashSet IdentInfo)])
-> [ModGuts] -> [(OccName, ModuleName, HashSet IdentInfo)]
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 = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo)
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ([(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo))
-> [(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((OccName, ModuleName, HashSet IdentInfo)
 -> (OccName, HashSet IdentInfo))
-> [(OccName, ModuleName, HashSet IdentInfo)]
-> [(OccName, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(OccName
a,ModuleName
_,HashSet IdentInfo
c) -> (OccName
a, HashSet IdentInfo
c)) [(OccName, ModuleName, HashSet IdentInfo)]
exportList
  ExportsMap -> ExportsMap
forall a. NFData a => a -> a
force (ExportsMap -> ExportsMap) -> ExportsMap -> ExportsMap
forall a b. (a -> b) -> a -> b
$ OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap OccEnv (HashSet IdentInfo)
exportsMap (ModuleNameEnv (HashSet IdentInfo) -> ExportsMap)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap ([(ModuleName, HashSet IdentInfo)]
 -> ModuleNameEnv (HashSet IdentInfo))
-> [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
forall a b. (a -> b) -> a -> b
$ ((OccName, ModuleName, HashSet IdentInfo)
 -> (ModuleName, HashSet IdentInfo))
-> [(OccName, ModuleName, HashSet IdentInfo)]
-> [(ModuleName, HashSet IdentInfo)]
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 = GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModGuts -> GenModule Unit
mg_module ModGuts
mi
      (AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)])
-> [AvailInfo] -> [(OccName, ModuleName, HashSet IdentInfo)]
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 (Bool -> Bool) -> (ModuleName -> Bool) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
".Internal" `isSuffixOf`) ([Char] -> Bool) -> (ModuleName -> [Char]) -> ModuleName -> Bool
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 <- (HieDb -> IO [HieModuleRow]) -> IO [HieModuleRow]
WithHieDb
withHieDb HieDb -> IO [HieModuleRow]
getAllIndexedMods
    [[IdentInfo]]
idents' <- [HieModuleRow]
-> (HieModuleRow -> IO [IdentInfo]) -> IO [[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 [IdentInfo]) -> IO [[IdentInfo]])
-> (HieModuleRow -> IO [IdentInfo]) -> IO [[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
        (ExportRow -> IdentInfo) -> [ExportRow] -> [IdentInfo]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName -> ExportRow -> IdentInfo
unwrap ModuleName
mn) ([ExportRow] -> [IdentInfo]) -> IO [ExportRow] -> IO [IdentInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HieDb -> IO [ExportRow]) -> IO [ExportRow]
WithHieDb
withHieDb (\HieDb
hieDb -> HieDb -> ModuleName -> IO [ExportRow]
getExportsForModule HieDb
hieDb ModuleName
mn)
    let idents :: [IdentInfo]
idents = [[IdentInfo]] -> [IdentInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[IdentInfo]]
idents'
    let exportsMap :: OccEnv (HashSet IdentInfo)
exportsMap = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(OccName, HashSet IdentInfo)] -> OccEnv (HashSet IdentInfo)
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) ((IdentInfo -> OccName)
-> [IdentInfo] -> [(OccName, HashSet IdentInfo)]
forall {a} {a}. Hashable a => (a -> a) -> [a] -> [(a, HashSet a)]
keyWith IdentInfo -> OccName
name [IdentInfo]
idents)
    ExportsMap -> IO ExportsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportsMap -> IO ExportsMap) -> ExportsMap -> IO ExportsMap
forall a b. NFData a => (a -> b) -> a -> b
$!! OccEnv (HashSet IdentInfo)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
ExportsMap OccEnv (HashSet IdentInfo)
exportsMap (ModuleNameEnv (HashSet IdentInfo) -> ExportsMap)
-> ModuleNameEnv (HashSet IdentInfo) -> ExportsMap
forall a b. (a -> b) -> a -> b
$ [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
buildModuleExportMap ((IdentInfo -> ModuleName)
-> [IdentInfo] -> [(ModuleName, HashSet IdentInfo)]
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 ModuleName
Maybe OccName
Maybe Unit
ModuleName
OccName
Unit
exportHieFile :: [Char]
exportName :: OccName
exportMod :: ModuleName
exportUnit :: Unit
exportParent :: Maybe OccName
exportParentMod :: Maybe ModuleName
exportParentUnit :: Maybe Unit
exportIsDatacon :: Bool
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
..} = 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, a -> HashSet a
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 = (IdentInfo -> (OccName, ModuleName, HashSet IdentInfo))
-> [IdentInfo] -> [(OccName, ModuleName, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map IdentInfo -> (OccName, ModuleName, HashSet IdentInfo)
f ([IdentInfo] -> [(OccName, ModuleName, HashSet IdentInfo)])
-> (AvailInfo -> [IdentInfo])
-> AvailInfo
-> [(OccName, ModuleName, HashSet IdentInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> AvailInfo -> [IdentInfo]
mkIdentInfos ModuleName
mn
  | Bool
otherwise = [(OccName, ModuleName, HashSet IdentInfo)]
-> AvailInfo -> [(OccName, ModuleName, HashSet IdentInfo)]
forall a b. a -> b -> a
const []
  where
    f :: IdentInfo -> (OccName, ModuleName, HashSet IdentInfo)
f identInfo :: IdentInfo
identInfo@IdentInfo {Maybe OccName
ModuleName
OccName
name :: IdentInfo -> OccName
identModuleName :: IdentInfo -> ModuleName
parent :: IdentInfo -> Maybe OccName
name :: OccName
parent :: Maybe OccName
identModuleName :: ModuleName
..} = (OccName
name, ModuleName
mn, IdentInfo -> HashSet IdentInfo
forall a. Hashable a => a -> HashSet a
Set.singleton IdentInfo
identInfo)


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 = ((ModuleName, HashSet IdentInfo) -> [IdentInfo])
-> [(ModuleName, 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])
-> ((ModuleName, HashSet IdentInfo) -> HashSet IdentInfo)
-> (ModuleName, HashSet IdentInfo)
-> [IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, HashSet IdentInfo) -> HashSet IdentInfo
forall a b. (a, b) -> b
snd) [(ModuleName, HashSet IdentInfo)]
exportsMap
  let lstThree :: [(ModuleName, IdentInfo)]
lstThree = (IdentInfo -> (ModuleName, IdentInfo))
-> [IdentInfo] -> [(ModuleName, IdentInfo)]
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 = (ModIface -> (ModuleName, HashSet IdentInfo))
-> [ModIface] -> [(ModuleName, HashSet IdentInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ModIface -> (ModuleName, HashSet IdentInfo)
extractModuleExports [ModIface]
modIfaces
  (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> [(key, elt)] -> UniqFM key elt
listToUFM_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
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 = GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModIface -> GenModule Unit
forall (phase :: ModIfacePhase). ModIface_ phase -> GenModule Unit
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 (ModuleName -> AvailInfo -> [IdentInfo]
mkIdentInfos ModuleName
modName) ([AvailInfo] -> [IdentInfo]) -> [AvailInfo] -> [IdentInfo]
forall a b. (a -> b) -> a -> b
$ ModIface -> [AvailInfo]
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 = (HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo)
-> [(ModuleName, HashSet IdentInfo)]
-> ModuleNameEnv (HashSet IdentInfo)
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> [(key, elt)] -> UniqFM key elt
listToUFM_C HashSet IdentInfo -> HashSet IdentInfo -> HashSet IdentInfo
forall a. Semigroup a => a -> a -> a
(<>) [(ModuleName
k, IdentInfo -> HashSet IdentInfo
forall a. Hashable a => a -> HashSet a
Set.singleton IdentInfo
v) | (ModuleName
k, IdentInfo
v) <- [(ModuleName, IdentInfo)]
assocs]