module Hint.Context (
      isModuleInterpreted,
      loadModules, getLoadedModules, setTopLevelModules,
      setImports, setImportsQ, setImportsF,
      reset,

      PhantomModule(..),
      cleanPhantomModules,

      supportString, supportShow
) where

import Prelude hiding (mod)

import Data.Char
import Data.Either (partitionEithers)
import Data.List

import Control.Arrow ((***))

import Control.Monad       (liftM, filterM, unless, guard, foldM, (>=>))
import Control.Monad.Trans (liftIO)
import Control.Monad.Catch

import Hint.Base
import Hint.Conversions
import qualified Hint.CompatPlatform as Compat

import qualified Hint.GHC as GHC

import System.Random
import System.FilePath
import System.Directory

#if defined(NEED_PHANTOM_DIRECTORY)
import Data.Maybe (maybe)
import Hint.Configuration (setGhcOption)
import System.IO.Temp
#endif

type ModuleText = String

-- When creating a phantom module we have a situation similar to that of
-- @Hint.Util.safeBndFor@: we want to avoid picking a module name that is
-- already in-scope. Additionally, since this may be used with sandboxing in
-- mind we want to avoid easy-to-guess names. Thus, we do a trick similar
-- to the one in safeBndFor, but including a random number instead of an
-- additional digit. Finally, to avoid clashes between two processes
-- that are concurrently running with the same random seed (e.g., initialized
-- with the system time with not enough resolution), we also include the process id
newPhantomModule :: MonadInterpreter m => m PhantomModule
newPhantomModule :: m PhantomModule
newPhantomModule =
    do Int
n <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
forall a. Random a => IO a
randomIO
       Int
p <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
Compat.getPID
       (ls :: [ModuleName]
ls,is :: [ModuleName]
is) <- m ([ModuleName], [ModuleName])
forall (m :: * -> *).
MonadInterpreter m =>
m ([ModuleName], [ModuleName])
allModulesInContext
       let nums :: ModuleName
nums = [ModuleName] -> ModuleName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> ModuleName
forall a. Show a => a -> ModuleName
show (Int -> Int
forall a. Num a => a -> a
abs Int
n::Int), Int -> ModuleName
forall a. Show a => a -> ModuleName
show Int
p, (Char -> Bool) -> ModuleName -> ModuleName
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (ModuleName -> ModuleName) -> ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> ModuleName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ModuleName]
ls [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
is)]
       let mod_name :: ModuleName
mod_name = 'M'Char -> ModuleName -> ModuleName
forall a. a -> [a] -> [a]
:ModuleName
nums
       --
       ModuleName
tmp_dir <- m ModuleName
forall (m :: * -> *). MonadInterpreter m => m ModuleName
getPhantomDirectory
       --
       PhantomModule -> m PhantomModule
forall (m :: * -> *) a. Monad m => a -> m a
return PhantomModule :: ModuleName -> ModuleName -> PhantomModule
PhantomModule{pmName :: ModuleName
pmName = ModuleName
mod_name, pmFile :: ModuleName
pmFile = ModuleName
tmp_dir ModuleName -> ModuleName -> ModuleName
</> ModuleName
mod_name ModuleName -> ModuleName -> ModuleName
<.> "hs"}

getPhantomDirectory :: MonadInterpreter m => m FilePath
getPhantomDirectory :: m ModuleName
getPhantomDirectory =
#if defined(NEED_PHANTOM_DIRECTORY)
    -- When a module is loaded by file name, ghc-8.4.1 loses track of the
    -- file location after the first time it has been loaded, so we create
    -- a directory for the phantom modules and add it to the search path.
    do Maybe ModuleName
mfp <- (InterpreterState -> Maybe ModuleName) -> m (Maybe ModuleName)
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> Maybe ModuleName
phantomDirectory
       case Maybe ModuleName
mfp of
           Just fp :: ModuleName
fp -> ModuleName -> m ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleName
fp
           Nothing -> do ModuleName
tmp_dir <- IO ModuleName -> m ModuleName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ModuleName
getTemporaryDirectory
                         ModuleName
fp <- IO ModuleName -> m ModuleName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModuleName -> m ModuleName) -> IO ModuleName -> m ModuleName
forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleName -> IO ModuleName
createTempDirectory ModuleName
tmp_dir "hint"
                         (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{ phantomDirectory :: Maybe ModuleName
phantomDirectory = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
fp })
                         ModuleName -> m ()
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m ()
setGhcOption (ModuleName -> m ()) -> ModuleName -> m ()
forall a b. (a -> b) -> a -> b
$ "-i" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
fp
                         ModuleName -> m ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleName
fp
#else
    liftIO getTemporaryDirectory
#endif

allModulesInContext :: MonadInterpreter m => m ([ModuleName], [ModuleName])
allModulesInContext :: m ([ModuleName], [ModuleName])
allModulesInContext = RunGhc m ([ModuleName], [ModuleName])
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
GhcT n ([ModuleName], [ModuleName])
forall (m :: * -> *). GhcMonad m => m ([ModuleName], [ModuleName])
getContextNames

getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.ImportDecl GHC.GhcPs])
getContext :: m ([Module], [ImportDecl GhcPs])
getContext = m [InteractiveImport]
forall (m :: * -> *). GhcMonad m => m [InteractiveImport]
GHC.getContext m [InteractiveImport]
-> ([InteractiveImport] -> m ([Module], [ImportDecl GhcPs]))
-> m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (([Module], [ImportDecl GhcPs])
 -> InteractiveImport -> m ([Module], [ImportDecl GhcPs]))
-> ([Module], [ImportDecl GhcPs])
-> [InteractiveImport]
-> m ([Module], [ImportDecl GhcPs])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Module], [ImportDecl GhcPs])
-> InteractiveImport -> m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *).
GhcMonad m =>
([Module], [ImportDecl GhcPs])
-> InteractiveImport -> m ([Module], [ImportDecl GhcPs])
f ([], [])
  where
    f :: (GHC.GhcMonad m) =>
         ([GHC.Module], [GHC.ImportDecl GHC.GhcPs]) ->
         GHC.InteractiveImport ->
         m ([GHC.Module], [GHC.ImportDecl GHC.GhcPs])
    f :: ([Module], [ImportDecl GhcPs])
