-
-
Save worldsayshi/8853909 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# 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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment