module Hint.Annotations (
    getModuleAnnotations,
    getValAnnotations
) where

import Data.Data
import GHC.Serialized

import Hint.Base
import qualified Hint.GHC as GHC

#if MIN_VERSION_ghc(9,2,0)
import GHC (ms_mod)
import GHC.Driver.Env (hsc_mod_graph)
#elif MIN_VERSION_ghc(9,0,0)
import GHC.Driver.Types (hsc_mod_graph, ms_mod)
#else
import HscTypes (hsc_mod_graph, ms_mod)
#endif

#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Annotations
import GHC.Utils.Monad (concatMapM)
#else
import Annotations
import MonadUtils (concatMapM)
#endif

-- Get the annotations associated with a particular module.
getModuleAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a]
getModuleAnnotations :: forall a (m :: * -> *).
(Data a, MonadInterpreter m) =>
a -> String -> m [a]
getModuleAnnotations a
_ String
x = do
    [ModSummary]
mods <- ModuleGraph -> [ModSummary]
GHC.mgModSummaries forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> ModuleGraph
hsc_mod_graph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
    let x' :: [ModSummary]
x' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) String
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod) [ModSummary]
mods
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall (m :: * -> *) a.
(MonadInterpreter m, Data a) =>
AnnTarget Name -> m [a]
anns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. Module -> AnnTarget name
ModuleTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod) [ModSummary]
x'

-- Get the annotations associated with a particular function.
getValAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a]
getValAnnotations :: forall a (m :: * -> *).
(Data a, MonadInterpreter m) =>
a -> String -> m [a]
getValAnnotations a
_ String
s = do
    [Name]
names <- forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => String -> m [Name]
GHC.parseName String
s
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall (m :: * -> *) a.
(MonadInterpreter m, Data a) =>
AnnTarget Name -> m [a]
anns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. name -> AnnTarget name
NamedTarget) [Name]
names

anns :: (MonadInterpreter m, Data a) => AnnTarget GHC.Name -> m [a]
anns :: forall (m :: * -> *) a.
(MonadInterpreter m, Data a) =>
AnnTarget Name -> m [a]
anns AnnTarget Name
target = forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(GhcMonad m, Typeable a) =>
([Word8] -> a) -> AnnTarget Name -> m [a]
GHC.findGlobalAnns forall a. Data a => [Word8] -> a
deserializeWithData AnnTarget Name
target