-> InteractiveImport -> m ([Module], [ImportDecl GhcPs])
f (ns :: [Module]
ns, ds :: [ImportDecl GhcPs]
ds) i :: InteractiveImport
i = case InteractiveImport
i of
      (GHC.IIDecl d :: ImportDecl GhcPs
d)     -> ([Module], [ImportDecl GhcPs]) -> m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Module]
ns, ImportDecl GhcPs
d ImportDecl GhcPs -> [ImportDecl GhcPs] -> [ImportDecl GhcPs]
forall a. a -> [a] -> [a]
: [ImportDecl GhcPs]
ds)
      m :: InteractiveImport
m@(GHC.IIModule _) -> do Module
n <- InteractiveImport -> m Module
forall (m :: * -> *). GhcMonad m => InteractiveImport -> m Module
iiModToMod InteractiveImport
m; ([Module], [ImportDecl GhcPs]) -> m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a. Monad m => a -> m a
return (Module
n Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: [Module]
ns, [ImportDecl GhcPs]
ds)

modToIIMod :: GHC.Module -> GHC.InteractiveImport
modToIIMod :: Module -> InteractiveImport
modToIIMod = ModuleName -> InteractiveImport
GHC.IIModule (ModuleName -> InteractiveImport)
-> (Module -> ModuleName) -> Module -> InteractiveImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
GHC.moduleName

iiModToMod :: GHC.GhcMonad m => GHC.InteractiveImport -> m GHC.Module
iiModToMod :: InteractiveImport -> m Module
iiModToMod (GHC.IIModule m :: ModuleName
m) = ModuleName -> Maybe FastString -> m Module
forall (m :: * -> *).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.findModule ModuleName
m Maybe FastString
forall a. Maybe a
Nothing
iiModToMod _ = ModuleName -> m Module
forall a. HasCallStack => ModuleName -> a
error "iiModToMod!"

getContextNames :: GHC.GhcMonad m => m([String], [String])
getContextNames :: m ([ModuleName], [ModuleName])
getContextNames = (([Module], [ImportDecl GhcPs]) -> ([ModuleName], [ModuleName]))
-> m ([Module], [ImportDecl GhcPs])
-> m ([ModuleName], [ModuleName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Module -> ModuleName) -> [Module] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map Module -> ModuleName
name ([Module] -> [ModuleName])
-> ([ImportDecl GhcPs] -> [ModuleName])
-> ([Module], [ImportDecl GhcPs])
-> ([ModuleName], [ModuleName])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (ImportDecl GhcPs -> ModuleName)
-> [ImportDecl GhcPs] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl GhcPs -> ModuleName
forall pass. ImportDecl pass -> ModuleName
decl) m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
    where name :: Module -> ModuleName
name = ModuleName -> ModuleName
GHC.moduleNameString (ModuleName -> ModuleName)
-> (Module -> ModuleName) -> Module -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
GHC.moduleName
          decl :: ImportDecl pass -> ModuleName
decl = ModuleName -> ModuleName
GHC.moduleNameString (ModuleName -> ModuleName)
-> (ImportDecl pass -> ModuleName) -> ImportDecl pass -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc (Located ModuleName -> ModuleName)
-> (ImportDecl pass -> Located ModuleName)
-> ImportDecl pass
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl pass -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
GHC.ideclName

setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.GhcPs] -> m ()
setContext :: [Module] -> [ImportDecl GhcPs] -> m ()
setContext ms :: [Module]
ms ds :: [ImportDecl GhcPs]
ds =
  let ms' :: [InteractiveImport]
ms' = (Module -> InteractiveImport) -> [Module] -> [InteractiveImport]
forall a b. (a -> b) -> [a] -> [b]
map Module -> InteractiveImport
modToIIMod [Module]
ms
      ds' :: [InteractiveImport]
ds' = (ImportDecl GhcPs -> InteractiveImport)
-> [ImportDecl GhcPs] -> [InteractiveImport]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl GhcPs -> InteractiveImport
GHC.IIDecl [ImportDecl GhcPs]
ds
      is :: [InteractiveImport]
is = [InteractiveImport]
ms' [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a] -> [a]
++ [InteractiveImport]
ds'
  in [InteractiveImport] -> m ()
forall (m :: * -> *). GhcMonad m => [InteractiveImport] -> m ()
GHC.setContext [InteractiveImport]
is

-- Explicitly-typed variants of getContext/setContext, for use where we modify
-- or override the context.
setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()
setContextModules :: [Module] -> [Module] -> m ()
setContextModules as :: [Module]
as = [Module] -> [ImportDecl GhcPs] -> m ()
forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
as ([ImportDecl GhcPs] -> m ())
-> ([Module] -> [ImportDecl GhcPs]) -> [Module] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module -> ImportDecl GhcPs) -> [Module] -> [ImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> ImportDecl GhcPs
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
GHC.simpleImportDecl (ModuleName -> ImportDecl GhcPs)
-> (Module -> ModuleName) -> Module -> ImportDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
GHC.moduleName)

fileTarget :: FilePath -> GHC.Target
fileTarget :: ModuleName -> Target
fileTarget f :: ModuleName
f = TargetId -> Bool -> Maybe (InputFileBuffer, UTCTime) -> Target
GHC.Target (ModuleName -> Maybe Phase -> TargetId
GHC.TargetFile ModuleName
f (Maybe Phase -> TargetId) -> Maybe Phase -> TargetId
forall a b. (a -> b) -> a -> b
$ Phase -> Maybe Phase
forall a. a -> Maybe a
Just Phase
next_phase) Bool
True Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
Nothing
    where next_phase :: Phase
next_phase = HscSource -> Phase
GHC.Cpp HscSource
GHC.HsSrcFile

addPhantomModule :: MonadInterpreter m
                 => (ModuleName -> ModuleText)
                 -> m PhantomModule
