
Hello all, I'd like to learn how to use the ghc api programmatically, but I am finding the haddocks (on hackage) to be a bit overwhelming. Could somebody please help me out by pointing me in the direction of the parts of the haddocks that are relevant to access information from .hi files that are available in the current build environment? In particular, I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically. PS: I'm aware that the .hie format is up and coming. I'm very excited by this! But I'm going to be using ghc-8.4.x and ghc-8.6.x for the foreseeable future, so I am mostly interested in what they have to offer. -- Best regards, Sam

To answer my own question with a solution and another question: Sam Halliday writes:
I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically.
This is answered by Stephen Diehl's blog post on the ghc api! How lucky I am: http://www.stephendiehl.com/posts/ghc_01.html He points to getNamesInScope Unfortunately I'm getting zero Names back when loading a file that imports several modules from ghc. Is there something I'm missing in the following? module Main where import Control.Monad import Control.Monad.IO.Class import GHC import GHC.Paths (libdir) main = runGhc (Just libdir) $ do dflags <- getSessionDynFlags void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted , ghcLink = LinkInMemory } addTarget $ Target (TargetFile "exe/Main.hs" Nothing) False Nothing res <- load LoadAllTargets liftIO $ putStrLn $ showPpr dflags res names <- getNamesInScope liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names" -- Best regards, Sam

At a guess, because the ghc package defaults to being hidden (it's creating
a new ghc instance at runtime, so the visibility of the ghc package when
compiling your code is not relevant) you need to do the ghc-api equivalent
of "-package ghc". Or for testing just "ghc-pkg expose ghc".
On Fri, Aug 2, 2019 at 3:47 PM Sam Halliday
To answer my own question with a solution and another question:
Sam Halliday writes:
I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically.
This is answered by Stephen Diehl's blog post on the ghc api! How lucky I am: http://www.stephendiehl.com/posts/ghc_01.html
He points to getNamesInScope
Unfortunately I'm getting zero Names back when loading a file that imports several modules from ghc. Is there something I'm missing in the following?
module Main where
import Control.Monad import Control.Monad.IO.Class import GHC import GHC.Paths (libdir)
main = runGhc (Just libdir) $ do dflags <- getSessionDynFlags void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted , ghcLink = LinkInMemory } addTarget $ Target (TargetFile "exe/Main.hs" Nothing) False Nothing res <- load LoadAllTargets liftIO $ putStrLn $ showPpr dflags res names <- getNamesInScope liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names"
-- Best regards, Sam _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
-- brandon s allbery kf8nh allbery.b@gmail.com

Brandon Allbery
At a guess, because the ghc package defaults to being hidden (it's creating a new ghc instance at runtime, so the visibility of the ghc package when compiling your code is not relevant) you need to do the ghc-api equivalent of "-package ghc". Or for testing just "ghc-pkg expose ghc".
Hmm, would that also explain why the Prelude and Control.Monad modules are not shown either? Is there a way to expose all modules programmatically?
On Fri, Aug 2, 2019 at 3:47 PM Sam Halliday
wrote: To answer my own question with a solution and another question:
Sam Halliday writes:
I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically.
This is answered by Stephen Diehl's blog post on the ghc api! How lucky I am: http://www.stephendiehl.com/posts/ghc_01.html
He points to getNamesInScope
Unfortunately I'm getting zero Names back when loading a file that imports several modules from ghc. Is there something I'm missing in the following?
module Main where
import Control.Monad import Control.Monad.IO.Class import GHC import GHC.Paths (libdir)
main = runGhc (Just libdir) $ do dflags <- getSessionDynFlags void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted , ghcLink = LinkInMemory } addTarget $ Target (TargetFile "exe/Main.hs" Nothing) False Nothing res <- load LoadAllTargets liftIO $ putStrLn $ showPpr dflags res names <- getNamesInScope liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names"
-- Best regards, Sam _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
-- brandon s allbery kf8nh allbery.b@gmail.com
-- Best regards, Sam

No, those are in base. But I don't think you would be seeing imported names
as such there, come to think of it, only names declared locally.
On Fri, Aug 2, 2019 at 4:06 PM Sam Halliday
Brandon Allbery
writes: At a guess, because the ghc package defaults to being hidden (it's creating a new ghc instance at runtime, so the visibility of the ghc package when compiling your code is not relevant) you need to do the ghc-api equivalent of "-package ghc". Or for testing just "ghc-pkg expose ghc".
Hmm, would that also explain why the Prelude and Control.Monad modules are not shown either?
Is there a way to expose all modules programmatically?
On Fri, Aug 2, 2019 at 3:47 PM Sam Halliday
wrote:
To answer my own question with a solution and another question:
Sam Halliday writes:
I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically.
This is answered by Stephen Diehl's blog post on the ghc api! How lucky I am: http://www.stephendiehl.com/posts/ghc_01.html
He points to getNamesInScope
Unfortunately I'm getting zero Names back when loading a file that imports several modules from ghc. Is there something I'm missing in the following?
module Main where
import Control.Monad import Control.Monad.IO.Class import GHC import GHC.Paths (libdir)
main = runGhc (Just libdir) $ do dflags <- getSessionDynFlags void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted , ghcLink = LinkInMemory } addTarget $ Target (TargetFile "exe/Main.hs" Nothing) False Nothing res <- load LoadAllTargets liftIO $ putStrLn $ showPpr dflags res names <- getNamesInScope liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names"
-- Best regards, Sam _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
-- brandon s allbery kf8nh allbery.b@gmail.com
-- Best regards, Sam
-- brandon s allbery kf8nh allbery.b@gmail.com

