module Hint.Annotations (
    getModuleAnnotations,
    getValAnnotations
) where

import Data.Data
import Annotations
import GHC.Serialized

import Hint.Base
import HscTypes (hsc_mod_graph, ms_mod)
import qualified Hint.GHC as GHC

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

-- Get the annotations associated with a particular function.
getValAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a]
getValAnnotations :: a -> String -> m [a]
getValAnnotations _ x :: String
x = do
    [Name]
x' <- RunGhc1 m String [Name]
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
String -> GhcT n [Name]
forall (m :: * -> *). GhcMonad m => String -> m [Name]
GHC.parseName String
x
    [[a]]
v <- (Name -> m [a]) -> [Name] -> m [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnnTarget Name -> m [a]
forall (m :: * -> *) a.
(MonadInterpreter m, Data a) =>
AnnTarget Name -> m [a]
anns (AnnTarget Name -> m [a])
-> (Name -> AnnTarget Name) -> Name -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> AnnTarget Name
forall name. name -> AnnTarget name
NamedTarget) [Name]
x'
    [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
v

anns :: (MonadInterpreter m, Data a) => AnnTarget GHC.Name -> m [a]
anns :: AnnTarget Name -> m [a]
anns = RunGhc1 m (AnnTarget Name) [a]
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 (([Word8] -> a) -> AnnTarget Name -> GhcT n [a]
forall (m :: * -> *) a.
(GhcMonad m, Typeable a) =>
([Word8] -> a) -> AnnTarget Name -> m [a]
GHC.findGlobalAnns [Word8] -> a
forall a. Data a => [Word8] -> a
deserializeWithData)