1

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.

Jörg Brüggmann
  • 603
  • 7
  • 19
  • Related, reiewd topics: - https://stackoverflow.com/questions/54133433 - https://stackoverflow.com/questions/12790341 - https://stackoverflow.com/questions/47680575 - https://stackoverflow.com/questions/12779143 - https://stackoverflow.com/questions/16806460 - https://stackoverflow.com/questions/9198140 - https://stackoverflow.com/questions/5521129 - https://stackoverflow.com/questions/41228537 – Jörg Brüggmann Aug 04 '23 at 15:31
  • "...which compiles but doesn't work." What it does output? – freestyle Aug 04 '23 at 15:47
  • @freestle: The output is "ExprmntGhcApi-exe: Missing file: src/settings". – Jörg Brüggmann Aug 04 '23 at 15:49
  • 1
    `dynCompileExpr` returns `Dynamic` object which should be casted to type of your function `Char -> Int` and then calculate. – freestyle Aug 04 '23 at 15:49
  • 1
    Looks like you provide invalid path to GHC location here `runGhc (Just "./src/")`. – freestyle Aug 04 '23 at 15:54
  • @freestle: That's right. That will be an additional problem. But, at the moment it even doesn't use the file `DynExample.hs`. The types doesn't matter for the given code, at the moment. The `value` seems to be of `class Show`, doesn't it? – Jörg Brüggmann Aug 04 '23 at 15:58
  • @freestle: I guessed that too. Hence, I looked for a folder or file named `settings` and could't find one. What is the API lookong for? – Jörg Brüggmann Aug 04 '23 at 16:00
  • "import GHC.Paths (libdir) doesn't exist anymore." Where it says? – freestyle Aug 04 '23 at 16:00
  • Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/254804/discussion-between-jorg-bruggmann-and-freestyle). – Jörg Brüggmann Aug 04 '23 at 16:01

2 Answers2

2

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'
K. A. Buhr
  • 45,621
  • 3
  • 45
  • 71
freestyle
  • 3,692
  • 11
  • 21
0

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

...
Jörg Brüggmann
  • 603
  • 7
  • 19