DynLoad.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Blog.DynLoad (
    loadSourceGhc,
    execFnGhc
    ) where

{-
Source:
http://codeutopia.net/blog/2011/08/20/adventures-in-haskell-dynamic-loading-and-compiling-of-modules/
https://gist.github.com/jhartikainen/1158986
-}

import Control.Exception (throw)
import GHC hiding (loadModule)
import HscTypes (SourceError, srcErrorMessages)
import DynFlags
import Unsafe.Coerce
import Bag (bagToList)

execFnGhc :: String -> String -> Ghc a
execFnGhc modname fn = do
  let modname' = mkModuleName modname
  setContext [IIDecl $ simpleImportDecl modname']
  value <- compileExpr (modname ++ "." ++ fn)
  
  let value' = (unsafeCoerce value) :: a
  return value'

loadSourceGhc :: String -> Ghc (Maybe String)
loadSourceGhc path = let
        throwingLogger (Just e) = throw e
        throwingLogger _ = return ()
    in do
        dflags <- getSessionDynFlags
        setSessionDynFlags (dflags{
            ghcLink = LinkInMemory,
            hscTarget = HscInterpreted,
            packageFlags = [ExposePackage "ghc"]
            })
        target <- guessTarget path Nothing
        addTarget target
        r <- load LoadAllTargets
        case r of
            Failed    -> return $ Just "Generic module load error"
            Succeeded -> return Nothing

        `gcatch` \(e :: SourceError) -> let
                errors e = concat $ map show (bagToList $ srcErrorMessages e)
            in
                return $ Just (errors e)