{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module HsInspect.Imports
( imports,
Qualified,
)
where
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
import qualified GHC.Types.Target as GHC
#endif
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
import qualified GHC.Driver.Env.Types as GHC
import qualified GHC.Unit.Env as GHC
import qualified GHC.Data.Bag as GHC
import qualified GHC.Types.Name.Reader as GHC
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
import qualified GHC.Types.Name.Reader as GHC
#else
import qualified HscTypes as GHC
import qualified RdrName as GHC
#endif
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified GHC as GHC
import HsInspect.Sexp
import HsInspect.Util
import HsInspect.Workarounds
imports :: GHC.GhcMonad m => FilePath -> m [Qualified]
imports :: forall (m :: * -> *). GhcMonad m => FilePath -> m [Qualified]
imports FilePath
file = do
(forall a. HasCallStack => Maybe a -> a
fromJust -> ModuleName
m, Target
target) <- forall (m :: * -> *).
GhcMonad m =>
Set ModuleName -> FilePath -> m (Maybe ModuleName, Target)
importsOnly forall a. Monoid a => a
mempty FilePath
file
forall (m :: * -> *). GhcMonad m => TargetId -> m ()
GHC.removeTarget forall a b. (a -> b) -> a -> b
$ ModuleName -> TargetId
GHC.TargetModule ModuleName
m
forall (m :: * -> *). GhcMonad m => Target -> m ()
GHC.addTarget Target
target
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
sess <- GHC.getSession
let unitid = GHC.ue_current_unit $ GHC.hsc_unit_env sess
_ <- GHC.load $ GHC.LoadUpTo (GHC.mkModule unitid m)
#else
SuccessFlag
_ <- forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load forall a b. (a -> b) -> a -> b
$ ModuleName -> LoadHowMuch
GHC.LoadUpTo ModuleName
m
#endif
GlobalRdrEnv
rdr_env <- forall (m :: * -> *). GhcMonad m => ModuleName -> m GlobalRdrEnv
minf_rdr_env' ModuleName
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> [Qualified]
describe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GlobalRdrEnv -> [GlobalRdrElt]
GHC.globalRdrEnvElts GlobalRdrEnv
rdr_env
describe :: GHC.GlobalRdrElt -> [Qualified]
describe :: GlobalRdrElt -> [Qualified]
describe GHC.GRE {GreName
gre_name :: GlobalRdrElt -> GreName
gre_name :: GreName
GHC.gre_name, [ImportSpec]
gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp :: [ImportSpec]
GHC.gre_imp} =
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
describe' <$> GHC.bagToList gre_imp
#else
ImportSpec -> Qualified
describe' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportSpec]
gre_imp
#endif
where
describe' :: ImportSpec -> Qualified
describe' GHC.ImpSpec {is_decl :: ImportSpec -> ImpDeclSpec
GHC.is_decl = GHC.ImpDeclSpec {ModuleName
is_mod :: ImpDeclSpec -> ModuleName
is_mod :: ModuleName
GHC.is_mod, ModuleName
is_as :: ImpDeclSpec -> ModuleName
is_as :: ModuleName
GHC.is_as, Bool
is_qual :: ImpDeclSpec -> Bool
is_qual :: Bool
GHC.is_qual}} =
let ln :: Maybe Text
ln =
if Bool
is_qual
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> FilePath
showGhc GreName
gre_name
lqn :: Maybe Text
lqn =
if ModuleName
is_mod forall a. Eq a => a -> a -> Bool
== ModuleName
is_as
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> FilePath
showGhc ModuleName
is_as forall a. [a] -> [a] -> [a]
++ FilePath
"." forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> FilePath
showGhc GreName
gre_name
fqn :: Text
fqn = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> FilePath
showGhc ModuleName
is_mod forall a. [a] -> [a] -> [a]
++ FilePath
"." forall a. [a] -> [a] -> [a]
++ forall a. Outputable a => a -> FilePath
showGhc GreName
gre_name
in Maybe Text -> Maybe Text -> Text -> Qualified
Qualified Maybe Text
ln Maybe Text
lqn Text
fqn
data Qualified
= Qualified
(Maybe Text)
(Maybe Text)
Text
deriving (Qualified -> Qualified -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Qualified -> Qualified -> Bool
$c/= :: Qualified -> Qualified -> Bool
== :: Qualified -> Qualified -> Bool
$c== :: Qualified -> Qualified -> Bool
Eq, Eq Qualified
Qualified -> Qualified -> Bool
Qualified -> Qualified -> Ordering
Qualified -> Qualified -> Qualified
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Qualified -> Qualified -> Qualified
$cmin :: Qualified -> Qualified -> Qualified
max :: Qualified -> Qualified -> Qualified
$cmax :: Qualified -> Qualified -> Qualified
>= :: Qualified -> Qualified -> Bool
$c>= :: Qualified -> Qualified -> Bool
> :: Qualified -> Qualified -> Bool
$c> :: Qualified -> Qualified -> Bool
<= :: Qualified -> Qualified -> Bool
$c<= :: Qualified -> Qualified -> Bool
< :: Qualified -> Qualified -> Bool
$c< :: Qualified -> Qualified -> Bool
compare :: Qualified -> Qualified -> Ordering
$ccompare :: Qualified -> Qualified -> Ordering
Ord, Int -> Qualified -> ShowS
[Qualified] -> ShowS
Qualified -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Qualified] -> ShowS
$cshowList :: [Qualified] -> ShowS
show :: Qualified -> FilePath
$cshow :: Qualified -> FilePath
showsPrec :: Int -> Qualified -> ShowS
$cshowsPrec :: Int -> Qualified -> ShowS
Show)
instance ToSexp Qualified where
toSexp :: Qualified -> Sexp
toSexp (Qualified Maybe Text
p_1_1 Maybe Text
p_1_2 Text
p_1_3) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"local", forall a. ToSexp a => a -> Sexp
toSexp Maybe Text
p_1_1), (Sexp
"qual", forall a. ToSexp a => a -> Sexp
toSexp Maybe Text
p_1_2), (Sexp
"full", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]