addPhantomModule :: (ModuleName -> ModuleName) -> m PhantomModule
addPhantomModule mod_text :: ModuleName -> ModuleName
mod_text =
    do PhantomModule
pm <- m PhantomModule
forall (m :: * -> *). MonadInterpreter m => m PhantomModule
newPhantomModule
       let t :: Target
t = ModuleName -> Target
fileTarget (PhantomModule -> ModuleName
pmFile PhantomModule
pm)
           m :: ModuleName
m = ModuleName -> ModuleName
GHC.mkModuleName (PhantomModule -> ModuleName
pmName PhantomModule
pm)
       --
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleName -> IO ()
writeFile (PhantomModule -> ModuleName
pmFile PhantomModule
pm) (ModuleName -> ModuleName
mod_text (ModuleName -> ModuleName) -> ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ PhantomModule -> ModuleName
pmName PhantomModule
pm)
       --
       (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{activePhantoms :: [PhantomModule]
activePhantoms = PhantomModule
pmPhantomModule -> [PhantomModule] -> [PhantomModule]
forall a. a -> [a] -> [a]
:InterpreterState -> [PhantomModule]
activePhantoms InterpreterState
s})
       m (Maybe ()) -> m ()
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (do -- GHC.load will remove all the modules from scope, so first
                   -- we save the context...
                   (old_top :: [Module]
old_top, old_imps :: [ImportDecl GhcPs]
old_imps) <- RunGhc m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
GhcT n ([Module], [ImportDecl GhcPs])
forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
                   --
                   RunGhc1 m Target ()
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
Target -> GhcT n ()
forall (m :: * -> *). GhcMonad m => Target -> m ()
GHC.addTarget Target
t
                   SuccessFlag
res <- RunGhc1 m LoadHowMuch SuccessFlag
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
LoadHowMuch -> GhcT n SuccessFlag
forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load (ModuleName -> LoadHowMuch
GHC.LoadUpTo ModuleName
m)
                   --
                   if SuccessFlag -> Bool
isSucceeded SuccessFlag
res
                     then do RunGhc2 m [Module] [ImportDecl GhcPs] ()
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Module] -> [ImportDecl GhcPs] -> GhcT n ()
forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
old_top [ImportDecl GhcPs]
old_imps
                             Maybe () -> m (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> m (Maybe ())) -> Maybe () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
                     else Maybe () -> m (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing)
        m () -> (InterpreterError -> m ()) -> m ()
forall (m :: * -> *) a.
MonadInterpreter m =>
m a -> (InterpreterError -> m a) -> m a
`catchIE` (\err :: InterpreterError
err -> case InterpreterError
err of
                             WontCompile _ -> do PhantomModule -> m ()
forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule PhantomModule
pm
                                                 InterpreterError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
err
                             _             -> InterpreterError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
err)
       --
       PhantomModule -> m PhantomModule
forall (m :: * -> *) a. Monad m => a -> m a
return PhantomModule
pm

removePhantomModule :: MonadInterpreter m => PhantomModule -> m ()
removePhantomModule :: PhantomModule -> m ()
removePhantomModule pm :: PhantomModule
pm =
    do -- We don't want to actually unload this module, because that
       -- would mean that all the real modules might get reloaded and the
       -- user didn't require that (they may be in a non-compiling state!).
       -- However, this means that we can't actually delete the file, because
       -- it is an active target. Therefore, we simply take it out of scope
       -- and mark it as "delete me when possible" (i.e., next time the
       -- @loadModules@ function is called).
       --
       Bool
isLoaded <- ModuleName -> m Bool
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Bool
moduleIsLoaded (ModuleName -> m Bool) -> ModuleName -> m Bool
forall a b. (a -> b) -> a -> b
$ PhantomModule -> ModuleName
pmName PhantomModule
pm
       Bool
safeToRemove <-
           if Bool
isLoaded
             then do -- take it out of scope
                     Module
mod <- ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (PhantomModule -> ModuleName
pmName PhantomModule
pm)
                     (mods :: [Module]
mods, imps :: [ImportDecl GhcPs]
imps) <- RunGhc m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
GhcT n ([Module], [ImportDecl GhcPs])
forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
                     let mods' :: [Module]
mods' = (Module -> Bool) -> [Module] -> [Module]
forall a. (a -> Bool) -> [a] -> [a]
filter (Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/=) [Module]
mods
                     RunGhc2 m [Module] [ImportDecl GhcPs] ()
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Module] -> [ImportDecl GhcPs] -> GhcT n ()
forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
mods' [ImportDecl GhcPs]
imps
                     --
                     let isNotPhantom :: Module -> m Bool
isNotPhantom = ModuleName -> m Bool
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Bool
isPhantomModule (ModuleName -> m Bool)
-> (Module -> ModuleName) -> Module -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
moduleToString  (Module -> m Bool) -> (Bool -> m Bool) -> Module -> m Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                                          Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (Bool -> Bool) -> Bool -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
                     [Module] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Module] -> Bool) -> m [Module] -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Module -> m Bool) -> [Module] -> m [Module]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Module -> m Bool
isNotPhantom [Module]
mods'
             else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       --
       let file_name :: ModuleName
