module Development.IDE.Plugin.CodeAction.Rules
  ( rulePackageExports
  )
where

import           Data.Traversable               ( forM )
import           Development.IDE.Core.Rules
import           Development.IDE.GHC.Util
import           Development.IDE.Plugin.CodeAction.RuleTypes
import           Development.IDE.Types.Exports
import           Development.Shake
import           GHC                            ( DynFlags(pkgState) )
import           HscTypes                       ( hsc_dflags)
import           LoadIface
import           Maybes
import           Module                         ( Module(..) )
import           Packages                       ( explicitPackages
                                                , exposedModules
                                                , packageConfigId
                                                )
import           TcRnMonad                      ( WhereFrom(ImportByUser)
                                                , initIfaceLoad
                                                )

rulePackageExports :: Rules ()
rulePackageExports :: Rules ()
rulePackageExports = (PackageExports -> Action ExportsMap) -> Rules ()
forall k v. IdeRule k v => (k -> Action v) -> Rules ()
defineNoFile ((PackageExports -> Action ExportsMap) -> Rules ())
-> (PackageExports -> Action ExportsMap) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \(PackageExports HscEnvEq
session) -> do
  let env :: HscEnv
env     = HscEnvEq -> HscEnv
hscEnv HscEnvEq
session
      pkgst :: PackageState
pkgst   = DynFlags -> PackageState
pkgState (HscEnv -> DynFlags
hsc_dflags HscEnv
env)
      depends :: [UnitId]
depends = PackageState -> [UnitId]
explicitPackages PackageState
pkgst
      targets :: [(PackageConfig, ModuleName)]
targets =
        [ (PackageConfig
pkg, ModuleName
mn)
        | UnitId
d        <- [UnitId]
depends
        , Just PackageConfig
pkg <- [UnitId -> HscEnv -> Maybe PackageConfig
lookupPackageConfig UnitId
d HscEnv
env]
        , (ModuleName
mn, Maybe Module
_)  <- PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules PackageConfig
pkg
        ]

  [Maybe ModIface]
modIfaces <- [(PackageConfig, ModuleName)]
-> ((PackageConfig, ModuleName) -> Action (Maybe ModIface))
-> Action [Maybe ModIface]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(PackageConfig, ModuleName)]
targets (((PackageConfig, ModuleName) -> Action (Maybe ModIface))
 -> Action [Maybe ModIface])
-> ((PackageConfig, ModuleName) -> Action (Maybe ModIface))
-> Action [Maybe ModIface]
forall a b. (a -> b) -> a -> b
$ \(PackageConfig
pkg, ModuleName
mn) -> do
    MaybeErr MsgDoc ModIface
modIface <- IO (MaybeErr MsgDoc ModIface) -> Action (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MaybeErr MsgDoc ModIface)
 -> Action (MaybeErr MsgDoc ModIface))
-> IO (MaybeErr MsgDoc ModIface)
-> Action (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$ HscEnv
-> IfG (MaybeErr MsgDoc ModIface) -> IO (MaybeErr MsgDoc ModIface)
forall a. HscEnv -> IfG a -> IO a
initIfaceLoad HscEnv
env (IfG (MaybeErr MsgDoc ModIface) -> IO (MaybeErr MsgDoc ModIface))
-> IfG (MaybeErr MsgDoc ModIface) -> IO (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Module -> WhereFrom -> IfG (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface
      MsgDoc
""
      (UnitId -> ModuleName -> Module
Module (PackageConfig -> UnitId
packageConfigId PackageConfig
pkg) ModuleName
mn)
      (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
False)
    Maybe ModIface -> Action (Maybe ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ModIface -> Action (Maybe ModIface))
-> Maybe ModIface -> Action (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$ case MaybeErr MsgDoc ModIface
modIface of
      Failed    MsgDoc
_err -> Maybe ModIface
forall a. Maybe a
Nothing
      Succeeded ModIface
mi   -> ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just ModIface
mi
  ExportsMap -> Action ExportsMap
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportsMap -> Action ExportsMap)
-> ExportsMap -> Action ExportsMap
forall a b. (a -> b) -> a -> b
$ [ModIface] -> ExportsMap
createExportsMap ([Maybe ModIface] -> [ModIface]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ModIface]
modIfaces)