I think this is an ok forum for this kind of question. You could also
try the haskell mailing list but I'm not sure if you will get more
help tehre.

I recently played around with the ghc api and I found the `hint` package
to be quite helpful as an example on how to do various
things when using the ghc api to implement your own interpreter.

Have you tried setting verbose? Perhaps the include dir is relative to
the working directory. In that case setting:

                  , workingDirectory = Just targetDir
                  , importPaths      = [targetDir] ++ importPaths dynflags

would mean ghc will search in targetDir/targetDir for Lib/Lib2. Should
be easy to say for sure by enabling verbosity and looking at the output.

Am 06/02/2023 um 13:42 schrieb Eternal Recursion via ghc-devs:
If this is the wrong forum for this question (which as I think about
it, I suppose it is) then redirection to a more appropriate mailing
list or forum (or any advice, really) would be appreciated. I just
figured this would be the forum with the best understanding of how the
GHC API works (and has changed over time), and my longer term goal is
indeed to contribute to it after I get past my learning curve.

Sincerely,

Bob

Sent with Proton Mail <https://proton.me/> secure email.

------- Original Message -------
On Saturday, February 4th, 2023 at 4:04 PM, Eternal Recursion via
ghc-devs <ghc-devs@haskell.org> wrote:

Hi Everyone!

I'm new here, trying to learn the GHC API. using 944 with cabal 3.8.1.0.

How do I correctly set a GHC Session's DynFlags (and/or other
properties) to ensure local libraries imported by the main target are
resolved properly at compile time?

What flags need to be set so that GHC is able to load/analyze/compile
all relevant Libraries in a package?

This is my current code:

withPath :: FilePath -> IO ()
withPath target = do
let targetDir = takeDirectory target
  let targetFile = takeFileName target
listing <- listDirectory targetDir
  let imports = filter (\f -> takeExtension f == ".hs") listing
  print imports
  let moduleName = mkModuleName targetFile
  g <- defaultErrorHandler defaultFatalMessager defaultFlushOut
    $ runGhc (Just libdir) $ do
initGhcMonad (Just libdir)
dynflags <- getSessionDynFlags
setSessionDynFlags $ dynflags { ghcLink          = LinkInMemory
                          , ghcMode          = CompManager
                          , backend          = Interpreter
                          , mainModuleNameIs = moduleName
                          , workingDirectory = Just targetDir
                          , importPaths      = [targetDir] ++
importPaths dynflags
                          }
targets <- mapM (\t -> guessTarget t Nothing Nothing) imports
setTargets targets
setContext [ IIDecl $ simpleImportDecl (mkModuleName "Prelude") ]
load LoadAllTargets
liftIO . print . ppr =<< getTargets
getModuleGraph
putStrLn "Here we go!"
  print $ ppr $ mgModSummaries g
putStrLn "☝️ "

However, when I run it (passing to example/app/Main.hs, in which
directory are Lib.hs and Lib2.hs, the latter being imported into
Main), I get:

$cabal run cli -- example/app/Main.hs
Up to date
["Main.hs","Lib.hs","Lib2.hs"]
[main:Main.hs, main:Lib.hs, main:Lib2.hs]
Here we go!
[ModSummary {
   ms_hs_hash = 23f9c4415bad851a1e36db9d813f34be
   ms_mod = Lib,
   unit = main
   ms_textual_imps = [(, Prelude)]
   ms_srcimps = []
},
ModSummary {
   ms_hs_hash = e1eccc23af49f3498a5a9566e63abefd
   ms_mod = Lib2,
   unit = main
   ms_textual_imps = [(, Prelude)]
   ms_srcimps = []
},
ModSummary {
   ms_hs_hash = 5f6751d7f0d5547a1bdf39af84f8c07f
   ms_mod = Main,
   unit = main
   ms_textual_imps = [(, Prelude), (, Lib2)]
   ms_srcimps = []
}]
☝

example/app/Main.hs:4:1: error:
   Could not find module ‘Lib2’
   Use -v (or `:set -v` in ghci) to see a list of the files searched for.
 |
4 |import qualified Lib2 as L2
 |^^^^^^^^^^^^^^^^^^^^^^^^^^^
cli: example/app/Main.hs:4:1: error:
   Could not find module `Lib2'
   Use -v (or `:set -v` in ghci) to see a list of the files searched
for.

​What do I need to do differently to make this work?

I have a local Cabal file I could use, but to know what I need out of
it, I need to understand the minimum required info to get this to
work. TIA!

Sincerely,

Bob

Sent with Proton Mail <https://proton.me/> secure email.


_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

Reply via email to