How to dynamically compile and import a module using GHC API - LTS Haskell 20.20 (ghc-9.2.7)?

Background

I would like to implement a program in Haskell that can generate Haskell module (hs-File) dynamically and then compile, and import it into the same application that generated the code.

Therefore, I tried to understand some example code snippets in SO and documentation. But it doesn't work nor compiles.

After some modifications of one of the given examples, I created the following souce code, Main.hs:

import qualified GhcApiWrap as Ghw

main :: IO ()
main = Ghw.msLoadModuleAndExecute "../dyn/" "DynExample.hs" "nFromChar" 'A'

GhcApiWrap.hs:

module GhcApiWrap
    (
        msLoadModuleAndExecute
    ) where

import GHC
--import GHC.Paths (libdir)  

msLoadModuleAndExecute :: String -> String -> String -> Char -> IO ()
msLoadModuleAndExecute _ _ _ _ = do
    value' <- runGhc (Just "./src/") $ do
            dflags <- getSessionDynFlags
            setSessionDynFlags $ dflags { 
                ghcLink   = LinkInMemory, 
                ghcMode = CompManager,
                objectDir   = Just "../dyn/",
                hiDir   = Just "../dyn/"
                }
            target <- guessTarget ("DynExample.hs") Nothing
            setTargets [target]
            ret <- load LoadAllTargets
            case ret of
                Succeeded -> do
                    importDecl_RdrName <- parseImportDecl $ "import DynExample"
                    setContext [IIDecl importDecl_RdrName]

                    value <- dynCompileExpr ("DynExample.nFromChar")

                    return value
                _       -> 
                    return undefined
    print $ value'

DynExample.hs:

module DynExample
    (
        nFromChar
    ) where

nFromChar :: Char -> Int
nFromChar _ = 33

...which compiles but doesn't work.

Its ouput is:

ExprmntGhcApi-exe: Missing file: src/settings

As you can see, I commented out import GHC.Paths (libdir) because it doesn't exist anymore. Therefore, as a humble guess I used (Just "./src/") instead of (Just libdir).

I tried several versions that are "flying around", but none of them work with GHC 9.2.7.

Question

Is it, and how is it possible to use DynExample.nFromChar dynamically this way using an up-to-date Haskell Stack environment, and having the following type of the function?

msLoadModuleAndExecute :: String -> String -> String -> Char -> ... Int

Environment

At the moment, I am using Stack with:

resolver:
  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/20.yaml

...which translates to usage of GHC 9.2.7.

So, issue with import GHC.Paths (libdir) solved by adding a dependence to the ghc-paths package.

Next issue was with provide correct argument to the guessTarget. From the doc:

> Attempts to guess what Target a string refers to. This function implements the --make/GHCi command-line syntax for filenames.

So, need provide path to the module not just the name.

And last problem is that dynCompileExpr returns Dynamic object which should be casted to type of your function Char -> Int and then calculate.

Combine all together we can get:

module GhcApiWrap
    (
        msLoadModuleAndExecute
    ) where

import Control.Exception.Safe
import Data.Dynamic
import GHC
import GHC.Paths (libdir)
import System.FilePath

msLoadModuleAndExecute :: FilePath -> FilePath -> String -> Char -> IO Int
msLoadModuleAndExecute buildDir modulePath funcName arg = do
    dynFunc <- runGhc (Just libdir) $ do
        dflags <- getSessionDynFlags
        setSessionDynFlags $ dflags { ghcLink   = LinkInMemory
                                    , ghcMode   = CompManager
                                    , objectDir = Just buildDir
                                    , hiDir     = Just buildDir
                                    }
        target <- guessTarget modulePath Nothing
        setTargets [target]
        loadStatus <- load LoadAllTargets
        case loadStatus of
            Succeeded -> do
                let moduleName = dropExtension $ takeFileName modulePath
                importDecl_RdrName <- parseImportDecl $ "import " ++ moduleName
                setContext [IIDecl importDecl_RdrName]
                dynCompileExpr $ moduleName ++ "." ++ funcName
            Failed    -> throwString $ "could not load the module: " ++ modulePath
    case fromDynamic dynFunc of
        Just func -> pure $ func arg
        Nothing   -> throwString $ funcName ++ " has type '" ++ show dynFunc ++ " but expected type `Char -> Int'"

which can be run with:

import qualified GhcApiWrap as Ghw

main :: IO ()
main = print =<< Ghw.msLoadModuleAndExecute "../dyn/" "DynExample.hs" "nFromChar" 'A'

But I think will be better simplify this function on just compileAndLoad that make it more generic.

