{-# 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

  -- performance can be very bad here if the user hasn't compiled recently. We
  -- could do the Index hack and only load things that have .hi files but that
  -- will result in very bizarre behaviour and we don't expect the user's code
  -- to be compilable at this point.
#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

-- 1. local name
-- 2. locally qualified name
-- 3. fully qualified name
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)
{- BOILERPLATE Qualified ToSexp field=[local,qual,full] -}
{- BOILERPLATE START -}
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)]
{- BOILERPLATE END -}