file_name = PhantomModule -> ModuleName
pmFile PhantomModule
pm
       RunGhc1 m TargetId ()
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
TargetId -> GhcT n ()
forall (m :: * -> *). GhcMonad m => TargetId -> m ()
GHC.removeTarget (Target -> TargetId
GHC.targetId (Target -> TargetId) -> Target -> TargetId
forall a b. (a -> b) -> a -> b
$ ModuleName -> Target
fileTarget ModuleName
file_name)
       --
       (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{activePhantoms :: [PhantomModule]
activePhantoms = (PhantomModule -> Bool) -> [PhantomModule] -> [PhantomModule]
forall a. (a -> Bool) -> [a] -> [a]
filter (PhantomModule
pm PhantomModule -> PhantomModule -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([PhantomModule] -> [PhantomModule])
-> [PhantomModule] -> [PhantomModule]
forall a b. (a -> b) -> a -> b
$ InterpreterState -> [PhantomModule]
activePhantoms InterpreterState
s})
       --
       if Bool
safeToRemove
         then m (Maybe ()) -> m ()
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (m (Maybe ()) -> m ()) -> m (Maybe ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do SuccessFlag
res <- RunGhc1 m LoadHowMuch SuccessFlag
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
LoadHowMuch -> GhcT n SuccessFlag
forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
GHC.LoadAllTargets
                           Maybe () -> m (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> m (Maybe ())) -> Maybe () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SuccessFlag -> Bool
isSucceeded SuccessFlag
res) Maybe () -> Maybe () -> Maybe ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Maybe ()
forall a. a -> Maybe a
Just ()
              m (Maybe ()) -> m () -> m (Maybe ())
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> IO ()
removeFile (PhantomModule -> ModuleName
pmFile PhantomModule
pm)
         else (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{zombiePhantoms :: [PhantomModule]
zombiePhantoms = PhantomModule
pmPhantomModule -> [PhantomModule] -> [PhantomModule]
forall a. a -> [a] -> [a]
:InterpreterState -> [PhantomModule]
zombiePhantoms InterpreterState
s})

-- Returns a tuple with the active and zombie phantom modules respectively
getPhantomModules :: MonadInterpreter m => m ([PhantomModule], [PhantomModule])
getPhantomModules :: m ([PhantomModule], [PhantomModule])
getPhantomModules = do [PhantomModule]
active <- (InterpreterState -> [PhantomModule]) -> m [PhantomModule]
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
activePhantoms
                       [PhantomModule]
zombie <- (InterpreterState -> [PhantomModule]) -> m [PhantomModule]
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
zombiePhantoms
                       ([PhantomModule], [PhantomModule])
-> m ([PhantomModule], [PhantomModule])
forall (m :: * -> *) a. Monad m => a -> m a
return ([PhantomModule]
active, [PhantomModule]
zombie)

isPhantomModule :: MonadInterpreter m => ModuleName -> m Bool
isPhantomModule :: ModuleName -> m Bool
isPhantomModule mn :: ModuleName
mn = do (as :: [PhantomModule]
as,zs :: [PhantomModule]
zs) <- m ([PhantomModule], [PhantomModule])
forall (m :: * -> *).
MonadInterpreter m =>
m ([PhantomModule], [PhantomModule])
getPhantomModules
                        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ModuleName
mn ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (PhantomModule -> ModuleName) -> [PhantomModule] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map PhantomModule -> ModuleName
pmName ([PhantomModule]
as [PhantomModule] -> [PhantomModule] -> [PhantomModule]
forall a. [a] -> [a] -> [a]
++ [PhantomModule]
zs)

-- | Tries to load all the requested modules from their source file.
--   Modules my be indicated by their ModuleName (e.g. \"My.Module\") or
--   by the full path to its source file.
--
-- The interpreter is 'reset' both before loading the modules and in the event
-- of an error.
--
-- /IMPORTANT/: Like in a ghci session, this will also load (and interpret)
--  any dependency that is not available via an installed package. Make
--  sure that you are not loading any module that is also being used to
--  compile your application.  In particular, you need to avoid modules
--  that define types that will later occur in an expression that you will
--  want to interpret.
--
-- The problem in doing this is that those types will have two incompatible
-- representations at runtime: 1) the one in the compiled code and 2) the
-- one in the interpreted code. When interpreting such an expression (bringing
-- it to program-code) you will likely get a segmentation fault, since the
-- latter representation will be used where the program assumes the former.
--
-- The rule of thumb is: never make the interpreter run on the directory
-- with the source code of your program! If you want your interpreted code to
-- use some type that is defined in your program, then put the defining module
-- on a library and make your program depend on that package.
loadModules :: MonadInterpreter m => [String] -> m ()
loadModules :: [ModuleName] -> m ()
loadModules fs :: [ModuleName]
fs = do -- first, unload everything, and do some clean-up
                    m ()
forall (m :: * -> *). MonadInterpreter m => m ()
reset
                    [ModuleName] -> m ()
forall (m :: * -> *). MonadInterpreter m => [ModuleName] -> m ()
doLoad [ModuleName]
fs m () -> (InterpreterError -> m ()) -> m ()
forall (m :: * -> *) a.
MonadInterpreter m =>
m a -> (InterpreterError -> m a) -> m a
`catchIE` (\e :: InterpreterError
e -> m ()
forall (m :: * -> *). MonadInterpreter m => m ()
reset m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InterpreterError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
e)

doLoad :: MonadInterpreter m => [String] -> m ()
doLoad :: [ModuleName] -> m ()
doLoad fs :: [ModuleName]
fs = m (Maybe ()) -> m ()
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (m (Maybe ()) -> m ()) -> m (Maybe ()) -> m ()
forall a b. (a -> b) -> a -> b
$ do
                   [Target]
targets <- (ModuleName -> m Target) -> [ModuleName] -> m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\f :: ModuleName
f->RunGhc2 m ModuleName (Maybe Phase) Target
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
ModuleName -> Maybe Phase -> GhcT n Target
forall (m :: * -> *).
GhcMonad m =>
ModuleName -> Maybe Phase -> m Target
GHC.guessTarget ModuleName
f Maybe Phase
forall a. Maybe a
Nothing) [ModuleName]
fs
                   --
                   RunGhc1 m [Target] ()
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Target] -> GhcT n ()
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
targets
                   SuccessFlag
res <- RunGhc1 m LoadHowMuch SuccessFlag
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
LoadHowMuch -> GhcT n SuccessFlag
forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
GHC.LoadAllTargets
                   -- loading the targets removes the support module
                   m ()
forall (m :: * -> *). MonadInterpreter m => m ()
reinstallSupportModule
                   Maybe () -> m (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> m (Maybe ())) -> Maybe () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SuccessFlag -> Bool
