    module Hint.Reflection (
          ModuleElem(..), Id, name, children,
          getModuleExports,
    ) where

    import Data.List
    import Data.Maybe

    import Hint.Base
    import qualified Hint.GHC as GHC

    -- | An Id for a class, a type constructor, a data constructor, a binding, etc
    type Id = String

    data ModuleElem = Fun Id | Class Id [Id] | Data Id [Id]
      deriving (ReadPrec [ModuleElem]
    ReadPrec ModuleElem
    Int -> ReadS ModuleElem
    ReadS [ModuleElem]
    (Int -> ReadS ModuleElem)
    -> ReadS [ModuleElem]
    -> ReadPrec ModuleElem
    -> ReadPrec [ModuleElem]
    -> Read ModuleElem
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ModuleElem
    readsPrec :: Int -> ReadS ModuleElem
    $creadList :: ReadS [ModuleElem]
    readList :: ReadS [ModuleElem]
    $creadPrec :: ReadPrec ModuleElem
    readPrec :: ReadPrec ModuleElem
    $creadListPrec :: ReadPrec [ModuleElem]
    readListPrec :: ReadPrec [ModuleElem]
    Read, Int -> ModuleElem -> ShowS
    [ModuleElem] -> ShowS
    ModuleElem -> Id
    (Int -> ModuleElem -> ShowS)
    -> (ModuleElem -> Id) -> ([ModuleElem] -> ShowS) -> Show ModuleElem
    forall a.
    (Int -> a -> ShowS) -> (a -> Id) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ModuleElem -> ShowS
    showsPrec :: Int -> ModuleElem -> ShowS
    $cshow :: ModuleElem -> Id
    show :: ModuleElem -> Id
    $cshowList :: [ModuleElem] -> ShowS
    showList :: [ModuleElem] -> ShowS
    Show, ModuleElem -> ModuleElem -> Bool
    (ModuleElem -> ModuleElem -> Bool)
    -> (ModuleElem -> ModuleElem -> Bool) -> Eq ModuleElem
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ModuleElem -> ModuleElem -> Bool
    == :: ModuleElem -> ModuleElem -> Bool
    $c/= :: ModuleElem -> ModuleElem -> Bool
    /= :: ModuleElem -> ModuleElem -> Bool
    Eq)

    name :: ModuleElem -> Id
    name :: ModuleElem -> Id
    name (Fun Id
    f)     = Id
    f
    name (Class Id
    c [Id]
    _) = Id
    c
    name (Data Id
    d [Id]
    _)  = Id
    d

    children :: ModuleElem -> [Id]
    children :: ModuleElem -> [Id]
    children (Fun   Id
    _)     = []
    children (Class Id
    _ [Id]
    ms)  = [Id]
    ms
    children (Data  Id
    _ [Id]
    dcs) = [Id]
    dcs

    -- | Gets an abstract representation of all the entities exported by the module.
    --   It is similar to the @:browse@ command in GHCi.
    getModuleExports :: MonadInterpreter m => ModuleName -> m [ModuleElem]
    getModuleExports :: forall (m :: * -> *). MonadInterpreter m => Id -> m [ModuleElem]
    getModuleExports Id
    mn =
        do module_  <- Id -> m Module
    forall (m :: * -> *). MonadInterpreter m => Id -> m Module
    findModule Id
    mn
           mod_info <- mayFail $ runGhc $ GHC.getModuleInfo module_
           exports  <- mapM (\Name
    n -> RunGhc m (Maybe TyThing)
    forall a. RunGhc m a
    forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
    runGhc RunGhc m (Maybe TyThing) -> RunGhc m (Maybe TyThing)
    forall a b. (a -> b) -> a -> b
    $ Name -> GhcT n (Maybe TyThing)
    forall (m :: * -> *). GhcMonad m => Name -> m (Maybe TyThing)
    GHC.lookupName Name
    n) (GHC.modInfoExports mod_info)
           dflags   <- runGhc GHC.getSessionDynFlags
           --
           return $ asModElemList dflags (catMaybes exports)

    asModElemList :: GHC.DynFlags -> [GHC.TyThing] -> [ModuleElem]
    asModElemList :: DynFlags -> [TyThing] -> [ModuleElem]
    asModElemList DynFlags
    df [TyThing]
    xs = [[ModuleElem]] -> [ModuleElem]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [
                            [ModuleElem]
    cs,
                            [ModuleElem]
    ts,
                            [ModuleElem]
    ds [ModuleElem] -> [ModuleElem] -> [ModuleElem]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ (ModuleElem -> [ModuleElem]) -> [ModuleElem] -> [ModuleElem]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Id -> ModuleElem) -> [Id] -> [ModuleElem]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> ModuleElem
    Fun ([Id] -> [ModuleElem])
    -> (ModuleElem -> [Id]) -> ModuleElem -> [ModuleElem]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleElem -> [Id]
    children) [ModuleElem]
    ts,
                            [ModuleElem]
    fs [ModuleElem] -> [ModuleElem] -> [ModuleElem]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ (ModuleElem -> [ModuleElem]) -> [ModuleElem] -> [ModuleElem]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Id -> ModuleElem) -> [Id] -> [ModuleElem]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> ModuleElem
    Fun ([Id] -> [ModuleElem])
    -> (ModuleElem -> [Id]) -> ModuleElem -> [ModuleElem]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleElem -> [Id]
    children) [ModuleElem]
    cs
                          ]
        where cs :: [ModuleElem]
    cs = [Id -> [Id] -> ModuleElem
    Class (DynFlags -> TyCon -> Id
    forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    df TyCon
    tc) ((Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([ModuleElem] -> Id -> Bool
    alsoIn [ModuleElem]
    fs) ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> Id -> Id
    forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    df (Id -> Id) -> [Id] -> [Id]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Class -> [Id]
    GHC.classMethods Class
    c)
                   | GHC.ATyCon TyCon
    tc <- [TyThing]
    xs, Just Class
    c  <- [TyCon -> Maybe Class
    GHC.tyConClass_maybe TyCon
    tc]]
              ts :: [ModuleElem]
    ts = [Id -> [Id] -> ModuleElem
    Data  (DynFlags -> TyCon -> Id
    forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    df TyCon
    tc) ((Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([ModuleElem] -> Id -> Bool
    alsoIn [ModuleElem]
    ds) ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> DataCon -> Id
    forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    df (DataCon -> Id) -> [DataCon] -> [Id]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TyCon -> [DataCon]
    GHC.tyConDataCons TyCon
    tc)
                   | GHC.ATyCon TyCon
    tc <- [TyThing]
    xs, Maybe Class
    Nothing <- [TyCon -> Maybe Class
    GHC.tyConClass_maybe TyCon
    tc]]
              ds :: [ModuleElem]
    ds = [Id -> ModuleElem
    Fun (Id -> ModuleElem) -> Id -> ModuleElem
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> DataCon -> Id
    forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    df DataCon
    dc | GHC.AConLike (GHC.RealDataCon DataCon
    dc) <- [TyThing]
    xs]
              fs :: [ModuleElem]
    fs = [Id -> ModuleElem
    Fun (Id -> ModuleElem) -> Id -> ModuleElem
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> Id -> Id
    forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    df Id
    f  | GHC.AnId Id
    f                        <- [TyThing]
    xs]
              alsoIn :: [ModuleElem] -> Id -> Bool
    alsoIn [ModuleElem]
    es = (Id -> [Id] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (ModuleElem -> Id) -> [ModuleElem] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleElem -> Id
    name [ModuleElem]
    es)

    getUnqualName :: GHC.NamedThing a => GHC.DynFlags -> a -> String
    getUnqualName :: forall a. NamedThing a => DynFlags -> a -> Id
    getUnqualName DynFlags
    dfs = DynFlags -> SDoc -> Id
    GHC.showSDoc DynFlags
    dfs (SDoc -> Id) -> (a -> SDoc) -> a -> Id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> SDoc
    forall a. NamedThing a => a -> SDoc
    GHC.pprParenSymName