{-# LANGUAGE ScopedTypeVariables #-}

module GhcApiWrap
    (
        msCompileAndLoad
    ) where

import Control.Exception.Safe
import Data.Dynamic
import Data.Proxy
import Data.Typeable
import GHC
import GHC.Paths (libdir)
import System.FilePath

msCompileAndLoad :: forall a. Typeable a => FilePath -> FilePath -> String -> IO a
msCompileAndLoad buildDir modulePath symbolName = do
    dynSymbol <- runGhc (Just libdir) $ do
        dflags <- getSessionDynFlags
        setSessionDynFlags $ dflags { ghcLink   = LinkInMemory
                                    , ghcMode   = CompManager
                                    , objectDir = Just buildDir
                                    , hiDir     = Just buildDir
                                    }
        target <- guessTarget modulePath Nothing
        setTargets [target]
        loadStatus <- load LoadAllTargets
        case loadStatus of
            Succeeded -> do
                let moduleName = dropExtension $ takeFileName modulePath
                importDecl_RdrName <- parseImportDecl $ "import " ++ moduleName
                setContext [IIDecl importDecl_RdrName]
                dynCompileExpr $ moduleName ++ "." ++ symbolName
            Failed    -> throwString $ "could not load the module: " ++ modulePath
    case fromDynamic dynSymbol of
        Just x  -> pure x
        Nothing -> throwString $ symbolName ++ " has type '" ++ show dynSymbol
                 ++ "' but expected type '" ++ show symbolType ++ "'"
  where
    symbolType = typeRep (Proxy :: Proxy a)

Then we can use it:

import qualified GhcApiWrap as Ghw

main :: IO ()
main = do
    nFromChar <- Ghw.msCompileAndLoad "../dyn/" "DynExample.hs" "nFromChar"
    print $ (nFromChar :: Char -> Int) 'A'

The answer from freestyle and K. A. Buhr works.

However, I created an alternative version, which should have the following characteristics:

• not throwing exceptions but forwarding error messages via Either
• catching all exceptions to forward its error messages via Either
• not modifying the dflags if not needed
• avoiding the do notation
• avoiding case constructions
• using qualified imports, where reasonably possible
• describing all necessities including stack setup details
• usage of the module name implying extension “hs” for the file
• hlint free

I tested the code regarding

• function
• unavailability of the module file
  (e.g. "Error: Exception: can't find file: ./dyn/DynExample.hs")
• compiler error regarding the module file
  (e.g. "Error: Could not load the module "DynExample"!")
• error regarding type check vs. imported symbol
  (e.g. "Error: Symbol nFromChar has type "<<Char -> Int>>" but expected type "Char -> Integer"")

GhcApiWrap

{-# LANGUAGE ScopedTypeVariables #-}
module GhcApiWrap
(
compileAndLoad
) where
import qualified Control.Exception.Safe as Exc
import qualified Data.Dynamic as Dyn
import qualified Data.Proxy as Px
import qualified Data.Typeable as T
import qualified GHC as Ghc
import qualified GHC.Paths as Pth
import Data.Functor ((<&>))
compileAndLoad :: forall a. T.Typeable a => String -> String -> String -> IO (Either String a)
compileAndLoad dir mdl sym = runGhcCatched >>= ethSym
where
runGhcCatched = Ghc.runGhc (Just Pth.libdir) (loadModule dir mdl sym)
`Exc.catchAny`
(\ex -> return (Left ("Exception: " ++ show ex)))
ethSym (Right dynSym) = return (ethSym' (Dyn.fromDynamic dynSym) (sErrFromDynSym dynSym))
ethSym (Left sErr) = return (Left sErr)
sErrFromDynSym dynSym = "Symbol " ++ sym ++ " has type \"" ++ show dynSym ++ 
"\" but expected type \"" ++ show symbolType ++ "\""
ethSym' (Just dynSym) _ = Right dynSym
ethSym' Nothing sErr = Left sErr
symbolType = T.typeRep (Px.Proxy :: Px.Proxy a)
loadModule :: Ghc.GhcMonad m => String -> String -> String -> m (Either String Dyn.Dynamic)
loadModule dir mdl sym = 
Ghc.getSessionDynFlags >>= 
Ghc.setSessionDynFlags >> 
Ghc.guessTarget (dir ++ mdl ++ ".hs") Nothing >>= 
(\target -> Ghc.setTargets [target]) >> 
Ghc.load Ghc.LoadAllTargets >>= 
returnFromLoadStatus
where
returnFromLoadStatus Ghc.Succeeded = dynSym <&> Right
returnFromLoadStatus Ghc.Failed = return (Left ("Could not load the module \"" ++ mdl ++ "\"!"))
dynSym = Ghc.parseImportDecl ("import " ++ mdl) >>= 
(\importDecl -> Ghc.setContext [Ghc.IIDecl importDecl]) >> 
Ghc.dynCompileExpr (mdl ++ "." ++ sym)

Usage

{-# LANGUAGE LambdaCase #-}
import qualified GhcApiWrap as Ghw
main :: IO ()
main =  Ghw.compileAndLoad "./dyn/" "DynExample" "nFromChar" >>= 
(\case 
(Right nFromChar) -> putStrLn ("nFromChar 'A' := " ++ show ((nFromChar :: Char -> Integer) 'A'))
(Left sErrorMassage) -> putStrLn ("Error: " ++ sErrorMassage))

Dynamic file to read ("DynExample.hs")

NOTE: The file has to be located in diretcory dyn side by side to the directory src, in order to be compatible with the code above ("Usage").

module DynExample
(
nFromChar
) where
import qualified Data.Char as Chr
nFromChar :: Char -> Int
nFromChar = Chr.ord

Output

nFromChar 'A' := 65

package.yaml

...
description:...
dependencies:
- base >= 4.7 && < 5
- ghc
- ghc-paths
- safe-exceptions
ghc-options:
...

stack.yaml

...
resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/20.yaml
...