isSucceeded SuccessFlag
res) Maybe () -> Maybe () -> Maybe ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Maybe ()
forall a. a -> Maybe a
Just ()

-- | Returns True if the module was interpreted.
isModuleInterpreted :: MonadInterpreter m => ModuleName -> m Bool
isModuleInterpreted :: ModuleName -> m Bool
isModuleInterpreted m :: ModuleName
m = ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule ModuleName
m m Module -> (Module -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RunGhc1 m Module Bool
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
Module -> GhcT n Bool
forall (m :: * -> *). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted

-- | Returns the list of modules loaded with 'loadModules'.
getLoadedModules :: MonadInterpreter m => m [ModuleName]
getLoadedModules :: m [ModuleName]
getLoadedModules = do (active_pms :: [PhantomModule]
active_pms, zombie_pms :: [PhantomModule]
zombie_pms) <- m ([PhantomModule], [PhantomModule])
forall (m :: * -> *).
MonadInterpreter m =>
m ([PhantomModule], [PhantomModule])
getPhantomModules
                      [ModuleName]
ms <- (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
modNameFromSummary ([ModSummary] -> [ModuleName]) -> m [ModSummary] -> m [ModuleName]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m [ModSummary]
forall (m :: * -> *). MonadInterpreter m => m [ModSummary]
getLoadedModSummaries
                      [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ModuleName] -> m [ModuleName]) -> [ModuleName] -> m [ModuleName]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
ms [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Eq a => [a] -> [a] -> [a]
\\ (PhantomModule -> ModuleName) -> [PhantomModule] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map PhantomModule -> ModuleName
pmName ([PhantomModule]
active_pms [PhantomModule] -> [PhantomModule] -> [PhantomModule]
forall a. [a] -> [a] -> [a]
++ [PhantomModule]
zombie_pms)

modNameFromSummary :: GHC.ModSummary -> ModuleName
modNameFromSummary :: ModSummary -> ModuleName
modNameFromSummary = Module -> ModuleName
moduleToString (Module -> ModuleName)
-> (ModSummary -> Module) -> ModSummary -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
GHC.ms_mod

getLoadedModSummaries :: MonadInterpreter m => m [GHC.ModSummary]
getLoadedModSummaries :: m [ModSummary]
getLoadedModSummaries =
  do ModuleGraph
all_mod_summ <- RunGhc m ModuleGraph
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
GhcT n ModuleGraph
forall (m :: * -> *). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
     (ModSummary -> m Bool) -> [ModSummary] -> m [ModSummary]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (RunGhc1 m ModuleName Bool
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
ModuleName -> GhcT n Bool
forall (m :: * -> *). GhcMonad m => ModuleName -> m Bool
GHC.isLoaded (ModuleName -> m Bool)
-> (ModSummary -> ModuleName) -> ModSummary -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModuleName
GHC.ms_mod_name)
             (ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
all_mod_summ)

-- | Sets the modules whose context is used during evaluation. All bindings
--   of these modules are in scope, not only those exported.
--
--   Modules must be interpreted to use this function.
setTopLevelModules :: MonadInterpreter m => [ModuleName] -> m ()
setTopLevelModules :: [ModuleName] -> m ()
setTopLevelModules ms :: [ModuleName]
ms =
    do [ModSummary]
loaded_mods_ghc <- m [ModSummary]
forall (m :: * -> *). MonadInterpreter m => m [ModSummary]
getLoadedModSummaries
       --
       let not_loaded :: [ModuleName]
not_loaded = [ModuleName]
ms [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Eq a => [a] -> [a] -> [a]
\\ (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
modNameFromSummary [ModSummary]
loaded_mods_ghc
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
not_loaded) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
         InterpreterError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (InterpreterError -> m ()) -> InterpreterError -> m ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> InterpreterError
NotAllowed ("These modules have not been loaded:\n" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++
                              [ModuleName] -> ModuleName
unlines [ModuleName]
not_loaded)
       --
       [PhantomModule]
active_pms <- (InterpreterState -> [PhantomModule]) -> m [PhantomModule]
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
activePhantoms
       [Module]
ms_mods <- (ModuleName -> m Module) -> [ModuleName] -> m [Module]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule ([ModuleName] -> [ModuleName]
forall a. Eq a => [a] -> [a]
nub ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
ms [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ (PhantomModule -> ModuleName) -> [PhantomModule] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map PhantomModule -> ModuleName
pmName [PhantomModule]
active_pms)
       --
       let mod_is_interpr :: Module -> m Bool
mod_is_interpr = RunGhc1 m Module Bool
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
Module -> GhcT n Bool
forall (m :: * -> *). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted
       [Module]
not_interpreted <- (Module -> m Bool) -> [Module] -> m [Module]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> (Module -> m Bool) -> Module -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> m Bool
mod_is_interpr) [Module]
ms_mods
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Module] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Module]
not_interpreted) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
         InterpreterError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (InterpreterError -> m ()) -> InterpreterError -> m ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> InterpreterError
NotAllowed ("These modules are not interpreted:\n" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++
                              [ModuleName] -> ModuleName
unlines ((Module -> ModuleName) -> [Module] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map Module -> ModuleName
moduleToString [Module]
not_interpreted))
       --
       (_, old_imports :: [ImportDecl GhcPs]
old_imports) <- RunGhc m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
GhcT n ([Module], [ImportDecl GhcPs])
forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
       RunGhc2 m [Module] [ImportDecl GhcPs] ()
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Module] -> [ImportDecl GhcPs] -> GhcT n ()
forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module]
ms_mods [ImportDecl GhcPs]
old_imports

