Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import GHC.Unit.Database
import GHC.Plugins
import GHC
import Data.Version
import GHC.Unit.Env
import GHC.Driver.Monad
import qualified Data.Map as M

main = do
  let libdir = "/home/matt/ghc-clean/_build/stage1/lib"
  runGhc (Just libdir) $ compilePackage
  runGhc (Just libdir) $ compileProject

myUnit :: UnitId
myUnit = UnitId (mkFastString "fake-uid")

myPkgName = PackageName (mkFastString "my-pkg")

myMod :: Module
myMod = mkModule (RealUnit (Definite myUnit)) (mkModuleName "MyLib")

modO = ModOrigin (Just True) [] [] True

fakeUnitInfo :: UnitInfo
fakeUnitInfo = GenericUnitInfo { unitId = myUnit
                               , unitInstanceOf = Indefinite myUnit
                               , unitInstantiations = []
                               , unitPackageId = PackageId (mkFastString "pkg")
                               , unitPackageName = myPkgName
                               , unitPackageVersion = makeVersion [0, 0]
                               , unitComponentName = Nothing
                               , unitAbiHash = ""
                               -- If you need these two, then you need to
                               -- get the info from the UnitState
                               , unitDepends = []
                               , unitAbiDepends = []
                               , unitImportDirs = ["/home/matt/ghc-clean/gergo"]
                               , unitLibraries = ["MyLib"]
                               , unitExtDepLibsSys = []
                               , unitExtDepLibsGhc = []
                               , unitLibraryDirs   = []
                               , unitLibraryDynDirs = []
                               , unitExtDepFrameworks = []
                               , unitExtDepFrameworkDirs = []
                               , unitLinkerOptions = []
                               , unitCcOptions = []
                               , unitIncludes = []
                               , unitIncludeDirs = []
                               , unitHaddockInterfaces = []
                               , unitHaddockHTMLs = []
                               , unitExposedModules = [(mkModuleName "MyLib", Nothing)]
                               , unitHiddenModules = []
                               , unitIsIndefinite  = False
                               , unitIsExposed  = True
                               , unitIsTrusted  = True
                               }
setupOpts :: [String] -> Ghc ()
setupOpts xs = do
  df1 <- getSessionDynFlags
  logger <- getLogger
  let cmdOpts = xs
  (df2, leftovers, warns) <- parseDynamicFlags logger df1 (map noLoc cmdOpts)
  setSessionDynFlags df2
  ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers
  setTargets ts

compilePackage :: Ghc ()
compilePackage = do
  -- Step 1: Compile "MyLib.hs"
  setupOpts ["-this-unit-id fake-uid", "MyLib"]
  () <$ load LoadAllTargets

addFakePackage :: HscEnv -> HscEnv
addFakePackage hsc_env = do
  hsc_env { hsc_unit_env = mod_us (hsc_unit_env hsc_env) }
  where
      mod_us ue = ue { ue_units = addUnit (ue_units ue) }
      addUnit us = us
            { packageNameMap = addToUFM (packageNameMap us) myPkgName (Indefinite myUnit)
            , unitInfoMap    = M.insert myUnit fakeUnitInfo $ unitInfoMap us
            , moduleNameProvidersMap = M.insert (mkModuleName "MyLib") (M.singleton myMod modO) $ moduleNameProvidersMap us
            }

compileProject :: Ghc ()
compileProject = do
  -- Step 1: Add the fake package to the UnitState
  setupOpts ["Test"]
  modifySession addFakePackage
  () <$ load LoadAllTargets

MyLib.hs

module MyLib where

Test.hs

{-# LANGUAGE PackageImports  #-}
module Test where
import "my-pkg" MyLib