hint 0.3.2.3 → 0.3.3.0

raw patch · 11 files changed

+157/−19 lines, 11 filesdep +unixPVP ok

version bump matches the API change (PVP)

Dependencies added: unix

API changes (from Hackage documentation)

Files

• AUTHORS +1/−0
• Changes +4/−0
• hint.cabal +6/−1
• src/Hint/Configuration.hs +6/−3
• src/Hint/Context.hs +1/−1
• src/Hint/InterpreterT.hs +63/−10
• src/Hint/Sandbox.hs +0/−1
• src/Hint/SignalHandlers.hs +40/−0
• src/Language/Haskell/Interpreter.hs +1/−1
• src/Language/Haskell/Interpreter/Unsafe.hs +18/−1
• unit-tests/run-unit-tests.hs +17/−1

@@ -7,3 +7,4 @@ Austin Seipp Fernando Benavides Pasqualino Titto Assini+Carl Howells

@@ -1,3 +1,7 @@+- ver 0.3.3.0+ * add unsafeRunInterpreterWithArgs+ * check that only one instance of the interpreter is run at any time+ - ver 0.3.2.3  * Can be built against MonadCatchIO-mtl-0.3.x.x 

@@ -1,5 +1,5 @@ name:                hint-version:             0.3.2.3+version:             0.3.3.0 description:         This library defines an @Interpreter@ monad. It allows to load Haskell         modules, browse them, type-check and evaluate strings with Haskell@@ -55,6 +55,10 @@       build-depends:    utf8-string < 0.3   } +  if !os(windows) {+      build-depends:    unix >= 2.2.0.0 && < 2.5+  }+   exposed-modules:    Language.Haskell.Interpreter                       Language.Haskell.Interpreter.Extension                       Language.Haskell.Interpreter.Unsafe@@ -73,6 +77,7 @@                       Hint.Reflection                       Hint.Typecheck                       Hint.Sandbox+                      Hint.SignalHandlers                       Hint.Util    if impl(ghc >= 6.11) {

@@ -33,7 +33,7 @@        when (not . null $ not_parsed) $             throwError $ UnknownError (concat ["flag: '", unwords opts,                                                "' not recognized"])-       runGhc1 GHC.setSessionDynFlags new_flags+       _ <- runGhc1 GHC.setSessionDynFlags new_flags        return ()  setGhcOption :: MonadInterpreter m => String -> m ()@@ -102,8 +102,9 @@  -- | List of extensions turned on when the @-fglasgow-exts@ flag is used glasgowExtensions :: [Extension]-glasgowExtensions = intersect availableExtensions exts610 -- works also for 608-    where exts610 = asExtensionList ["ForeignFunctionInterface",+glasgowExtensions = intersect availableExtensions exts612 -- works also for 608 and 610+    where exts612 = asExtensionList ["PrintExplicitForalls",+                                     "ForeignFunctionInterface",                                      "UnliftedFFITypes",                                      "GADTs",                                      "ImplicitParams",@@ -124,10 +125,12 @@                                      "PostfixOperators",                                      "PatternGuards",                                      "LiberalTypeSynonyms",+                                     "ExplicitForAll",                                      "RankNTypes",                                      "ImpredicativeTypes",                                      "TypeOperators",                                      "RecursiveDo",+                                     "DoRec",                                      "ParallelListComp",                                      "EmptyDataDecls",                                      "KindSignatures",

@@ -264,7 +264,7 @@        --        -- Unload all previously loaded modules        runGhc1 GHC.setTargets []-       runGhc1 GHC.load GHC.LoadAllTargets+       _ <- runGhc1 GHC.load GHC.LoadAllTargets        --        -- At this point, GHCi would call rts_revertCAFs and        -- reset the buffering of stdin, stdout and stderr.

@@ -1,5 +1,6 @@ module Hint.InterpreterT (-    InterpreterT, Interpreter, runInterpreter,+    InterpreterT, Interpreter, runInterpreter, runInterpreterWithArgs,+    MultipleInstancesNotAllowed(..) )  where@@ -15,7 +16,12 @@ import Control.Monad.Error import Control.Monad.CatchIO +import Data.Typeable ( Typeable )+import Control.Concurrent.MVar+import System.IO.Unsafe ( unsafePerformIO )+ import Data.IORef+import Data.List #if __GLASGOW_HASKELL__ < 610 import Data.Dynamic #endif@@ -90,27 +96,52 @@  -- ================= Executing the interpreter ================== -initialize :: (MonadCatchIO m, Functor m) => InterpreterT m ()-initialize =+initialize :: (MonadCatchIO m, Functor m)+              => [String]+              -> InterpreterT m ()+initialize args =     do log_handler <- fromSession ghcErrLogger-       --        -- Set a custom log handler, to intercept error messages :S+       dflags <- runGhc GHC.getSessionDynFlags++       dflags' <- do+           let df = Compat.configureDynFlags dflags++           (df', extra) <- runGhc2 Compat.parseDynamicFlags df args+           when (not . null $ extra) $+               throwError $ UnknownError (concat [ "flags: '"+                                                 , intercalate " " extra+                                                 , "' not recognized"])+           return df'+        -- Observe that, setSessionDynFlags loads info on packages        -- available; calling this function once is mandatory!-       dflags <- runGhc GHC.getSessionDynFlags-       let dflags' = Compat.configureDynFlags dflags-       runGhc1 GHC.setSessionDynFlags dflags'{GHC.log_action = log_handler}-       --+       _ <- runGhc1 GHC.setSessionDynFlags dflags'{GHC.log_action = log_handler}+        reset  -- | Executes the interpreter. Returns @Left InterpreterError@ in case of error. --+-- NB. The underlying ghc will overwrite certain signal handlers+-- (SIGINT, SIGHUP, SIGTERM, SIGQUIT on Posix systems, Ctrl-C handler on Windows).+-- In future versions of hint, this might be controlled by the user. runInterpreter :: (MonadCatchIO m, Functor m)                => InterpreterT m a                -> m (Either InterpreterError a)-runInterpreter action =+runInterpreter = runInterpreterWithArgs []++-- | Executes the interpreter, setting args passed in as though they+-- were command-line args. Returns @Left InterpreterError@ in case of+-- error.+runInterpreterWithArgs :: (MonadCatchIO m, Functor m)+                          => [String]+                          -> InterpreterT m a+                          -> m (Either InterpreterError a)+runInterpreterWithArgs args action =+  ifInterpreterNotRunning $     do s <- newInterpreterSession `catch` rethrowGhcException-       execute s (initialize >> action)+       -- SH.protectHandlers $ execute s (initialize args >> action)+       execute s (initialize args >> action)     where rethrowGhcException   = throw . GhcException . showGhcEx #if __GLASGOW_HASKELL__ < 610           newInterpreterSession =  do s <- liftIO $@@ -120,6 +151,28 @@           -- GHC >= 610           newInterpreterSession = newSessionData () #endif++{-# NOINLINE uniqueToken #-}+uniqueToken :: MVar ()+uniqueToken = unsafePerformIO $ newMVar ()++ifInterpreterNotRunning :: MonadCatchIO m => m a -> m a+ifInterpreterNotRunning action =+    do maybe_token <- liftIO $ tryTakeMVar uniqueToken+       case maybe_token of+           Nothing -> throw MultipleInstancesNotAllowed+           Just x  -> action `finally` (liftIO $ putMVar uniqueToken x)++-- | The installed version of ghc is not thread-safe. This exception+--   is thrown whenever you try to execute @runInterpreter@ while another+--   instance is already running.+data MultipleInstancesNotAllowed = MultipleInstancesNotAllowed deriving Typeable++instance Exception MultipleInstancesNotAllowed++instance Show MultipleInstancesNotAllowed where+    show _ = "This version of GHC is not thread-safe," +++             "can't safely run two instances of the interpreter simultaneously"  initialState :: InterpreterState initialState = St {active_phantoms      = [],

@@ -7,7 +7,6 @@  import {-# SOURCE #-} Hint.Typecheck ( typeChecks_unsandboxed ) -import Data.List import Control.Monad.Error  sandboxed :: MonadInterpreter m => (Expr -> m a) -> (Expr -> m a)

@@ -0,0 +1,40 @@+module Hint.SignalHandlers (+    protectHandlers+)+where++import Control.Monad.CatchIO+import Control.Monad.Trans++#ifdef mingw32_HOST_OS+import GHC.ConsoleHandler as C++saveHandlers :: MonadCatchIO m => m C.Handler+saveHandlers = liftIO $ C.installHandler Ignore++restoreHandlers :: MonadCatchIO m => C.Handler -> m C.Handler+restoreHandlers = liftIO . C.installHandler++#else+import qualified System.Posix.Signals as S++helper :: MonadCatchIO m => S.Handler -> S.Signal -> m S.Handler+helper handler signal = liftIO $ S.installHandler signal handler Nothing++signals :: [S.Signal]+signals = [ S.sigQUIT+          , S.sigINT+          , S.sigHUP+          , S.sigTERM+          ]++saveHandlers :: MonadCatchIO m => m [S.Handler]+saveHandlers = liftIO $ mapM (helper S.Ignore) signals++restoreHandlers :: MonadCatchIO m => [S.Handler] -> m [S.Handler]+restoreHandlers h  = liftIO . sequence $ zipWith helper h signals++#endif++protectHandlers :: MonadCatchIO m => m a -> m a+protectHandlers a = bracket saveHandlers restoreHandlers $ const a

@@ -44,7 +44,7 @@     -- ** Evaluation      interpret, as, infer, eval,     -- * Error handling-     InterpreterError(..), GhcError(..),+     InterpreterError(..), GhcError(..), MultipleInstancesNotAllowed(..),     -- * Miscellaneous      ghcVersion,parens,      module Control.Monad.Trans)

@@ -1,9 +1,14 @@-module Language.Haskell.Interpreter.Unsafe ( unsafeSetGhcOption )+module Language.Haskell.Interpreter.Unsafe (+    unsafeSetGhcOption, unsafeRunInterpreterWithArgs+)  where +import Control.Monad.CatchIO+ import Hint.Base import Hint.Configuration+import Hint.InterpreterT  -- | Set a GHC option for the current session, --   eg. @unsafeSetGhcOption \"-XNoMonomorphismRestriction\"@.@@ -11,3 +16,15 @@ --   Warning: Some options may interact badly with the Interpreter. unsafeSetGhcOption :: MonadInterpreter m => String -> m () unsafeSetGhcOption = setGhcOption++-- | Executes the interpreter, setting the 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.+unsafeRunInterpreterWithArgs :: (MonadCatchIO m, Functor m)+                                => [String]+                                -> InterpreterT m a+                                -> m (Either InterpreterError a)+unsafeRunInterpreterWithArgs = runInterpreterWithArgs

@@ -8,6 +8,9 @@ import Control.Monad       ( liftM, when ) import Control.Monad.Error ( Error, MonadError(catchError) ) +import Control.Concurrent ( forkIO )+import Control.Concurrent.MVar+ import System.IO import System.FilePath import System.Directory@@ -195,6 +198,18 @@                       return $! s  +test_only_one_instance :: TestCase+test_only_one_instance = TestCase "only_one_instance" [] $ do+    liftIO $ do+        r <- newEmptyMVar+        let concurrent = runInterpreter (liftIO $ putMVar r False)+                          `catch` \MultipleInstancesNotAllowed ->+                                    do liftIO $ putMVar r True+                                       return $ Right ()+        forkIO $ concurrent >> return ()+        readMVar r @?  "concurrent instance did not fail"++ tests :: [TestCase] tests = [test_reload_modified,          test_lang_exts,@@ -208,7 +223,8 @@          test_priv_syms_in_scope,          test_search_path,          test_search_path_dot,-         test_catch]+         test_catch,+         test_only_one_instance]  main :: IO () main = do -- run the tests...