Brandon Allbery
No, those are in base. But I don't think you would be seeing imported names as such there, come to think of it, only names declared locally.
Hmm, then perhaps I misunderstand what it's doing. If I do what I thought might be the equivalent ghci command λ> :l exe/Main.hs [1 of 1] Compiling Main ( exe/Main.hs, interpreted ) Ok, one module loaded. λ> :browse main :: IO () we see one symbol. So this is already different to what my application is doing. But the information I want is when we do something like λ> :browse! *Main ... everything in scope including Prelude and GHC ... An option I have considered would be to manually parse the import sections and then perform the Module lookup via the pkg database, but that approach has many flaws because it means reimplementing a lot of the early compilation stages manually and I'm sure dealing with explicit import lists (and hiding, not to mention dealing with lang extensions such as TypeOperators) is probably quite tricky to get right.
On Fri, Aug 2, 2019 at 4:06 PM Sam Halliday
wrote: Brandon Allbery
writes: At a guess, because the ghc package defaults to being hidden (it's creating a new ghc instance at runtime, so the visibility of the ghc package when compiling your code is not relevant) you need to do the ghc-api equivalent of "-package ghc". Or for testing just "ghc-pkg expose ghc".
Hmm, would that also explain why the Prelude and Control.Monad modules are not shown either?
Is there a way to expose all modules programmatically?
On Fri, Aug 2, 2019 at 3:47 PM Sam Halliday
wrote:
To answer my own question with a solution and another question:
Sam Halliday writes:
I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically.
This is answered by Stephen Diehl's blog post on the ghc api! How lucky I am: http://www.stephendiehl.com/posts/ghc_01.html
He points to getNamesInScope
Unfortunately I'm getting zero Names back when loading a file that imports several modules from ghc. Is there something I'm missing in the following?
module Main where
import Control.Monad import Control.Monad.IO.Class import GHC import GHC.Paths (libdir)
main = runGhc (Just libdir) $ do dflags <- getSessionDynFlags void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted , ghcLink = LinkInMemory } addTarget $ Target (TargetFile "exe/Main.hs" Nothing) False Nothing res <- load LoadAllTargets liftIO $ putStrLn $ showPpr dflags res names <- getNamesInScope liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names"
-- Best regards, Sam _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
-- brandon s allbery kf8nh allbery.b@gmail.com
-- Best regards, Sam
-- brandon s allbery kf8nh allbery.b@gmail.com
-- Best regards, Sam

Hey Sam,
Starting from the implementation of :browse and going through the call
graph in:
https://gitlab.haskell.org/ghc/ghc/blob/master/ghc/GHCi/UI.hs
gave the following, which works for me:
module Main where
import Control.Monad
import Control.Monad.IO.Class
import BasicTypes
import DynFlags
import GHC
import GHC.Paths (libdir)
import Maybes
import Panic
main = runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
void $ setSessionDynFlags $ dflags {
hscTarget = HscInterpreted
, ghcLink = LinkInMemory
}
t <- guessTarget "Main.hs" Nothing
setTargets [t]
_ <- load LoadAllTargets
graph <- getModuleGraph
mss <- filterM (isLoaded . ms_mod_name) (mgModSummaries graph)
let m = ms_mod ms
ms = head mss
liftIO . putStrLn $ (show . length $ mss) ++ " modules loaded"
mi <- getModuleInfo m
let mod_info = fromJust mi
dflags <- getDynFlags
let names = GHC.modInfoTopLevelScope mod_info `orElse` []
liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names"
--
Best, Artem
On Fri, 2 Aug 2019 at 15:47, Sam Halliday
To answer my own question with a solution and another question:
Sam Halliday writes:
I'm mostly interested in gathering information about symbols and their type signatures. As a first exercise: given a module+import section for a haskell source file, I want to find out which symbols (and their types) are available. Like :browse in ghci, but programmatically.
This is answered by Stephen Diehl's blog post on the ghc api! How lucky I am: http://www.stephendiehl.com/posts/ghc_01.html
He points to getNamesInScope
Unfortunately I'm getting zero Names back when loading a file that imports several modules from ghc. Is there something I'm missing in the following?
module Main where
import Control.Monad import Control.Monad.IO.Class import GHC import GHC.Paths (libdir)
main = runGhc (Just libdir) $ do dflags <- getSessionDynFlags void $ setSessionDynFlags $ dflags { hscTarget = HscInterpreted , ghcLink = LinkInMemory } addTarget $ Target (TargetFile "exe/Main.hs" Nothing) False Nothing res <- load LoadAllTargets liftIO $ putStrLn $ showPpr dflags res names <- getNamesInScope liftIO $ putStrLn $ "seen " <> (show $ length names) <> " Names"
-- Best regards, Sam _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
participants (3)
-
Artem Pelenitsyn
-
Brandon Allbery
-
Sam Halliday