{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module HsInspect.Imports
( imports,
Qualified,
)
where
import Data.List (sort)
import Data.Maybe (fromJust)
import qualified GHC as GHC
import HscTypes (TargetId(..))
import HsInspect.Sexp
import HsInspect.Util
import HsInspect.Workarounds
import RdrName (GlobalRdrElt(..), ImpDeclSpec(..), ImportSpec(..),
globalRdrEnvElts)
imports :: GHC.GhcMonad m => FilePath -> m [Qualified]
imports file = do
(fromJust -> m, target) <- importsOnly mempty file
GHC.removeTarget $ TargetModule m
GHC.addTarget target
_ <- GHC.load $ GHC.LoadUpTo m
rdr_env <- minf_rdr_env' m
pure . sort $ describe =<< globalRdrEnvElts rdr_env
describe :: GlobalRdrElt -> [Qualified]
describe GRE {gre_name, gre_imp} = describe' <$> gre_imp
where
describe' ImpSpec {is_decl = ImpDeclSpec {is_mod, is_as, is_qual}} =
let ln =
if is_qual
then Nothing
else Just $ showGhc gre_name
lqn =
if is_mod == is_as
then Nothing
else Just $ showGhc is_as ++ "." ++ showGhc gre_name
fqn = showGhc is_mod ++ "." ++ showGhc gre_name
in Qualified ln lqn fqn
data Qualified
= Qualified
(Maybe String)
(Maybe String)
String
deriving (Eq, Ord, Show)
instance ToSexp Qualified where
toSexp (Qualified ln lqn fqn) =
alist
[ ("local", toSexp ln),
("qual", toSexp lqn),
("full", toSexp fqn)
]