{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module HsInspect.Imports
  ( imports,
    Qualified,
  )
where

import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Text (Text)
import qualified Data.Text as T
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 :: FilePath -> m [Qualified]
imports FilePath
file = do
  (Maybe ModuleName -> ModuleName
forall a. HasCallStack => Maybe a -> a
fromJust -> ModuleName
m, Target
target) <- Set ModuleName -> FilePath -> m (Maybe ModuleName, Target)
forall (m :: * -> *).
GhcMonad m =>
Set ModuleName -> FilePath -> m (Maybe ModuleName, Target)
importsOnly Set ModuleName
forall a. Monoid a => a
mempty FilePath
file

  TargetId -> m ()
forall (m :: * -> *). GhcMonad m => TargetId -> m ()
GHC.removeTarget (TargetId -> m ()) -> TargetId -> m ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> TargetId
TargetModule ModuleName
m
  Target -> 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.
  SuccessFlag
_ <- LoadHowMuch -> m SuccessFlag
forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load (LoadHowMuch -> m SuccessFlag) -> LoadHowMuch -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ ModuleName -> LoadHowMuch
GHC.LoadUpTo ModuleName
m

  GlobalRdrEnv
rdr_env <- ModuleName -> m GlobalRdrEnv
forall (m :: * -> *). GhcMonad m => ModuleName -> m GlobalRdrEnv
minf_rdr_env' ModuleName
m
  [Qualified] -> m [Qualified]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Qualified] -> m [Qualified])
-> ([Qualified] -> [Qualified]) -> [Qualified] -> m [Qualified]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Qualified] -> [Qualified]
forall a. Ord a => [a] -> [a]
sort ([Qualified] -> m [Qualified]) -> [Qualified] -> m [Qualified]
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> [Qualified]
describe (GlobalRdrElt -> [Qualified]) -> [GlobalRdrElt] -> [Qualified]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
rdr_env

describe :: GlobalRdrElt -> [Qualified]
describe :: GlobalRdrElt -> [Qualified]
describe GRE {Name
gre_name :: GlobalRdrElt -> Name
gre_name :: Name
gre_name, [ImportSpec]
gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp :: [ImportSpec]
gre_imp} = ImportSpec -> Qualified
describe' (ImportSpec -> Qualified) -> [ImportSpec] -> [Qualified]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportSpec]
gre_imp
  where
    describe' :: ImportSpec -> Qualified
describe' ImpSpec {is_decl :: ImportSpec -> ImpDeclSpec
is_decl = ImpDeclSpec {ModuleName
is_mod :: ImpDeclSpec -> ModuleName
is_mod :: ModuleName
is_mod, ModuleName
is_as :: ImpDeclSpec -> ModuleName
is_as :: ModuleName
is_as, Bool
is_qual :: ImpDeclSpec -> Bool
is_qual :: Bool
is_qual}} =
      let ln :: Maybe Text
ln =
            if Bool
is_qual
              then Maybe Text
forall a. Maybe a
Nothing
              else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (FilePath -> Text) -> FilePath -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Maybe Text) -> FilePath -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Outputable a => a -> FilePath
showGhc Name
gre_name
          lqn :: Maybe Text
lqn =
            if ModuleName
is_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
is_as
              then Maybe Text
forall a. Maybe a
Nothing
              else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (FilePath -> Text) -> FilePath -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Maybe Text) -> FilePath -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
forall a. Outputable a => a -> FilePath
showGhc ModuleName
is_as FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Outputable a => a -> FilePath
showGhc Name
gre_name
          fqn :: Text
fqn = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
forall a. Outputable a => a -> FilePath
showGhc ModuleName
is_mod FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Outputable a => a -> FilePath
showGhc Name
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
(Qualified -> Qualified -> Bool)
-> (Qualified -> Qualified -> Bool) -> Eq Qualified
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
Eq Qualified
-> (Qualified -> Qualified -> Ordering)
-> (Qualified -> Qualified -> Bool)
-> (Qualified -> Qualified -> Bool)
-> (Qualified -> Qualified -> Bool)
-> (Qualified -> Qualified -> Bool)
-> (Qualified -> Qualified -> Qualified)
-> (Qualified -> Qualified -> Qualified)
-> Ord 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
$cp1Ord :: Eq Qualified
Ord, Int -> Qualified -> FilePath -> FilePath
[Qualified] -> FilePath -> FilePath
Qualified -> FilePath
(Int -> Qualified -> FilePath -> FilePath)
-> (Qualified -> FilePath)
-> ([Qualified] -> FilePath -> FilePath)
-> Show Qualified
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Qualified] -> FilePath -> FilePath
$cshowList :: [Qualified] -> FilePath -> FilePath
show :: Qualified -> FilePath
$cshow :: Qualified -> FilePath
showsPrec :: Int -> Qualified -> FilePath -> FilePath
$cshowsPrec :: Int -> Qualified -> FilePath -> FilePath
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", Maybe Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe Text
p_1_1), (Sexp
"qual", Maybe Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe Text
p_1_2), (Sexp
"full", Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]
{- BOILERPLATE END -}