-- | Sets the modules whose exports must be in context.
--
--   Warning: 'setImports', 'setImportsQ', and 'setImportsF' are mutually exclusive.
--   If you have a list of modules to be used qualified and another list
--   unqualified, then you need to do something like
--
--   >  setImportsQ ((zip unqualified $ repeat Nothing) ++ qualifieds)
setImports :: MonadInterpreter m => [ModuleName] -> m ()
setImports :: [ModuleName] -> m ()
setImports ms :: [ModuleName]
ms = [ModuleImport] -> m ()
forall (m :: * -> *). MonadInterpreter m => [ModuleImport] -> m ()
setImportsF ([ModuleImport] -> m ()) -> [ModuleImport] -> m ()
forall a b. (a -> b) -> a -> b
$ (ModuleName -> ModuleImport) -> [ModuleName] -> [ModuleImport]
forall a b. (a -> b) -> [a] -> [b]
map (\m :: ModuleName
m -> ModuleName -> ModuleQualification -> ImportList -> ModuleImport
ModuleImport ModuleName
m ModuleQualification
NotQualified ImportList
NoImportList) [ModuleName]
ms

-- | Sets the modules whose exports must be in context; some
--   of them may be qualified. E.g.:
--
--   @setImportsQ [("Prelude", Nothing), ("Data.Map", Just "M")]@.
--
--   Here, "map" will refer to Prelude.map and "M.map" to Data.Map.map.
setImportsQ :: MonadInterpreter m => [(ModuleName, Maybe String)] -> m ()
setImportsQ :: [(ModuleName, Maybe ModuleName)] -> m ()
setImportsQ ms :: [(ModuleName, Maybe ModuleName)]
ms = [ModuleImport] -> m ()
forall (m :: * -> *). MonadInterpreter m => [ModuleImport] -> m ()
setImportsF ([ModuleImport] -> m ()) -> [ModuleImport] -> m ()
forall a b. (a -> b) -> a -> b
$ ((ModuleName, Maybe ModuleName) -> ModuleImport)
-> [(ModuleName, Maybe ModuleName)] -> [ModuleImport]
forall a b. (a -> b) -> [a] -> [b]
map (\(m :: ModuleName
m,q :: Maybe ModuleName
q) -> ModuleName -> ModuleQualification -> ImportList -> ModuleImport
ModuleImport ModuleName
m (ModuleQualification
-> (ModuleName -> ModuleQualification)
-> Maybe ModuleName
-> ModuleQualification
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ModuleQualification
NotQualified (Maybe ModuleName -> ModuleQualification
QualifiedAs (Maybe ModuleName -> ModuleQualification)
-> (ModuleName -> Maybe ModuleName)
-> ModuleName
-> ModuleQualification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just) Maybe ModuleName
q) ImportList
NoImportList) [(ModuleName, Maybe ModuleName)]
ms

-- | Sets the modules whose exports must be in context; some
--   may be qualified or have imports lists. E.g.:
--
--   @setImportsF [ModuleImport "Prelude" NotQualified NoImportList, ModuleImport "Data.Text" (QualifiedAs $ Just "Text") (HidingList ["pack"])]@

setImportsF :: MonadInterpreter m => [ModuleImport] -> m ()
setImportsF :: [ModuleImport] -> m ()
setImportsF ms :: [ModuleImport]
ms = do
       [Module]
regularMods <- (ModuleImport -> m Module) -> [ModuleImport] -> m [Module]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (ModuleName -> m Module)
-> (ModuleImport -> ModuleName) -> ModuleImport -> m Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleImport -> ModuleName
modName) [ModuleImport]
regularImports
       (ModuleImport -> m Module) -> [ModuleImport] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (ModuleName -> m Module)
-> (ModuleImport -> ModuleName) -> ModuleImport -> m Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleImport -> ModuleName
modName) [ModuleImport]
phantomImports -- just to be sure they exist
       --
       Maybe PhantomModule
old_qual_hack_mod <- (InterpreterState -> Maybe PhantomModule)
-> m (Maybe PhantomModule)
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> Maybe PhantomModule
importQualHackMod
       m () -> (PhantomModule -> m ()) -> Maybe PhantomModule -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) PhantomModule -> m ()
forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule Maybe PhantomModule
old_qual_hack_mod
       --
       Maybe PhantomModule
new_pm <- if [ModuleImport] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleImport]
phantomImports
                   then Maybe PhantomModule -> m (Maybe PhantomModule)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PhantomModule
forall a. Maybe a
Nothing
                   else do
                     PhantomModule
new_pm <- (ModuleName -> ModuleName) -> m PhantomModule
forall (m :: * -> *).
MonadInterpreter m =>
(ModuleName -> ModuleName) -> m PhantomModule
addPhantomModule ((ModuleName -> ModuleName) -> m PhantomModule)
-> (ModuleName -> ModuleName) -> m PhantomModule
forall a b. (a -> b) -> a -> b
$ \mod_name :: ModuleName
mod_name -> [ModuleName] -> ModuleName
unlines ([ModuleName] -> ModuleName) -> [ModuleName] -> ModuleName
forall a b. (a -> b) -> a -> b
$
                                ("module " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " where ") ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
:
                                (ModuleImport -> ModuleName) -> [ModuleImport] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleImport -> ModuleName
newImportLine [ModuleImport]
phantomImports
                     (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{importQualHackMod :: Maybe PhantomModule
importQualHackMod = PhantomModule -> Maybe PhantomModule
forall a. a -> Maybe a
Just PhantomModule
new_pm})
                     Maybe PhantomModule -> m (Maybe PhantomModule)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PhantomModule -> m (Maybe PhantomModule))
-> Maybe PhantomModule -> m (Maybe PhantomModule)
forall a b. (a -> b) -> a -> b
$ PhantomModule -> Maybe PhantomModule
forall a. a -> Maybe a
Just PhantomModule
new_pm
       --
       [Module]
pm <- m [Module]
-> (PhantomModule -> m [Module])
-> Maybe PhantomModule
-> m [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Module] -> m [Module]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (ModuleName -> m Module)
-> (PhantomModule -> ModuleName) -> PhantomModule -> m Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhantomModule -> ModuleName
pmName (PhantomModule -> m Module)
-> (Module -> m [Module]) -> PhantomModule -> m [Module]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Module] -> m [Module]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Module] -> m [Module])
-> (Module -> [Module]) -> Module -> m [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Module]
forall (m :: * -> *) a. Monad m => a -> m a
return) Maybe PhantomModule
new_pm
       (old_top_level :: [Module]
old_top_level, _) <- RunGhc m ([Module], [ImportDecl GhcPs])
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
GhcT n ([Module], [ImportDecl GhcPs])
forall (m :: * -> *).
GhcMonad m =>
m ([Module], [ImportDecl GhcPs])
getContext
       let new_top_level :: [Module]
