From 44d04ec43f60a96f2f32444b60969a2da8325414 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Piotr=20M=C5=82odawski?= <remdezx@gmail.com>
Date: Wed, 27 Aug 2014 10:07:26 +0200
Subject: [PATCH] Added runInterpreterWithTopDirAndArgs which allows to select
 a custom GHC top dir

---
 src/Hint/InterpreterT.hs                   | 35 +++++++++++++++-------
 src/Language/Haskell/Interpreter/Unsafe.hs | 17 ++++++++++-
 2 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/src/Hint/InterpreterT.hs b/src/Hint/InterpreterT.hs
index 6d57022..709057a 100644
--- a/src/Hint/InterpreterT.hs
+++ b/src/Hint/InterpreterT.hs
@@ -1,5 +1,6 @@
 module Hint.InterpreterT (
-    InterpreterT, Interpreter, runInterpreter, runInterpreterWithArgs,
+    InterpreterT, Interpreter, runInterpreter, runInterpreterWithArgs, 
+    runInterpreterWithTopDirAndArgs,
     MultipleInstancesNotAllowed(..)
 )
 
@@ -42,10 +43,11 @@ newtype InterpreterT m a = InterpreterT{
     deriving (Functor, Monad, MonadIO, MonadThrow,MonadCatch,MonadMask)
 
 execute :: (MonadIO m, MonadMask m, Functor m)
-        => InterpreterSession
+        => Maybe FilePath 
+        -> InterpreterSession
         -> InterpreterT m a
         -> m (Either InterpreterError a)
-execute s = runErrorT . flip runReaderT s . unInterpreterT
+execute _ s = runErrorT . flip runReaderT s . unInterpreterT
 
 instance MonadTrans InterpreterT where
     lift = InterpreterT . lift . lift
@@ -66,13 +68,14 @@ newtype InterpreterT m a = InterpreterT{
     deriving (Functor, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask)
 
 execute :: (MonadIO m, MonadMask m, Functor m)
-        => InterpreterSession
+        => Maybe FilePath 
+        -> InterpreterSession
         -> InterpreterT m a
         -> m (Either InterpreterError a)
-execute s = try
-          . GHC.runGhcT (Just GHC.Paths.libdir)
-          . flip runReaderT s
-          . unInterpreterT
+execute mb_top_dir s = try
+                     . GHC.runGhcT mb_top_dir
+                     . flip runReaderT s
+                     . unInterpreterT
 
 
 instance MonadTrans InterpreterT where
@@ -158,15 +161,25 @@ runInterpreterWithArgs :: (MonadIO m, MonadMask m, Functor m)
                           => [String]
                           -> InterpreterT m a
                           -> m (Either InterpreterError a)
-runInterpreterWithArgs args action =
+runInterpreterWithArgs = runInterpreterWithTopDirAndArgs (Just GHC.Paths.libdir)
+
+-- | Executes the interpreter, setting GHC top dir and args passed in as 
+-- though they were command-line args. Returns @Left InterpreterError@ 
+-- in case of error.
+runInterpreterWithTopDirAndArgs :: (MonadIO m, MonadMask m, Functor m)
+                                => Maybe FilePath
+                                -> [String]
+                                -> InterpreterT m a
+                                -> m (Either InterpreterError a)
+runInterpreterWithTopDirAndArgs mb_top_dir args action =
   ifInterpreterNotRunning $
     do s <- newInterpreterSession `MC.catch` rethrowGhcException
        -- SH.protectHandlers $ execute s (initialize args >> action)
-       execute s (initialize args >> action `finally` cleanSession)
+       execute mb_top_dir s (initialize args >> action `finally` cleanSession)
     where rethrowGhcException   = throwM . GhcException . showGhcEx
 #if __GLASGOW_HASKELL__ < 610
           newInterpreterSession =  do s <- liftIO $
-                                             Compat.newSession GHC.Paths.libdir
+                                             Compat.newSession $ fromJust mb_top_dir
                                       newSessionData s
           cleanSession = cleanPhantomModules -- clean ghc session, too?
 #else
diff --git a/src/Language/Haskell/Interpreter/Unsafe.hs b/src/Language/Haskell/Interpreter/Unsafe.hs
index 0731928..e301f8e 100644
--- a/src/Language/Haskell/Interpreter/Unsafe.hs
+++ b/src/Language/Haskell/Interpreter/Unsafe.hs
@@ -1,5 +1,6 @@
 module Language.Haskell.Interpreter.Unsafe (
-    unsafeSetGhcOption, unsafeRunInterpreterWithArgs
+    unsafeSetGhcOption, unsafeRunInterpreterWithArgs,
+    unsafeRunInterpreterWithTopDirAndArgs
 )
 
 where
@@ -29,3 +30,17 @@ unsafeRunInterpreterWithArgs :: (MonadMask m, MonadIO m, Functor m)
                                 -> InterpreterT m a
                                 -> m (Either InterpreterError a)
 unsafeRunInterpreterWithArgs = runInterpreterWithArgs
+
+
+-- | Executes the interpreter, setting the GHC top dir and args as though 
+--   they were command-line args. In particular, this means args that 
+--   have no effect with :set in ghci might function properly from this
+--   context.
+--
+--   Warning: Some options may interact badly with the Interpreter.
+unsafeRunInterpreterWithTopDirAndArgs :: (MonadMask m, MonadIO m, Functor m)
+                                => Maybe FilePath
+                                -> [String]
+                                -> InterpreterT m a
+                                -> m (Either InterpreterError a)
+unsafeRunInterpreterWithTopDirAndArgs = runInterpreterWithTopDirAndArgs
\ No newline at end of file