new_top_level = [Module]
pm [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
old_top_level
       RunGhc2 m [Module] [Module] ()
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Module] -> [Module] -> GhcT n ()
forall (m :: * -> *). GhcMonad m => [Module] -> [Module] -> m ()
setContextModules [Module]
new_top_level [Module]
regularMods
       --
       (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s ->InterpreterState
s{qualImports :: [ModuleImport]
qualImports = [ModuleImport]
phantomImports})
  where
    (regularImports :: [ModuleImport]
regularImports, phantomImports :: [ModuleImport]
phantomImports) = [Either ModuleImport ModuleImport]
-> ([ModuleImport], [ModuleImport])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ModuleImport ModuleImport]
 -> ([ModuleImport], [ModuleImport]))
-> [Either ModuleImport ModuleImport]
-> ([ModuleImport], [ModuleImport])
forall a b. (a -> b) -> a -> b
$ (ModuleImport -> Either ModuleImport ModuleImport)
-> [ModuleImport] -> [Either ModuleImport ModuleImport]
forall a b. (a -> b) -> [a] -> [b]
map (\m :: ModuleImport
m -> if ModuleImport -> Bool
isQualified ModuleImport
m Bool -> Bool -> Bool
|| ModuleImport -> Bool
hasImportList ModuleImport
m
                                                                       then ModuleImport -> Either ModuleImport ModuleImport
forall a b. b -> Either a b
Right ModuleImport
m
                                                                       else ModuleImport -> Either ModuleImport ModuleImport
forall a b. a -> Either a b
Left ModuleImport
m) [ModuleImport]
ms
    isQualified :: ModuleImport -> Bool
isQualified m :: ModuleImport
m = ModuleImport -> ModuleQualification
modQual ModuleImport
m ModuleQualification -> ModuleQualification -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleQualification
NotQualified
    hasImportList :: ModuleImport -> Bool
hasImportList m :: ModuleImport
m = ModuleImport -> ImportList
modImp ModuleImport
m ImportList -> ImportList -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportList
NoImportList
    newImportLine :: ModuleImport -> ModuleName
newImportLine m :: ModuleImport
m = [ModuleName] -> ModuleName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["import ", case ModuleImport -> ModuleQualification
modQual ModuleImport
m of
                                            NotQualified -> ModuleImport -> ModuleName
modName ModuleImport
m
                                            ImportAs q :: ModuleName
q -> ModuleImport -> ModuleName
modName ModuleImport
m ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " as " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
q
                                            QualifiedAs Nothing -> "qualified " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleImport -> ModuleName
modName ModuleImport
m
                                            QualifiedAs (Just q :: ModuleName
q) -> "qualified " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleImport -> ModuleName
modName ModuleImport
m ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " as " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
q
                             ,case ModuleImport -> ImportList
modImp ModuleImport
m of
                                 NoImportList -> ""
                                 ImportList l :: [ModuleName]
l -> " (" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName -> [ModuleName] -> ModuleName
forall a. [a] -> [[a]] -> [a]
intercalate "," [ModuleName]
l ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ")"
                                 HidingList l :: [ModuleName]
l -> " hiding (" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName -> [ModuleName] -> ModuleName
forall a. [a] -> [[a]] -> [a]
intercalate "," [ModuleName]
l ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ")"
                             ]

-- | 'cleanPhantomModules' works like 'reset', but skips the
--   loading of the support module that installs '_show'. Its purpose
--   is to clean up all temporary files generated for phantom modules.
cleanPhantomModules :: MonadInterpreter m => m ()
cleanPhantomModules :: m ()
cleanPhantomModules =
    do -- Remove all modules from context
       RunGhc2 m [Module] [ImportDecl GhcPs] ()
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Module] -> [ImportDecl GhcPs] -> GhcT n ()
forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [] []
       --
       -- Unload all previously loaded modules
       RunGhc1 m [Target] ()
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Target] -> GhcT n ()
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets []
       SuccessFlag
_ <- RunGhc1 m LoadHowMuch SuccessFlag
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
LoadHowMuch -> GhcT n SuccessFlag
forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
GHC.LoadAllTargets
       --
       -- At this point, GHCi would call rts_revertCAFs and
       -- reset the buffering of stdin, stdout and stderr.
       -- Should we do any of these?
       --
       -- liftIO $ rts_revertCAFs
       --
       -- We now remove every phantom module and forget about qual imports
       [PhantomModule]
old_active <- (InterpreterState -> [PhantomModule]) -> m [PhantomModule]
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
activePhantoms
       [PhantomModule]
old_zombie <- (InterpreterState -> [PhantomModule]) -> m [PhantomModule]
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> [PhantomModule]
zombiePhantoms
       (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{activePhantoms :: [PhantomModule]
activePhantoms      = [],
                        zombiePhantoms :: [PhantomModule]
zombiePhantoms      = [],
                        importQualHackMod :: Maybe PhantomModule
importQualHackMod = Maybe PhantomModule
forall a. Maybe a
Nothing,
                        qualImports :: [ModuleImport]
qualImports         = []})
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (PhantomModule -> IO ()) -> [PhantomModule] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ModuleName -> IO ()
removeFile (ModuleName -> IO ())
-> (PhantomModule -> ModuleName) -> PhantomModule -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhantomModule -> ModuleName
pmFile) ([PhantomModule]
old_active [PhantomModule] -> [PhantomModule] -> [PhantomModule]
forall a. [a] -> [a] -> [a]
++ [PhantomModule]
old_zombie)
#if defined(NEED_PHANTOM_DIRECTORY)
       Maybe ModuleName
old_phantomdir <- (InterpreterState -> Maybe ModuleName) -> m (Maybe ModuleName)
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> Maybe ModuleName
phantomDirectory
       (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\s :: InterpreterState
s -> InterpreterState
s{phantomDirectory :: Maybe ModuleName
phantomDirectory    = Maybe ModuleName
forall a. Maybe a
Nothing})
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do IO () -> (ModuleName -> IO ()) -> Maybe ModuleName -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ModuleName -> IO ()
removeDirectory Maybe ModuleName
old_phantomdir
#endif

-- | All imported modules are cleared from the context, and
--   loaded modules are unloaded. It is similar to a @:load@ in
--   GHCi, but observe that not even the Prelude will be in
--   context after a reset.
reset :: MonadInterpreter m => m ()
reset :: m ()
reset = do -- clean up context
           m ()
forall (m :: * -> *). MonadInterpreter m => m ()
cleanPhantomModules
           --
           -- Now, install a support module
           m ()
forall (m :: * -> *). MonadInterpreter m => m ()
installSupportModule

-- Load a phantom module with all the symbols from the prelude we need
installSupportModule :: MonadInterpreter m => m ()
installSupportModule :: m ()
installSupportModule = do PhantomModule
mod <- (ModuleName -> ModuleName) -> m PhantomModule
forall (m :: * -> *).
MonadInterpreter m =>
(ModuleName -> ModuleName) -> m PhantomModule
addPhantomModule ModuleName -> ModuleName
support_module
                          (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(InterpreterState -> InterpreterState) -> m ()
onState (\st :: InterpreterState
st -> InterpreterState
st{hintSupportModule :: PhantomModule
hintSupportModule = PhantomModule
mod})
                          Module
mod' <- ModuleName -> m Module
forall (m :: * -> *). MonadInterpreter m => ModuleName -> m Module
findModule (PhantomModule -> ModuleName
pmName PhantomModule
mod)
                          RunGhc2 m [Module] [ImportDecl GhcPs] ()
forall (m :: * -> *) a b c. MonadInterpreter m => RunGhc2 m a b c
runGhc2 forall (n :: * -> *).
(MonadIO n, MonadMask n) =>
[Module] -> [ImportDecl GhcPs] -> GhcT n ()
forall (m :: * -> *).
GhcMonad m =>
[Module] -> [ImportDecl GhcPs] -> m ()
setContext [Module
mod'] []
    --
    where support_module :: ModuleName -> ModuleName
support_module m :: ModuleName
m = [ModuleName] -> ModuleName
unlines [
                               "module " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
m ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ "( ",
                               "    " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_String ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ",",
                               "    " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_show   ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ")",
                               "where",
                               "",
                               "import qualified Prelude as " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_P ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " (String, Show(show))",
                               "",
                               "type " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_String ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " = " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_P ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ".String",
                               "",
                               ModuleName
_show ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " :: " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_P ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ".Show a => a -> " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_P ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ".String",
                               ModuleName
_show ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ " = " ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
_P ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ".show"
                             ]
            where _String :: ModuleName
_String = ModuleName -> ModuleName
altStringName ModuleName
m
                  _show :: ModuleName
_show   = ModuleName -> ModuleName
altShowName ModuleName
m
                  _P :: ModuleName
_P      = ModuleName -> ModuleName
altPreludeName ModuleName
m

-- Call it when the support module is an active phantom module but has been
-- unloaded as a side effect by GHC (e.g. by calling GHC.loadTargets)
reinstallSupportModule :: MonadInterpreter m => m ()
reinstallSupportModule :: m ()
reinstallSupportModule = do PhantomModule
pm <- (InterpreterState -> PhantomModule) -> m PhantomModule
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState InterpreterState -> PhantomModule
hintSupportModule
                            PhantomModule -> m ()
forall (m :: * -> *). MonadInterpreter m => PhantomModule -> m ()
removePhantomModule PhantomModule
pm
                            m ()
forall (m :: * -> *). MonadInterpreter m => m ()
installSupportModule

altStringName :: ModuleName -> String
altStringName :: ModuleName -> ModuleName
altStringName mod_name :: ModuleName
mod_name = "String_" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name

altShowName :: ModuleName -> String
altShowName :: ModuleName -> ModuleName
altShowName mod_name :: ModuleName
mod_name = "show_" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name

altPreludeName :: ModuleName -> String
altPreludeName :: ModuleName -> ModuleName
altPreludeName mod_name :: ModuleName
mod_name = "Prelude_" ModuleName -> ModuleName -> ModuleName
forall a. [a] -> [a] -> [a]
++ ModuleName
mod_name

supportString :: MonadInterpreter m => m String
supportString :: m ModuleName
supportString = do ModuleName
mod_name <- (InterpreterState -> ModuleName) -> m ModuleName
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState (PhantomModule -> ModuleName
pmName (PhantomModule -> ModuleName)
-> (InterpreterState -> PhantomModule)
-> InterpreterState
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterState -> PhantomModule
hintSupportModule)
                   ModuleName -> m ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName -> m ModuleName) -> ModuleName -> m ModuleName
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> ModuleName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ModuleName
mod_name, ".", ModuleName -> ModuleName
altStringName ModuleName
mod_name]

supportShow :: MonadInterpreter m => m String
supportShow :: m ModuleName
supportShow = do ModuleName
mod_name <- (InterpreterState -> ModuleName) -> m ModuleName
forall (m :: * -> *) a.
MonadInterpreter m =>
(InterpreterState -> a) -> m a
fromState (PhantomModule -> ModuleName
pmName (PhantomModule -> ModuleName)
-> (InterpreterState -> PhantomModule)
-> InterpreterState
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterState -> PhantomModule
hintSupportModule)
                 ModuleName -> m ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName -> m ModuleName) -> ModuleName -> m ModuleName
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> ModuleName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ModuleName
mod_name, ".", ModuleName -> ModuleName
altShowName ModuleName
mod_name]

-- SHOULD WE CALL THIS WHEN MODULES ARE LOADED / UNLOADED?
-- foreign import ccall "revertCAFs" rts_revertCAFs :: IO ()