packages feed

hint 0.4.3 → 0.5.0

raw patch · 30 files changed

+505/−995 lines, 30 filesdep −ghc-mtldep −utf8-stringdep ~HUnitdep ~basedep ~ghcsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: ghc-mtl, utf8-string

Dependency ranges changed: HUnit, base, ghc

API changes (from Hackage documentation)

- Language.Haskell.Interpreter: NoImplicitPrelude :: Extension
- Language.Haskell.Interpreter: NoMonoPatBinds :: Extension
- Language.Haskell.Interpreter: NoMonomorphismRestriction :: Extension
- Language.Haskell.Interpreter: glasgowExtensions :: [Extension]
- Language.Haskell.Interpreter: setInstalledModsAreInScopeQualified :: MonadInterpreter m => Bool -> m ()
- Language.Haskell.Interpreter: setUseLanguageExtensions :: MonadInterpreter m => Bool -> m ()
- Language.Haskell.Interpreter.Extension: NoImplicitPrelude :: Extension
- Language.Haskell.Interpreter.Extension: NoMonoPatBinds :: Extension
- Language.Haskell.Interpreter.Extension: NoMonomorphismRestriction :: Extension
- Language.Haskell.Interpreter.Extension: knownExtensions :: [Extension]
+ Language.Haskell.Interpreter: AllowAmbiguousTypes :: Extension
+ Language.Haskell.Interpreter: AutoDeriveTypeable :: Extension
+ Language.Haskell.Interpreter: BinaryLiterals :: Extension
+ Language.Haskell.Interpreter: CApiFFI :: Extension
+ Language.Haskell.Interpreter: ConstraintKinds :: Extension
+ Language.Haskell.Interpreter: DataKinds :: Extension
+ Language.Haskell.Interpreter: DefaultSignatures :: Extension
+ Language.Haskell.Interpreter: DeriveAnyClass :: Extension
+ Language.Haskell.Interpreter: DeriveGeneric :: Extension
+ Language.Haskell.Interpreter: EmptyCase :: Extension
+ Language.Haskell.Interpreter: ExplicitNamespaces :: Extension
+ Language.Haskell.Interpreter: GADTSyntax :: Extension
+ Language.Haskell.Interpreter: ImplicitPrelude :: Extension
+ Language.Haskell.Interpreter: InstanceSigs :: Extension
+ Language.Haskell.Interpreter: InterruptibleFFI :: Extension
+ Language.Haskell.Interpreter: JavaScriptFFI :: Extension
+ Language.Haskell.Interpreter: LambdaCase :: Extension
+ Language.Haskell.Interpreter: MonadComprehensions :: Extension
+ Language.Haskell.Interpreter: MonoPatBinds :: Extension
+ Language.Haskell.Interpreter: MonomorphismRestriction :: Extension
+ Language.Haskell.Interpreter: MultiWayIf :: Extension
+ Language.Haskell.Interpreter: NamedWildCards :: Extension
+ Language.Haskell.Interpreter: NegativeLiterals :: Extension
+ Language.Haskell.Interpreter: NondecreasingIndentation :: Extension
+ Language.Haskell.Interpreter: NullaryTypeClasses :: Extension
+ Language.Haskell.Interpreter: NumDecimals :: Extension
+ Language.Haskell.Interpreter: OverloadedLists :: Extension
+ Language.Haskell.Interpreter: ParallelArrays :: Extension
+ Language.Haskell.Interpreter: PartialTypeSignatures :: Extension
+ Language.Haskell.Interpreter: PatternSynonyms :: Extension
+ Language.Haskell.Interpreter: PolyKinds :: Extension
+ Language.Haskell.Interpreter: RoleAnnotations :: Extension
+ Language.Haskell.Interpreter: Safe :: Extension
+ Language.Haskell.Interpreter: SafeImports :: Extension
+ Language.Haskell.Interpreter: TraditionalRecordSyntax :: Extension
+ Language.Haskell.Interpreter: Trustworthy :: Extension
+ Language.Haskell.Interpreter: Unsafe :: Extension
+ Language.Haskell.Interpreter.Extension: AllowAmbiguousTypes :: Extension
+ Language.Haskell.Interpreter.Extension: AutoDeriveTypeable :: Extension
+ Language.Haskell.Interpreter.Extension: BinaryLiterals :: Extension
+ Language.Haskell.Interpreter.Extension: CApiFFI :: Extension
+ Language.Haskell.Interpreter.Extension: ConstraintKinds :: Extension
+ Language.Haskell.Interpreter.Extension: DataKinds :: Extension
+ Language.Haskell.Interpreter.Extension: DefaultSignatures :: Extension
+ Language.Haskell.Interpreter.Extension: DeriveAnyClass :: Extension
+ Language.Haskell.Interpreter.Extension: DeriveGeneric :: Extension
+ Language.Haskell.Interpreter.Extension: EmptyCase :: Extension
+ Language.Haskell.Interpreter.Extension: ExplicitNamespaces :: Extension
+ Language.Haskell.Interpreter.Extension: GADTSyntax :: Extension
+ Language.Haskell.Interpreter.Extension: ImplicitPrelude :: Extension
+ Language.Haskell.Interpreter.Extension: InstanceSigs :: Extension
+ Language.Haskell.Interpreter.Extension: InterruptibleFFI :: Extension
+ Language.Haskell.Interpreter.Extension: JavaScriptFFI :: Extension
+ Language.Haskell.Interpreter.Extension: LambdaCase :: Extension
+ Language.Haskell.Interpreter.Extension: MonadComprehensions :: Extension
+ Language.Haskell.Interpreter.Extension: MonoPatBinds :: Extension
+ Language.Haskell.Interpreter.Extension: MonomorphismRestriction :: Extension
+ Language.Haskell.Interpreter.Extension: MultiWayIf :: Extension
+ Language.Haskell.Interpreter.Extension: NamedWildCards :: Extension
+ Language.Haskell.Interpreter.Extension: NegativeLiterals :: Extension
+ Language.Haskell.Interpreter.Extension: NondecreasingIndentation :: Extension
+ Language.Haskell.Interpreter.Extension: NullaryTypeClasses :: Extension
+ Language.Haskell.Interpreter.Extension: NumDecimals :: Extension
+ Language.Haskell.Interpreter.Extension: OverloadedLists :: Extension
+ Language.Haskell.Interpreter.Extension: ParallelArrays :: Extension
+ Language.Haskell.Interpreter.Extension: PartialTypeSignatures :: Extension
+ Language.Haskell.Interpreter.Extension: PatternSynonyms :: Extension
+ Language.Haskell.Interpreter.Extension: PolyKinds :: Extension
+ Language.Haskell.Interpreter.Extension: RoleAnnotations :: Extension
+ Language.Haskell.Interpreter.Extension: Safe :: Extension
+ Language.Haskell.Interpreter.Extension: SafeImports :: Extension
+ Language.Haskell.Interpreter.Extension: TraditionalRecordSyntax :: Extension
+ Language.Haskell.Interpreter.Extension: Trustworthy :: Extension
+ Language.Haskell.Interpreter.Extension: Unsafe :: Extension

Files

CHANGELOG.md view
@@ -1,149 +1,166 @@+### 0.5.0++* Drop support for GHC 7.4+* Remove deprecated functions and modules:+  - `glasgowExtensions`+  - `setUseLanguageExtensions`+  - `setInstalledModsAreInScopeQualified`+  - `Language.Haskell.Interpreter.GHC`+  - `Language.Haskell.Interpreter.GHC.Unsafe`+* Drop dependencies on `ghc-mtl` and `extensible-exceptions`+ ### 0.4.3 - * New maintainer and source code repo+* New maintainer and source code repo  ### 0.4.2.3 - * It builds against 7.4.2 (not 7.4.1), so update the constraints.+* It builds against 7.4.2 (not 7.4.1), so update the constraints.  ### 0.4.2.2 - * Builds with ghc 7.10- * Builds again with ghc 7.4- * Drops dependency on utf8-string+* Builds with GHC 7.10+* Builds again with GHC 7.4+* Drops dependency on `utf8-string`  ### 0.4.2.1 - * Better error reporting (thanks to Corentin Dupont)+* Better error reporting (thanks to Corentin Dupont)  ### 0.4.2.0 - * Based on exceptions-0.6+* Based on exceptions-0.6  ### 0.4.1.0 - * Based on exceptions-0.4+* Based on exceptions-0.4  ### 0.4.0.0 - * Compiles with ghc 7.8- * Fixed an issue where "P" was available as a qualified version of Prelude-   (thanks to Samuel Gélineau)- * Uses exceptions package instead of MonadCatchIO-mtl (API breakage expected)- * No longer depends on haskell-src- * Changelog should now appear in Hackage- * Integrated unit tests with cabal+* Compiles with GHC 7.8+* Fixed an issue where `P` was available as a qualified version of+  Prelude (thanks to Samuel Gélineau)+* Uses `exceptions` package instead of `MonadCatchIO-mtl` (API breakage+  expected)+* No longer depends on `haskell-src`+* Changelog should now appear in Hackage+* Integrated unit tests with cabal  ### 0.3.3.7 - * Fixed a race condition that would happen, for instance, when two process where run-   one next to the other, making them, on some platforms, to get the same random number seed-   (thanks to Mario Pastorelli and Samuel Gélineau)- * Small fix in documentation (thanks to Daniil Frumin)+* Fixed a race condition that would happen, for instance, when two+  process where run one next to the other, making them, on some+  platforms, to get the same random number seed (thanks to Mario+  Pastorelli and Samuel Gélineau)+* Small fix in documentation (thanks to Daniil Frumin)  ### 0.3.3.6 - * Works again on GHC 7.2.x (thanks to Björn Peemöller)+* Works again on GHC 7.2.x (thanks to Björn Peemöller)  ### 0.3.3.5 - * Works on GHC 7.4.6- * Cleans up files for phantom modules that were left behind (thanks to Beltram Felgenhauer)+* Works on GHC 7.4.6+* Cleans up files for phantom modules that were left behind (thanks to+  Beltram Felgenhauer)  ### 0.3.3.4 - * Works on GHC 7.4.1+* Works on GHC 7.4.1  ### 0.3.3.3 - * Works on GHC 7.2.1+* Works on GHC 7.2.1  ### 0.3.3.2 - * Supports GHC 7+* Supports GHC 7  ### 0.3.3.1 - * Instance declaration for Applicative (InterpreterT m) works with mtl-2-   (requires Applicative m, this shouldn't break anything...)+* Instance declaration for Applicative (InterpreterT m) works with mtl-2+  (requires Applicative m, this shouldn't break anything...)  ### 0.3.3.0 - * Add unsafeRunInterpreterWithArgs- * Check that only one instance of the interpreter is run at any time+* Add unsafeRunInterpreterWithArgs+* Check that only one instance of the interpreter is run at any time  ### 0.3.2.3 - * Can be built against MonadCatchIO-mtl-0.3.x.x+* Can be built against MonadCatchIO-mtl-0.3.x.x  ### 0.3.2.2 - * Fixed a bug that would make expressions using heavy use of the layout-   rule to fail to be interpreted (see parens)+* Fixed a bug that would make expressions using heavy use of the layout+  rule to fail to be interpreted (see parens)  ### 0.3.2.1 - * hint.cabal includes version bounds for package ghc-mtl. This is to-   avoid the accidental selection of the completely unrelated ghc-mtl-   internal to ghc and, apparently, installed in the hackage server+* hint.cabal includes version bounds for package ghc-mtl. This is to+  avoid the accidental selection of the completely unrelated ghc-mtl+  internal to GHC and, apparently, installed in the hackage server  ### 0.3.2.0 - * Exports functions parens and isInterpretedModule- * Experimental support for module annotations- * Uses extensible-exceptions in order to provide a uniform interface-   accross different ghc versions- * Provides an Applicative instance for IntepreterT- * Adds an option to configurate the searchPath+* Exports functions parens and isInterpretedModule+* Experimental support for module annotations+* Uses extensible-exceptions in order to provide a uniform interface+  accross different ghc versions+* Provides an Applicative instance for IntepreterT+* Adds an option to configurate the searchPath  ### 0.3.1.0 - * No longer uses Language.Haskell.Extension due to configuration problems with Cabal.-   Instead, it uses its own Language.Haskell.Interpreter.Extension module.+* No longer uses Language.Haskell.Extension due to configuration+  problems with Cabal. Instead, it uses its own+  Language.Haskell.Interpreter.Extension module.  ### 0.3.0.0 - * Updated API:-   + InterpreterT monad transformer (Interpreter = InterpreterT IO)-   + No more Sessions, use runInterpreter only once-   + New options handling functions-     - but observe that there is no setOptimizations equivalent;-       since GHC does no optimization on interpreted code, this was actually-       doing nothing- * Works with GHC 6.10 and 6.8 (untested with 6.6)+* Updated API:+  + InterpreterT monad transformer (Interpreter = InterpreterT IO)+  + No more Sessions, use runInterpreter only once+  + New options handling functions+    - but observe that there is no setOptimizations equivalent; since+      GHC does no optimization on interpreted code, this was actually+      doing nothing+* Works with GHC 6.10 and 6.8 (untested with 6.6)  ### 0.2.5 - * setImportsQ added (modules can be imported both qualified and unqualified)+* setImportsQ added (modules can be imported both qualified and+  unqualified)  ### 0.2.4.1 - * BUGFIX: No longer fails on expressions ending in a -- comment+* BUGFIX: No longer fails on expressions ending in a -- comment  ### 0.2.4 - * setInstalledModsAreInScopeQualified added- * Now depends on ghc-paths (no longer needs a custom cabal script)+* setInstalledModsAreInScopeQualified added+* Now depends on ghc-paths (no longer needs a custom cabal script)  ### 0.2.2 - * setOptimizations added- * Module Language.Haskell.Interpreter.GHC.Unsafe added-   (contains unsafeSetGhcOption)- * Unit tests now based on HUnit+* setOptimizations added+* Module Language.Haskell.Interpreter.GHC.Unsafe added (contains+  unsafeSetGhcOption)+* Unit tests now based on HUnit  ### 0.2.1 - * BUGFIX: Module reloading was broken under 6.8- * GHC.GhcExceptions are catched and turned into InterpreterErrors+* BUGFIX: Module reloading was broken under 6.8+* GHC.GhcExceptions are catched and turned into InterpreterErrors  ### 0.2.0.1 - * Adds the requirement cabal-version < 1.3+* Adds the requirement cabal-version < 1.3  ### 0.2 - * Works also with GHC 6.8 and 6.6- * Added the getModuleExports function- * withSession function throws a dynamic exception instead of returning Either Error a- * Requires Cabal 1.2.x+* Works also with GHC 6.8 and 6.6+* Added the getModuleExports function+* withSession function throws a dynamic exception instead of returning+  Either Error a+* Requires Cabal 1.2.x
README.md view
@@ -1,13 +1,14 @@ # hint  [![Build Status](https://travis-ci.org/mvdan/hint.svg?branch=master)](https://travis-ci.org/mvdan/hint)+[![Hackage](https://img.shields.io/hackage/v/hint.svg)](https://hackage.haskell.org/package/hint)  This library defines an Interpreter monad. It allows to load Haskell modules, browse them, type-check and evaluate strings with Haskell expressions and even coerce them into values. The library is thread-safe and type-safe (even the coercion of expressions to values). -It is, esentially, a huge subset of the GHC API wrapped in a simpler+It is, essentially, a huge subset of the GHC API wrapped in a simpler API.  ### Example
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,5 +0,0 @@-#!/usr/bin/env runhaskell-> module Main where-> import Distribution.Simple-> main :: IO ()-> main = defaultMainWithHooks defaultUserHooks
examples/example.hs view
@@ -31,7 +31,7 @@       --       say "We can also evaluate an expression; the result will be a string"       let expr2 = "length $ concat [[f,g],[h]]"-      say $ concat ["e.g. eval ", show expr1]+      say $ "e.g. eval " ++ show expr2       a <- eval expr2       say (show a)       --@@ -47,17 +47,16 @@       say . show $ fun (Just 7)       --       say "And sometimes we can even use the type system to infer the expected type (eg Maybe Bool -> Bool)!"-      bool_val <- (interpret expr3 infer `ap` (return $ Just False))+      bool_val <- interpret expr3 infer `ap` return (Just False)       say (show $ not bool_val)       --       say "Here we evaluate an expression of type string, that when evaluated (again) leads to a string"       res <- interpret "head $ map show [\"Worked!\", \"Didn't work\"]" infer >>= flip interpret infer       say res - say :: String -> Interpreter () say = liftIO . putStrLn  printInterpreterError :: InterpreterError -> IO ()-printInterpreterError e = putStrLn $ "Ups... " ++ (show e)+printInterpreterError e = putStrLn $ "Ups... " ++ show e 
hint.cabal view
@@ -1,25 +1,25 @@-name:                hint-version:             0.4.3+name:         hint+version:      0.5.0 description:-        This library defines an @Interpreter@ monad. It allows to load Haskell+        This library defines an Interpreter monad. It allows to load Haskell         modules, browse them, type-check and evaluate strings with Haskell-        expressions and even coerce them into values. The library is-        thread-safe and type-safe (even the coercion of expressions to-        values).+        expressions and even coerce them into values. The library is thread-safe+        and type-safe (even the coercion of expressions to values).          It is, essentially, a huge subset of the GHC API wrapped in a simpler         API.-synopsis:           Runtime Haskell interpreter (GHC API wrapper)-category:           Language, Compilers/Interpreters-license:            BSD3-license-file:       LICENSE-author:             The Hint Authors-maintainer:         mvdan@mvdan.cc-homepage:           https://github.com/mvdan/hint -cabal-version:      >= 1.9.2-build-type:         Simple+synopsis:     Runtime Haskell interpreter (GHC API wrapper)+category:     Language, Compilers/Interpreters+license:      BSD3+license-file: LICENSE+author:       The Hint Authors+maintainer:   mvdan@mvdan.cc+homepage:     https://github.com/mvdan/hint +cabal-version: >= 1.9.2+build-type:    Simple+ extra-source-files: README.md                     AUTHORS                     CHANGELOG.md@@ -31,88 +31,60 @@   location: https://github.com/mvdan/hint  Test-Suite unit-tests-  type: exitcode-stdio-1.0+  type:           exitcode-stdio-1.0   hs-source-dirs: unit-tests-  main-is: run-unit-tests.hs-  build-depends: base < 5-                ,hint-                ,HUnit==1.2.*-                ,directory-                ,filepath-                ,mtl-                ,extensible-exceptions-                ,exceptions+  main-is:        run-unit-tests.hs -Library-  build-depends:      ghc >= 7.4.2,-                      ghc-paths,-                      mtl,-                      filepath,-                      extensible-exceptions,-                      exceptions-  if impl(ghc >= 6.8) {-    build-depends:    random,-                      directory+  build-depends:  base == 4.*,+                  hint,+                  HUnit,+                  directory,+                  filepath,+                  extensible-exceptions,+                  exceptions -    if impl(ghc >= 6.10) {-      build-depends:  base >= 4, base < 5,-                      ghc-mtl == 1.2.1.*-                        -- version 1.1.* uses exceptions instead of MonadCatchIO-                        -- version 1.2.* uses the exceptions-0.4 api-                        -- version 1.2.1.* uses the exceptions-0.6 api-    } else {-      build-depends:  base >= 3, base < 4-    }-  }-  else {-      -- ghc < 6.8-      build-depends:    utf8-string < 0.3-  }+Library+  build-depends: base == 4.*,+                 ghc >= 7.6,+                 ghc-paths,+                 mtl,+                 filepath,+                 exceptions,+                 random,+                 directory    if !os(windows) {-      build-depends:    unix >= 2.2.0.0+      build-depends: unix >= 2.2.0.0   } -  exposed-modules:    Language.Haskell.Interpreter-                      Language.Haskell.Interpreter.Extension-                      Language.Haskell.Interpreter.Unsafe-                      Language.Haskell.Interpreter.GHC-                      Language.Haskell.Interpreter.GHC.Unsafe-  other-modules:      Hint.GHC-                      Hint.Base-                      Hint.InterpreterT-                      Hint.Compat-                      Hint.CompatPlatform-                      Hint.Configuration-                      Hint.Extension-                      Hint.Context-                      Hint.Conversions-                      Hint.Eval-                      Hint.Parsers-                      Hint.Reflection-                      Hint.Typecheck-                      Hint.Sandbox-                      Hint.SignalHandlers-                      Hint.Util--  if impl(ghc >= 6.11) {-      other-modules: Hint.Annotations-  }+  exposed-modules: Language.Haskell.Interpreter+                   Language.Haskell.Interpreter.Extension+                   Language.Haskell.Interpreter.Unsafe+  other-modules:   Hint.GHC+                   Hint.Base+                   Hint.InterpreterT+                   Hint.Compat+                   Hint.CompatPlatform+                   Hint.Configuration+                   Hint.Extension+                   Hint.Context+                   Hint.Conversions+                   Hint.Eval+                   Hint.Parsers+                   Hint.Reflection+                   Hint.Typecheck+                   Hint.Util+                   Hint.Annotations+                   Control.Monad.Ghc -  hs-source-dirs:     src+  hs-source-dirs: src -  ghc-options:        -Wall -O2-  extensions:         CPP-                      GeneralizedNewtypeDeriving-                      MultiParamTypeClasses-                      DeriveDataTypeable-                      MagicHash-                      TypeSynonymInstances-                      FlexibleInstances-                      FlexibleContexts-                      FunctionalDependencies-                      KindSignatures-                      Rank2Types-                      ScopedTypeVariables-                      ExistentialQuantification-                      PatternGuards+  ghc-options: -Wall+  extensions:  CPP+               GeneralizedNewtypeDeriving+               DeriveDataTypeable+               MagicHash+               FunctionalDependencies+               Rank2Types+               ScopedTypeVariables+               ExistentialQuantification
+ src/Control/Monad/Ghc.hs view
@@ -0,0 +1,76 @@+module Control.Monad.Ghc (+    GhcT, runGhcT+) where++import Control.Applicative+import Prelude++import Control.Monad+import Control.Monad.Trans+import qualified Control.Monad.Trans as MTL++import Control.Monad.Catch++import qualified GHC ( runGhcT )+import qualified MonadUtils as GHC+import qualified Exception  as GHC+import qualified GhcMonad   as GHC++import qualified DynFlags as GHC++newtype GhcT m a = GhcT { unGhcT :: GHC.GhcT (MTLAdapter m) a }+                 deriving (Functor, Monad, GHC.HasDynFlags)++instance (Functor m, Monad m) => Applicative (GhcT m) where+  pure  = return+  (<*>) = ap++runGhcT :: (Functor m, MonadIO m, MonadCatch m, MonadMask m) => Maybe FilePath -> GhcT m a -> m a+runGhcT f = unMTLA . GHC.runGhcT f . unGhcT++instance MTL.MonadTrans GhcT where+    lift = GhcT . GHC.liftGhcT . MTLAdapter++instance MTL.MonadIO m => MTL.MonadIO (GhcT m) where+    liftIO = GhcT . GHC.liftIO++#if __GLASGOW_HASKELL__ < 708+  -- ghc started using transformers at some point+instance MTL.MonadIO m => GHC.MonadIO (GhcT m) where+    liftIO = MTL.liftIO+#endif++instance MonadCatch m => MonadThrow (GhcT m) where+    throwM = lift . throwM++instance (MonadIO m,MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where+    m `catch` f = GhcT (unGhcT m `GHC.gcatch` (unGhcT . f))++instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where+    mask f = wrap $ \s ->+               mask $ \io_restore ->+                 unwrap (f $ \m -> (wrap $ \s' -> io_restore (unwrap m s'))) s+      where+        wrap g   = GhcT $ GHC.GhcT $ \s -> MTLAdapter (g s)+        unwrap m = unMTLA . GHC.unGhcT (unGhcT m)++    uninterruptibleMask = mask++instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (GhcT m) where+    gcatch  = catch+    gmask f = mask (\x -> f x)++instance (Functor m, MonadIO m, MonadCatch m, MonadMask m) => GHC.GhcMonad (GhcT m) where+    getSession = GhcT GHC.getSession+    setSession = GhcT . GHC.setSession++-- | We use the 'MTLAdapter' to convert between similar classes+--   like 'MTL'''s 'MonadIO' and 'GHC'''s 'MonadIO'.+newtype MTLAdapter m a = MTLAdapter {unMTLA :: m a} deriving (Functor, Applicative, Monad)++instance MTL.MonadIO m => GHC.MonadIO (MTLAdapter m) where+    liftIO = MTLAdapter . MTL.liftIO++instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (MTLAdapter m) where+  m `gcatch` f = MTLAdapter $ unMTLA m `catch` (unMTLA . f)+  gmask io = MTLAdapter $ mask (\f -> unMTLA $ io (MTLAdapter . f . unMTLA))
src/Hint/Base.hs view
@@ -1,24 +1,22 @@ module Hint.Base (     MonadInterpreter(..), RunGhc,-    --+     GhcError(..), InterpreterError(..), mayFail, catchIE,-    --+     InterpreterSession, SessionData(..), GhcErrLogger,     InterpreterState(..), fromState, onState,     InterpreterConfiguration(..),-    ---    runGhc1, runGhc2, runGhc3, runGhc4, runGhc5,-    --++    runGhc1, runGhc2, runGhc3,+     ModuleName, PhantomModule(..),     findModule, moduleIsLoaded,     withDynFlags,-    --+     ghcVersion,-    ---    debug, showGHC-) -where+    debug, showGHC+) where  import Control.Monad.Trans import Control.Monad.Catch as MC@@ -29,15 +27,12 @@ import qualified Hint.GHC as GHC  import Hint.Extension-import Hint.Compat as Compat  -- | Version of the underlying ghc api. Values are: ----- * @606@ for GHC 6.6.x------ * @608@ for GHC 6.8.x+-- * @708@ for GHC 7.8.x ----- * @610@ for GHC 6.10.x+-- * @710@ for GHC 7.10.x -- -- * etc... ghcVersion :: Int@@ -52,7 +47,6 @@ type FromSession      m a = (InterpreterSession -> a) -> m a type ModifySessionRef m a = (InterpreterSession -> IORef a) -> (a -> a) -> m a - data InterpreterError = UnknownError String                       | WontCompile [GhcError]                       | NotAllowed  String@@ -61,50 +55,26 @@                       | GhcException String                       deriving (Show, Typeable) -data InterpreterState = St{active_phantoms      :: [PhantomModule],-                           zombie_phantoms      :: [PhantomModule],-                           hint_support_module  :: PhantomModule,-                           import_qual_hack_mod :: Maybe PhantomModule,-                           qual_imports         :: [(ModuleName, String)],-                           defaultExts          :: [(Extension,Bool)], -- R/O-                           configuration        :: InterpreterConfiguration}+data InterpreterState = St {+                           activePhantoms    :: [PhantomModule],+                           zombiePhantoms    :: [PhantomModule],+                           hintSupportModule :: PhantomModule,+                           importQualHackMod :: Maybe PhantomModule,+                           qualImports       :: [(ModuleName, String)],+                           defaultExts       :: [(Extension,Bool)], -- R/O+                           configuration     :: InterpreterConfiguration+                        }  data InterpreterConfiguration = Conf {-                                  search_path       :: [FilePath],-                                  language_exts     :: [Extension],-                                  all_mods_in_scope :: Bool+                                  searchFilePath :: [FilePath],+                                  languageExts   :: [Extension],+                                  allModsInScope :: Bool                                 } -#if __GLASGOW_HASKELL__ < 610-type InterpreterSession = SessionData GHC.Session--adjust :: (a -> b -> c) -> (b -> a -> c)-adjust f = flip f--type RunGhc  m a           = (GHC.Session -> IO a)-                          -> m a-type RunGhc1 m a b         = (GHC.Session -> a -> IO b)-                          -> (a -> m b)-type RunGhc2 m a b c       = (GHC.Session -> a -> b -> IO c)-                          -> (a -> b -> m c)-type RunGhc3 m a b c d     = (GHC.Session -> a -> b -> c -> IO d)-                          -> (a -> b -> c -> m d)--type RunGhc4 m a b c d e   = (GHC.Session -> a -> b -> c -> d -> IO e)-                          -> (a -> b -> c -> d -> m e)--type RunGhc5 m a b c d e f = (GHC.Session -> a -> b -> c -> d -> e -> IO f)-                          -> (a -> b -> c -> d -> e -> m f)--#else-      -- ghc >= 6.10 type InterpreterSession = SessionData ()  instance Exception InterpreterError -adjust :: (a -> b) -> (a -> b)-adjust = id- type RunGhc  m a =     (forall n.(MonadIO n, MonadMask n,Functor n) => GHC.GhcT n a)  -> m a@@ -121,15 +91,6 @@     (forall n.(MonadIO n, MonadMask n, Functor n) => a -> b -> c -> GHC.GhcT n d)  -> (a -> b -> c -> m d) -type RunGhc4 m a b c d e =-    (forall n.(MonadIO n, MonadMask n, Functor n) => a -> b -> c -> d -> GHC.GhcT n e)- -> (a -> b -> c -> d -> m e)--type RunGhc5 m a b c d e f =-    (forall n.(MonadIO n, MonadMask n, Functor n) => a->b->c->d->e->GHC.GhcT n f)- -> (a -> b -> c -> d -> e -> m f)-#endif- data SessionData a = SessionData {                        internalState   :: IORef InterpreterState,                        versionSpecific :: a,@@ -150,43 +111,27 @@                  -> m a                  -> m a mapGhcExceptions buildEx action =-    do  action-          `MC.catch` (\err -> case err of-                                GhcException s -> throwM (buildEx s)-                                _              -> throwM err)+    action+      `MC.catch` (\err -> case err of+                            GhcException s -> throwM (buildEx s)+                            _              -> throwM err)  catchIE :: MonadInterpreter m => m a -> (InterpreterError -> m a) -> m a catchIE = MC.catch --#if __GLASGOW_HASKELL__ < 704-type GhcErrLogger = GHC.Severity-                 -> GHC.SrcSpan-                 -> GHC.PprStyle-                 -> GHC.Message-                 -> IO ()-#else type GhcErrLogger = GHC.LogAction-#endif  -- | Module names are _not_ filepaths. type ModuleName = String  runGhc1 :: MonadInterpreter m => RunGhc1 m a b-runGhc1 f a = runGhc (adjust f a)+runGhc1 f a = runGhc (f a)  runGhc2 :: MonadInterpreter m => RunGhc2 m a b c-runGhc2 f a = runGhc1 (adjust f a)+runGhc2 f a = runGhc1 (f a)  runGhc3 :: MonadInterpreter m => RunGhc3 m a b c d-runGhc3 f a = runGhc2 (adjust f a)--runGhc4 :: MonadInterpreter m => RunGhc4 m a b c d e-runGhc4 f a = runGhc3 (adjust f a)--runGhc5 :: MonadInterpreter m => RunGhc5 m a b c d e f-runGhc5 f a = runGhc4 (adjust f a)-+runGhc3 f a = runGhc2 (f a)  -- ================ Handling the interpreter state ================= @@ -222,19 +167,18 @@ showGHC a  = do unqual <- runGhc GHC.getPrintUnqual       withDynFlags $ \df ->-        return $ Compat.showSDocForUser df unqual (GHC.ppr a)+        return $ GHC.showSDocForUser df unqual (GHC.ppr a)  -- ================ Misc ===================================  -- this type ought to go in Hint.Context, but ghc dislikes cyclic imports...-data PhantomModule = PhantomModule{pm_name :: ModuleName, pm_file :: FilePath}+data PhantomModule = PhantomModule{pmName :: ModuleName, pmFile :: FilePath}                    deriving (Eq, Show)  findModule :: MonadInterpreter m => ModuleName -> m GHC.Module findModule mn = mapGhcExceptions NotAllowed $                     runGhc2 GHC.findModule mod_name Nothing     where mod_name = GHC.mkModuleName mn-  moduleIsLoaded :: MonadInterpreter m => ModuleName -> m Bool moduleIsLoaded mn = (findModule mn >> return True)
src/Hint/Compat.hs view
@@ -1,16 +1,8 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module Hint.Compat--where--#if __GLASGOW_HASKELL__ < 702-import Control.Monad.Trans (liftIO)-#endif+module Hint.Compat where -#if __GLASGOW_HASKELL__ >= 704 import Control.Monad (foldM, liftM)-#endif  import qualified Hint.GHC as GHC @@ -18,35 +10,15 @@ -- to be able to define a FromGhcRep instance for both versions newtype Kind = Kind GHC.Kind -#if __GLASGOW_HASKELL__ >= 700 -- supportedLanguages :: [String] supportedExtensions = map f GHC.xFlags     where #if (__GLASGOW_HASKELL__ >= 710)       f = GHC.flagSpecName-#elif (__GLASGOW_HASKELL__ < 702) || (__GLASGOW_HASKELL__ >= 704)-      f (e,_,_) = e #else-      f (e,_,_,_) = e+      f (e,_,_) = e #endif -#if __GLASGOW_HASKELL__ < 702--- setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()-setContext xs = GHC.setContext xs . map (\y -> (y,Nothing))--getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.Module])-getContext = fmap (\(as,bs) -> (as,map fst bs)) GHC.getContext-#elif __GLASGOW_HASKELL__ < 704--- Keep setContext/getContext unmodified for use where the results of getContext--- are simply restored by setContext, in which case we don't really care about the--- particular type of b.---- setContext :: GHC.GhcMonad m => [GHC.Module] -> [b] -> m ()-setContext = GHC.setContext---- getContext :: GHC.GhcMonad m => m ([GHC.Module], [b])-getContext = GHC.getContext-#else setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.RdrName] -> m () setContext ms ds =   let ms' = map modToIIMod ms@@ -62,66 +34,27 @@          GHC.InteractiveImport ->          m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])     f (ns, ds) i = case i of-      (GHC.IIDecl d)     -> return (ns, (d:ds))-      m@(GHC.IIModule _) -> do n <- iiModToMod m; return ((n:ns), ds)-+      (GHC.IIDecl d)     -> return (ns, d : ds)+      m@(GHC.IIModule _) -> do n <- iiModToMod m; return (n : ns, ds)  modToIIMod :: GHC.Module -> GHC.InteractiveImport iiModToMod :: GHC.GhcMonad m => GHC.InteractiveImport -> m GHC.Module-#if __GLASGOW_HASKELL__ < 706-modToIIMod = GHC.IIModule-iiModToMod (GHC.IIModule m) = return m-#else modToIIMod = GHC.IIModule . GHC.moduleName iiModToMod (GHC.IIModule m) = GHC.findModule m Nothing-#endif iiModToMod _ = error "iiModToMod!" -#endif--mkPState = GHC.mkPState--#else--- supportedExtensions :: [String]-supportedExtensions = GHC.supportedLanguages---- setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()--- i don't want to check the signature on every ghc version....-setContext = GHC.setContext--getContext = GHC.getContext--mkPState df buf loc = GHC.mkPState buf loc df-#endif- -- Explicitly-typed variants of getContext/setContext, for use where we modify -- or override the context.-#if __GLASGOW_HASKELL__ < 702 setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()-setContextModules = setContext--getContextNames :: GHC.GhcMonad m => m([String], [String])-getContextNames = fmap (\(as,bs) -> (map name as, map name bs)) getContext-    where name = GHC.moduleNameString . GHC.moduleName-#else-setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m () setContextModules as = setContext as . map (GHC.simpleImportDecl . GHC.moduleName)  getContextNames :: GHC.GhcMonad m => m([String], [String]) getContextNames = fmap (\(as,bs) -> (map name as, map decl bs)) getContext     where name = GHC.moduleNameString . GHC.moduleName           decl = GHC.moduleNameString . GHC.unLoc . GHC.ideclName-#endif -#if __GLASGOW_HASKELL__ < 702-mkSrcLoc = GHC.mkSrcLoc-stringToStringBuffer = liftIO . GHC.stringToStringBuffer-#else-mkSrcLoc = GHC.mkRealSrcLoc stringToStringBuffer = return . GHC.stringToStringBuffer-#endif -#if __GLASGOW_HASKELL__ >= 610 configureDynFlags :: GHC.DynFlags -> GHC.DynFlags configureDynFlags dflags = dflags{GHC.ghcMode    = GHC.CompManager,                                   GHC.hscTarget  = GHC.HscInterpreted,@@ -137,12 +70,6 @@ fileTarget f = GHC.Target (GHC.TargetFile f $ Just next_phase) True Nothing     where next_phase = GHC.Cpp GHC.HsSrcFile -targetId :: GHC.Target -> GHC.TargetId-targetId = GHC.targetId--guessTarget :: GHC.GhcMonad m => String -> Maybe GHC.Phase -> m GHC.Target-guessTarget = GHC.guessTarget- -- add a bogus Maybe, in order to use it with mayFail compileExpr :: GHC.GhcMonad m => String -> m (Maybe GHC.HValue) compileExpr = fmap Just . GHC.compileExpr@@ -152,64 +79,9 @@ exprType = fmap Just . GHC.exprType  -- add a bogus Maybe, in order to use it with mayFail-#if __GLASGOW_HASKELL__ < 704 typeKind :: GHC.GhcMonad m => String -> m (Maybe GHC.Kind)-typeKind = fmap Just . GHC.typeKind-#else-typeKind :: GHC.GhcMonad m => String -> m (Maybe GHC.Kind) typeKind = fmap Just . (liftM snd) . (GHC.typeKind True)-#endif-#else--- add a bogus session parameter, in order to use it with runGhc2-parseDynamicFlags :: GHC.Session-                  -> GHC.DynFlags-                  -> [String] -> IO (GHC.DynFlags, [String])-parseDynamicFlags = const GHC.parseDynamicFlags -fileTarget :: FilePath -> GHC.Target-fileTarget f = GHC.Target (GHC.TargetFile f $ Just next_phase) Nothing-    where next_phase = GHC.Cpp GHC.HsSrcFile--targetId :: GHC.Target -> GHC.TargetId-targetId (GHC.Target _id _) = _id---- add a bogus session parameter, in order to use it with runGhc2-guessTarget :: GHC.Session -> String -> Maybe GHC.Phase -> IO GHC.Target-guessTarget = const GHC.guessTarget--compileExpr :: GHC.Session -> String -> IO (Maybe GHC.HValue)-compileExpr = GHC.compileExpr--exprType :: GHC.Session -> String -> IO (Maybe GHC.Type)-exprType = GHC.exprType--typeKind :: GHC.Session -> String -> IO (Maybe GHC.Kind)-typeKind = GHC.typeKind--#endif--#if __GLASGOW_HASKELL__ >= 608-#if __GLASGOW_HASKELL__ < 610-  -- 6.08 only-newSession :: FilePath -> IO GHC.Session-newSession ghc_root = GHC.newSession (Just ghc_root)--configureDynFlags :: GHC.DynFlags -> GHC.DynFlags-configureDynFlags dflags = dflags{GHC.ghcMode    = GHC.CompManager,-                                  GHC.hscTarget  = GHC.HscInterpreted,-                                  GHC.ghcLink    = GHC.LinkInMemory}-#endif--#if __GLASGOW_HASKELL__ < 701-  -- 6.08 - 7.0.4-pprType :: GHC.Type -> (GHC.PprStyle -> GHC.Doc)-pprType = GHC.pprTypeForUser False -- False means drop explicit foralls--pprKind :: GHC.Kind -> (GHC.PprStyle -> GHC.Doc)-pprKind = pprType-#else-  -- 7.2.1 and above- pprType :: GHC.Type -> GHC.SDoc #if __GLASGOW_HASKELL__ < 708 pprType = GHC.pprTypeForUser False -- False means drop explicit foralls@@ -217,41 +89,4 @@ pprType = GHC.pprTypeForUser #endif -pprKind :: GHC.Kind -> GHC.SDoc-pprKind = pprType-#endif--#elif __GLASGOW_HASKELL__ >= 606-  -- 6.6 only--newSession :: FilePath -> IO GHC.Session-newSession ghc_root = GHC.newSession GHC.Interactive (Just ghc_root)--configureDynFlags :: GHC.DynFlags -> GHC.DynFlags-configureDynFlags dflags = dflags{GHC.hscTarget  = GHC.HscInterpreted}--pprType :: GHC.Type -> (GHC.PprStyle -> GHC.Doc)-pprType = GHC.ppr . GHC.dropForAlls--pprKind :: GHC.Kind -> (GHC.PprStyle -> GHC.Doc)-pprKind = GHC.ppr--#endif--#if __GLASGOW_HASKELL__ >= 706-showSDoc        = GHC.showSDoc-showSDocForUser = GHC.showSDocForUser-showSDocUnqual  = GHC.showSDocUnqual-#else-  -- starting from ghc 7.6, they started to receive a DynFlags argument (sigh)-showSDoc        _ = GHC.showSDoc-showSDocForUser _ = GHC.showSDocForUser-showSDocUnqual  _ = GHC.showSDocUnqual-#endif---#if __GLASGOW_HASKELL__ >= 706 mkLocMessage = GHC.mkLocMessage GHC.SevError-#else-mkLocMessage = GHC.mkLocMessage-#endif
src/Hint/CompatPlatform.hs view
@@ -1,15 +1,12 @@ #if defined(mingw32_HOST_OS) || defined(__MINGW32__) {-# LANGUAGE ForeignFunctionInterface #-} #endif-module Hint.CompatPlatform-  (+module Hint.CompatPlatform (     getPID-  )--where+) where  import Control.Applicative-+import Prelude  #if defined(mingw32_HOST_OS) || defined(__MINGW32__) @@ -20,7 +17,6 @@ import System.Posix.Process  #endif-  #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -- This function is not yet in the win32 package, so we have to
src/Hint/Configuration.hs view
@@ -1,24 +1,20 @@ module Hint.Configuration (-       setGhcOption, setGhcOptions, -      defaultConf, fromConf, onConf,+      defaultConf,        get, set, Option, OptionVal(..), -      languageExtensions, availableExtensions, glasgowExtensions, Extension(..),+      languageExtensions, availableExtensions, Extension(..),       installedModulesInScope, -      setUseLanguageExtensions,--      setInstalledModsAreInScopeQualified,       searchPath-      ) where+) where  import Control.Monad import Control.Monad.Catch import Data.Char-import Data.List ( intersect, intercalate )+import Data.List ( intercalate )  import qualified Hint.GHC as GHC import qualified Hint.Compat as Compat@@ -31,7 +27,7 @@ setGhcOptions opts =     do old_flags <- runGhc GHC.getSessionDynFlags        (new_flags,not_parsed) <- runGhc2 Compat.parseDynamicFlags old_flags opts-       when (not . null $ not_parsed) $+       unless (null not_parsed) $             throwM $ UnknownError                             $ concat ["flags: ", unwords $ map quote not_parsed,                                                "not recognized"]@@ -43,12 +39,11 @@  defaultConf :: InterpreterConfiguration defaultConf = Conf {-                language_exts     = [],-                all_mods_in_scope = False,-                search_path       = ["."]+                languageExts   = [],+                allModsInScope = False,+                searchFilePath = ["."]               } - -- | Available options are: -- --    * 'languageExtensions'@@ -56,8 +51,10 @@ --    * 'installedModulesInScope' -- --    * 'searchPath'-data Option m a = Option{_set :: MonadInterpreter m => a -> m (),-                         _get :: MonadInterpreter m => m a}+data Option m a = Option{+                    _set :: MonadInterpreter m => a -> m (),+                    _get :: MonadInterpreter m => m a+                  }  data OptionVal m = forall a . (Option m a) := a @@ -79,9 +76,9 @@ languageExtensions = Option setter getter     where setter es = do resetExtensions                          setGhcOptions $ map (extFlag True)  es-                         onConf $ \c -> c{language_exts = es}+                         onConf $ \c -> c{languageExts = es}           ---          getter = fromConf language_exts+          getter = fromConf languageExts           --           resetExtensions = do es <- fromState defaultExts                                setGhcOptions $ map (uncurry $ flip extFlag) es@@ -95,46 +92,6 @@                              | isUpper c = "-X" ++ drop (if b then 0 else 2) o         strToFlag b o                    = "-X" ++ concat ["No"|not b] ++ o ----- | List of extensions turned on when the @-fglasgow-exts@ flag is used-{-# DEPRECATED glasgowExtensions "glasgowExtensions list is no longer maintained, will be removed soon" #-}-glasgowExtensions :: [Extension]-glasgowExtensions = intersect availableExtensions exts612 -- works also for 608 and 610-    where exts612 = map asExtension ["PrintExplicitForalls",-                                     "ForeignFunctionInterface",-                                     "UnliftedFFITypes",-                                     "GADTs",-                                     "ImplicitParams",-                                     "ScopedTypeVariables",-                                     "UnboxedTuples",-                                     "TypeSynonymInstances",-                                     "StandaloneDeriving",-                                     "DeriveDataTypeable",-                                     "FlexibleContexts",-                                     "FlexibleInstances",-                                     "ConstrainedClassMethods",-                                     "MultiParamTypeClasses",-                                     "FunctionalDependencies",-                                     "MagicHash",-                                     "PolymorphicComponents",-                                     "ExistentialQuantification",-                                     "UnicodeSyntax",-                                     "PostfixOperators",-                                     "PatternGuards",-                                     "LiberalTypeSynonyms",-                                     "ExplicitForAll",-                                     "RankNTypes",-                                     "ImpredicativeTypes",-                                     "TypeOperators",-                                     "RecursiveDo",-                                     "DoRec",-                                     "ParallelListComp",-                                     "EmptyDataDecls",-                                     "KindSignatures",-                                     "GeneralizedNewtypeDeriving",-                                     "TypeFamilies" ]- -- | When set to @True@, every module in every available package is implicitly --   imported qualified. This is very convenient for interactive --   evaluation, but can be a problem in sandboxed environments@@ -146,12 +103,11 @@ --   private symbols in interpreted modules will not be in scope. installedModulesInScope :: MonadInterpreter m => Option m Bool installedModulesInScope = Option setter getter-    where getter = fromConf all_mods_in_scope-          setter b = do onConf $ \c -> c{all_mods_in_scope = b}-                        when ( ghcVersion >= 610 ) $-                            setGhcOption $ "-f"                   ++-                                           concat ["no-" | not b] ++-                                           "implicit-import-qualified"+    where getter = fromConf allModsInScope+          setter b = do onConf $ \c -> c{allModsInScope = b}+                        setGhcOption $ "-f"                   +++                                       concat ["no-" | not b] +++                                       "implicit-import-qualified"  -- | The search path for source files. Observe that every time it is set, --   it overrides the previous search path. The default is @[\".\"]@.@@ -159,12 +115,11 @@ --   Keep in mind that by a limitation in ghc, @\".\"@ is always in scope. searchPath :: MonadInterpreter m => Option m [FilePath] searchPath = Option setter getter-    where getter = fromConf search_path-          setter p = do onConf $ \c -> c{search_path = p}-                        setGhcOption $ "-i" -- clear the old path+    where getter = fromConf searchFilePath+          setter p = do onConf $ \c -> c{searchFilePath = p}+                        setGhcOption "-i" -- clear the old path                         setGhcOption $ "-i" ++ intercalate ":" p - fromConf :: MonadInterpreter m => (InterpreterConfiguration -> a) -> m a fromConf f = fromState (f . configuration) @@ -172,13 +127,3 @@        => (InterpreterConfiguration -> InterpreterConfiguration)        -> m () onConf f = onState $ \st -> st{configuration = f (configuration st)}--{-# DEPRECATED setUseLanguageExtensions "Use set [languageExtensions := (ExtendedDefaultRules:glasgowExtensions)] instead." #-}-setUseLanguageExtensions :: MonadInterpreter m => Bool -> m ()-setUseLanguageExtensions False = set [languageExtensions := []]-setUseLanguageExtensions True  = set [languageExtensions := exts]-    where exts = ExtendedDefaultRules : glasgowExtensions--{-# DEPRECATED setInstalledModsAreInScopeQualified "Use set [installedModulesInScope := b] instead." #-}-setInstalledModsAreInScopeQualified :: MonadInterpreter m => Bool -> m ()-setInstalledModsAreInScopeQualified b = set [installedModulesInScope := b]
src/Hint/Context.hs view
@@ -1,27 +1,21 @@ module Hint.Context (--      ModuleName, isModuleInterpreted,+      isModuleInterpreted,       loadModules, getLoadedModules, setTopLevelModules,       setImports, setImportsQ,       reset, -      PhantomModule(..), ModuleText,-      addPhantomModule, removePhantomModule, getPhantomModules,+      PhantomModule(..),       cleanPhantomModules, -      allModulesInContext, onAnEmptyContext,--      support_String, support_show-)--where+      supportString, supportShow+) where  import Prelude hiding ( mod )  import Data.Char import Data.List -import Control.Monad       ( liftM, filterM, when, guard )+import Control.Monad       ( liftM, filterM, unless, guard ) import Control.Monad.Trans ( liftIO ) import Control.Monad.Catch @@ -58,7 +52,7 @@        --        tmp_dir <- liftIO getTemporaryDirectory        ---       return PhantomModule{pm_name = mod_name, pm_file = tmp_dir </> nums}+       return PhantomModule{pmName = mod_name, pmFile = tmp_dir </> nums}  allModulesInContext :: MonadInterpreter m => m ([ModuleName], [ModuleName]) allModulesInContext = runGhc Compat.getContextNames@@ -68,12 +62,12 @@                  -> m PhantomModule addPhantomModule mod_text =     do pm <- newPhantomModule-       let t  = Compat.fileTarget (pm_file pm)-           m  = GHC.mkModuleName (pm_name pm)+       let t  = Compat.fileTarget (pmFile pm)+           m  = GHC.mkModuleName (pmName pm)        ---       liftIO $ writeFile (pm_file pm) (mod_text $ pm_name pm)+       liftIO $ writeFile (pmFile pm) (mod_text $ pmName pm)        ---       onState (\s -> s{active_phantoms = pm:active_phantoms s})+       onState (\s -> s{activePhantoms = pm:activePhantoms s})        mayFail (do -- GHC.load will remove all the modules from scope, so first                    -- we save the context...                    (old_top, old_imps) <- runGhc Compat.getContext@@ -102,11 +96,11 @@        -- and mark it as "delete me when possible" (i.e., next time the        -- @loadModules@ function is called).        ---       isLoaded <- moduleIsLoaded $ pm_name pm+       isLoaded <- moduleIsLoaded $ pmName pm        safeToRemove <-            if isLoaded              then do -- take it out of scope-                     mod <- findModule (pm_name pm)+                     mod <- findModule (pmName pm)                      (mods, imps) <- runGhc Compat.getContext                      let mods' = filter (mod /=) mods                      runGhc2 Compat.setContext mods' imps@@ -116,27 +110,27 @@                      null `liftM` filterM isNotPhantom mods'              else return True        ---       let file_name = pm_file pm-       runGhc1 GHC.removeTarget (Compat.targetId $ Compat.fileTarget file_name)+       let file_name = pmFile pm+       runGhc1 GHC.removeTarget (GHC.targetId $ Compat.fileTarget file_name)        ---       onState (\s -> s{active_phantoms = filter (pm /=) $ active_phantoms s})+       onState (\s -> s{activePhantoms = filter (pm /=) $ activePhantoms s})        --        if safeToRemove          then do mayFail $ do res <- runGhc1 GHC.load GHC.LoadAllTargets                               return $ guard (isSucceeded res) >> Just ()-                 liftIO $ removeFile (pm_file pm)-         else do onState (\s -> s{zombie_phantoms = pm:zombie_phantoms s})+                 liftIO $ removeFile (pmFile pm)+         else do onState (\s -> s{zombiePhantoms = pm:zombiePhantoms s})                  return ()  -- Returns a tuple with the active and zombie phantom modules respectively getPhantomModules :: MonadInterpreter m => m ([PhantomModule], [PhantomModule])-getPhantomModules = do active <- fromState active_phantoms-                       zombie <- fromState zombie_phantoms+getPhantomModules = do active <- fromState activePhantoms+                       zombie <- fromState zombiePhantoms                        return (active, zombie)  isPhantomModule :: MonadInterpreter m => ModuleName -> m Bool isPhantomModule mn = do (as,zs) <- getPhantomModules-                        return $ mn `elem` (map pm_name $ as ++ zs)+                        return $ mn `elem` map pmName (as ++ zs)  -- | Tries to load all the requested modules from their source file. --   Modules my be indicated by their ModuleName (e.g. \"My.Module\") or@@ -167,10 +161,9 @@                     reset                     doLoad fs `catchIE` (\e  -> reset >> throwM e) - doLoad :: MonadInterpreter m => [String] -> m ()-doLoad fs = do mayFail $ do-                   targets <- mapM (\f->runGhc2 Compat.guessTarget f Nothing) fs+doLoad fs = mayFail $ do+                   targets <- mapM (\f->runGhc2 GHC.guessTarget f Nothing) fs                    --                    runGhc1 GHC.setTargets targets                    res <- runGhc1 GHC.load GHC.LoadAllTargets@@ -186,7 +179,7 @@ getLoadedModules :: MonadInterpreter m => m [ModuleName] getLoadedModules = do (active_pms, zombie_pms) <- getPhantomModules                       ms <- map modNameFromSummary `liftM` getLoadedModSummaries-                      return $ ms \\ (map pm_name $ active_pms ++ zombie_pms)+                      return $ ms \\ map pmName (active_pms ++ zombie_pms)  modNameFromSummary :: GHC.ModSummary -> ModuleName modNameFromSummary =  moduleToString . GHC.ms_mod@@ -205,31 +198,22 @@     do loaded_mods_ghc <- getLoadedModSummaries        --        let not_loaded = ms \\ map modNameFromSummary loaded_mods_ghc-       when (not . null $ not_loaded) $+       unless (null not_loaded) $          throwM $ NotAllowed ("These modules have not been loaded:\n" ++                               unlines not_loaded)        ---       active_pms <- fromState active_phantoms-       ms_mods <- mapM findModule (nub $ ms ++ map pm_name active_pms)+       active_pms <- fromState activePhantoms+       ms_mods <- mapM findModule (nub $ ms ++ map pmName active_pms)        --        let mod_is_interpr = runGhc1 GHC.moduleIsInterpreted        not_interpreted <- filterM (liftM not . mod_is_interpr) ms_mods-       when (not . null $ not_interpreted) $+       unless (null $ not_interpreted) $          throwM $ NotAllowed ("These modules are not interpreted:\n" ++                               unlines (map moduleToString not_interpreted))        --        (_, old_imports) <- runGhc Compat.getContext        runGhc2 Compat.setContext ms_mods old_imports -onAnEmptyContext :: MonadInterpreter m => m a -> m a-onAnEmptyContext action =-    do (old_mods, old_imps) <- runGhc Compat.getContext-       runGhc2 Compat.setContext [] []-       let restore = runGhc2 Compat.setContext old_mods old_imps-       a <- action `catchIE` (\e -> do restore; throwM e)-       restore-       return a- -- | Sets the modules whose exports must be in context. -- --   Warning: 'setImports' and 'setImportsQ' are mutually exclusive.@@ -248,31 +232,31 @@ --   Here, "map" will refer to Prelude.map and "M.map" to Data.Map.map. setImportsQ :: MonadInterpreter m => [(ModuleName, Maybe String)] -> m () setImportsQ ms =-    do let qualOrNot = \(a,mb) -> maybe (Right a) (Left . (,) a) mb-           (quals,unquals) = Util.partitionEither $ map qualOrNot ms+    do let qualOrNot (a, mb) = maybe (Right a) (Left . (,) a) mb+           (quals, unquals) = Util.partitionEither $ map qualOrNot ms        --        unqual_mods <- mapM findModule unquals        mapM_ (findModule . fst) quals -- just to be sure they exist        ---       old_qual_hack_mod <- fromState import_qual_hack_mod+       old_qual_hack_mod <- fromState importQualHackMod        maybe (return ()) removePhantomModule old_qual_hack_mod        ---       new_pm <- if ( not $ null quals )+       new_pm <- if not $ null quals                    then do                      new_pm <- addPhantomModule $ \mod_name -> unlines $                                 ("module " ++ mod_name ++ " where ") :                                 ["import qualified " ++ m ++ " as " ++ n |                                    (m,n) <- quals]-                     onState (\s -> s{import_qual_hack_mod = Just new_pm})+                     onState (\s -> s{importQualHackMod = Just new_pm})                      return $ Just new_pm                    else return Nothing        ---       pm <- maybe (return []) (findModule . pm_name >=> return . return) new_pm+       pm <- maybe (return []) (findModule . pmName >=> return . return) new_pm        (old_top_level, _) <- runGhc Compat.getContext        let new_top_level = pm ++ old_top_level        runGhc2 Compat.setContextModules new_top_level unqual_mods        ---       onState (\s ->s{qual_imports = quals})+       onState (\s ->s{qualImports = quals})  -- | 'cleanPhantomModules' works like 'reset', but skips the --   loading of the support module that installs '_show'. Its purpose@@ -293,13 +277,13 @@        -- liftIO $ rts_revertCAFs        --        -- We now remove every phantom module and forget about qual imports-       old_active <- fromState active_phantoms-       old_zombie <- fromState zombie_phantoms-       onState (\s -> s{active_phantoms      = [],-                        zombie_phantoms      = [],-                        import_qual_hack_mod = Nothing,-                        qual_imports         = []})-       liftIO $ mapM_ (removeFile . pm_file) (old_active ++ old_zombie)+       old_active <- fromState activePhantoms+       old_zombie <- fromState zombiePhantoms+       onState (\s -> s{activePhantoms      = [],+                        zombiePhantoms      = [],+                        importQualHackMod = Nothing,+                        qualImports         = []})+       liftIO $ mapM_ (removeFile . pmFile) (old_active ++ old_zombie)  -- | All imported modules are cleared from the context, and --   loaded modules are unloaded. It is similar to a @:load@ in@@ -315,8 +299,8 @@ -- Load a phantom module with all the symbols from the prelude we need installSupportModule :: MonadInterpreter m => m () installSupportModule = do mod <- addPhantomModule support_module-                          onState (\st -> st{hint_support_module = mod})-                          mod' <- findModule (pm_name mod)+                          onState (\st -> st{hintSupportModule = mod})+                          mod' <- findModule (pmName mod)                           runGhc2 Compat.setContext [mod'] []     --     where support_module m = unlines [@@ -339,7 +323,7 @@ -- Call it when the support module is an active phantom module but has been -- unloaded as a side effect by GHC (e.g. by calling GHC.loadTargets) reinstallSupportModule :: MonadInterpreter m => m ()-reinstallSupportModule = do pm <- fromState hint_support_module+reinstallSupportModule = do pm <- fromState hintSupportModule                             removePhantomModule pm                             installSupportModule @@ -352,13 +336,13 @@ altPreludeName :: ModuleName -> String altPreludeName mod_name = "Prelude_" ++ mod_name -support_String :: MonadInterpreter m => m String-support_String = do mod_name <- fromState (pm_name . hint_support_module)-                    return $ concat [mod_name, ".", altStringName mod_name]+supportString :: MonadInterpreter m => m String+supportString = do mod_name <- fromState (pmName . hintSupportModule)+                   return $ concat [mod_name, ".", altStringName mod_name] -support_show :: MonadInterpreter m => m String-support_show = do mod_name <- fromState (pm_name . hint_support_module)-                  return $ concat [mod_name, ".", altShowName mod_name]+supportShow :: MonadInterpreter m => m String+supportShow = do mod_name <- fromState (pmName . hintSupportModule)+                 return $ concat [mod_name, ".", altShowName mod_name]  -- SHOULD WE CALL THIS WHEN MODULES ARE LOADED / UNLOADED? -- foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
src/Hint/Conversions.hs view
@@ -1,35 +1,26 @@-module Hint.Conversions-  (-   typeToString-  ,kindToString-  ,moduleToString-  ,isSucceeded-  )--where+module Hint.Conversions (+      typeToString, kindToString, moduleToString, isSucceeded+) where  import qualified Hint.GHC as GHC  import Hint.Base import qualified Hint.Compat as Compat - -- --------- Types / Kinds ----------------------- - typeToString :: MonadInterpreter m => GHC.Type -> m String typeToString t  = do -- Unqualify necessary types       -- (i.e., do not expose internals)       unqual <- runGhc GHC.getPrintUnqual       withDynFlags $ \df ->-        return $ Compat.showSDocForUser df unqual (Compat.pprType t)+        return $ GHC.showSDocForUser df unqual (Compat.pprType t)  kindToString :: MonadInterpreter m => Compat.Kind -> m String kindToString (Compat.Kind k)  = withDynFlags $ \df ->-     return $ Compat.showSDoc df (Compat.pprKind k)-+     return $ GHC.showSDoc df (Compat.pprType k)  -- ---------------- Modules -------------------------- 
src/Hint/Eval.hs view
@@ -1,9 +1,7 @@ module Hint.Eval (-       interpret, as, infer,-      eval ,parens)--where+      eval, parens+) where  import qualified GHC.Exts ( unsafeCoerce# ) @@ -13,12 +11,10 @@ import Hint.Base import Hint.Context import Hint.Parsers-import Hint.Sandbox import Hint.Util  import qualified Hint.Compat as Compat - -- | Convenience functions to be used with @interpret@ to provide witnesses. --   Example: --@@ -33,26 +29,24 @@ interpret :: (MonadInterpreter m, Typeable a) => String -> a -> m a interpret expr wit = unsafeInterpret expr (show $ Data.Typeable.typeOf wit) - unsafeInterpret :: (MonadInterpreter m) => String -> String -> m a-unsafeInterpret expr type_str = sandboxed go expr-  where go e =-         do -- First, make sure the expression has no syntax errors,-            -- for this is the only way we have to "intercept" this-            -- kind of errors-            failOnParseError parseExpr e-            ---            let expr_typesig = concat [parens e, " :: ", type_str]-            expr_val <- mayFail $ runGhc1 Compat.compileExpr expr_typesig-            ---            return (GHC.Exts.unsafeCoerce# expr_val :: a)+unsafeInterpret expr type_str =+    do -- First, make sure the expression has no syntax errors,+       -- for this is the only way we have to "intercept" this+       -- kind of errors+       failOnParseError parseExpr expr+       --+       let expr_typesig = concat [parens expr, " :: ", type_str]+       expr_val <- mayFail $ runGhc1 Compat.compileExpr expr_typesig+       --+       return (GHC.Exts.unsafeCoerce# expr_val :: a)  -- | @eval expr@ will evaluate @show expr@. --  It will succeed only if @expr@ has type t and there is a 'Show' --  instance for t. eval :: MonadInterpreter m => String -> m String-eval expr = do in_scope_show   <- support_show-               in_scope_String <- support_String+eval expr = do in_scope_show   <- supportShow+               in_scope_String <- supportString                let show_expr = unwords [in_scope_show, parens expr]                unsafeInterpret show_expr in_scope_String 
src/Hint/Extension.hs view
@@ -1,9 +1,8 @@ -- this module was automatically generated. do not edit! -- edit util/mk_extensions_mod.hs instead-module Hint.Extension (Extension(..),-                       knownExtensions, availableExtensions, asExtension)--where+module Hint.Extension (+    Extension(..), availableExtensions, asExtension+) where  import Hint.Compat as Compat @@ -29,13 +28,14 @@                | RecursiveDo                | ParallelListComp                | MultiParamTypeClasses-               | NoMonomorphismRestriction+               | MonomorphismRestriction                | FunctionalDependencies                | Rank2Types                | RankNTypes                | PolymorphicComponents                | ExistentialQuantification                | ScopedTypeVariables+               | PatternSignatures                | ImplicitParams                | FlexibleContexts                | FlexibleInstances@@ -48,7 +48,7 @@                | ForeignFunctionInterface                | Arrows                | Generics-               | NoImplicitPrelude+               | ImplicitPrelude                | NamedFieldPuns                | PatternGuards                | GeneralizedNewtypeDeriving@@ -59,20 +59,26 @@                | TypeFamilies                | StandaloneDeriving                | UnicodeSyntax-               | PatternSignatures                | UnliftedFFITypes+               | InterruptibleFFI+               | CApiFFI                | LiberalTypeSynonyms                | TypeOperators                | RecordWildCards                | RecordPuns                | DisambiguateRecordFields+               | TraditionalRecordSyntax                | OverloadedStrings                | GADTs-               | NoMonoPatBinds+               | GADTSyntax+               | MonoPatBinds                | RelaxedPolyRec                | ExtendedDefaultRules                | UnboxedTuples                | DeriveDataTypeable+               | DeriveGeneric+               | DefaultSignatures+               | InstanceSigs                | ConstrainedClassMethods                | PackageImports                | ImpredicativeTypes@@ -80,6 +86,7 @@                | PostfixOperators                | QuasiQuotes                | TransformListComp+               | MonadComprehensions                | ViewPatterns                | XmlSyntax                | RegularPatterns@@ -87,6 +94,8 @@                | GHCForeignImportPrim                | NPlusKPatterns                | DoAndIfThenElse+               | MultiWayIf+               | LambdaCase                | RebindableSyntax                | ExplicitForAll                | DatatypeContexts@@ -94,6 +103,30 @@                | DeriveFunctor                | DeriveTraversable                | DeriveFoldable+               | NondecreasingIndentation+               | SafeImports+               | Safe+               | Trustworthy+               | Unsafe+               | ConstraintKinds+               | PolyKinds+               | DataKinds+               | ParallelArrays+               | RoleAnnotations+               | OverloadedLists+               | EmptyCase+               | AutoDeriveTypeable+               | NegativeLiterals+               | BinaryLiterals+               | NumDecimals+               | NullaryTypeClasses+               | ExplicitNamespaces+               | AllowAmbiguousTypes+               | JavaScriptFFI+               | PatternSynonyms+               | PartialTypeSignatures+               | NamedWildCards+               | DeriveAnyClass                | UnknownExtension String         deriving (Eq, Show, Read) @@ -105,13 +138,14 @@                    RecursiveDo,                    ParallelListComp,                    MultiParamTypeClasses,-                   NoMonomorphismRestriction,+                   MonomorphismRestriction,                    FunctionalDependencies,                    Rank2Types,                    RankNTypes,                    PolymorphicComponents,                    ExistentialQuantification,                    ScopedTypeVariables,+                   PatternSignatures,                    ImplicitParams,                    FlexibleContexts,                    FlexibleInstances,@@ -124,7 +158,7 @@                    ForeignFunctionInterface,                    Arrows,                    Generics,-                   NoImplicitPrelude,+                   ImplicitPrelude,                    NamedFieldPuns,                    PatternGuards,                    GeneralizedNewtypeDeriving,@@ -135,20 +169,26 @@                    TypeFamilies,                    StandaloneDeriving,                    UnicodeSyntax,-                   PatternSignatures,                    UnliftedFFITypes,+                   InterruptibleFFI,+                   CApiFFI,                    LiberalTypeSynonyms,                    TypeOperators,                    RecordWildCards,                    RecordPuns,                    DisambiguateRecordFields,+                   TraditionalRecordSyntax,                    OverloadedStrings,                    GADTs,-                   NoMonoPatBinds,+                   GADTSyntax,+                   MonoPatBinds,                    RelaxedPolyRec,                    ExtendedDefaultRules,                    UnboxedTuples,                    DeriveDataTypeable,+                   DeriveGeneric,+                   DefaultSignatures,+                   InstanceSigs,                    ConstrainedClassMethods,                    PackageImports,                    ImpredicativeTypes,@@ -156,6 +196,7 @@                    PostfixOperators,                    QuasiQuotes,                    TransformListComp,+                   MonadComprehensions,                    ViewPatterns,                    XmlSyntax,                    RegularPatterns,@@ -163,11 +204,37 @@                    GHCForeignImportPrim,                    NPlusKPatterns,                    DoAndIfThenElse,+                   MultiWayIf,+                   LambdaCase,                    RebindableSyntax,                    ExplicitForAll,                    DatatypeContexts,                    MonoLocalBinds,                    DeriveFunctor,                    DeriveTraversable,-                   DeriveFoldable+                   DeriveFoldable,+                   NondecreasingIndentation,+                   SafeImports,+                   Safe,+                   Trustworthy,+                   Unsafe,+                   ConstraintKinds,+                   PolyKinds,+                   DataKinds,+                   ParallelArrays,+                   RoleAnnotations,+                   OverloadedLists,+                   EmptyCase,+                   AutoDeriveTypeable,+                   NegativeLiterals,+                   BinaryLiterals,+                   NumDecimals,+                   NullaryTypeClasses,+                   ExplicitNamespaces,+                   AllowAmbiguousTypes,+                   JavaScriptFFI,+                   PatternSynonyms,+                   PartialTypeSignatures,+                   NamedWildCards,+                   DeriveAnyClass                    ]
src/Hint/GHC.hs view
@@ -2,54 +2,32 @@     module GHC,     module Outputable,     module ErrUtils, Message,-    module Pretty,     module DriverPhases,     module StringBuffer,     module Lexer,     module Parser,     module DynFlags,     module FastString,-#if __GLASGOW_HASKELL__ >= 610     module Control.Monad.Ghc,     module HscTypes,-    module Bag,-#endif-#if __GLASGOW_HASKELL__ >= 608     module PprTyThing,-#elif __GLASGOW_HASKELL__ < 608     module SrcLoc,-#endif-#if __GLASGOW_HASKELL__ >= 702-    module SrcLoc,-#endif #if __GLASGOW_HASKELL__ >= 708     module ConLike, #endif-)+) where -where-#if __GLASGOW_HASKELL__ >= 610 import GHC hiding ( Phase, GhcT, runGhcT ) import Control.Monad.Ghc ( GhcT, runGhcT )  import HscTypes ( SourceError, srcErrorMessages, GhcApiError )-import Bag ( bagToList )-#else-import GHC hiding ( Phase )-#endif  import Outputable   ( PprStyle, SDoc, Outputable(ppr),                       showSDoc, showSDocForUser, showSDocUnqual,                       withPprStyle, defaultErrStyle ) -import ErrUtils     ( mkLocMessage, pprErrMsgBagWithLoc)-#if __GLASGOW_HASKELL__ < 706-import ErrUtils     ( Message )-#else-import ErrUtils     ( MsgDoc ) -- we alias it as Message below-#endif+import ErrUtils     ( mkLocMessage, pprErrMsgBagWithLoc, MsgDoc) -- we alias MsgDoc as Message below -import Pretty       ( Doc ) import DriverPhases ( Phase(Cpp), HscSource(HsSrcFile) ) import StringBuffer ( stringToStringBuffer ) import Lexer        ( P(..), ParseResult(..), mkPState )@@ -57,31 +35,16 @@ import FastString   ( fsLit )  #if   __GLASGOW_HASKELL__ >= 710-import DynFlags     ( supportedLanguagesAndExtensions, xFlags, xopt, FlagSpec(..) )-#elif __GLASGOW_HASKELL__ >= 700-import DynFlags     ( supportedLanguagesAndExtensions, xFlags, xopt )+import DynFlags     ( xFlags, xopt, LogAction, FlagSpec(..) ) #else-import DynFlags     ( supportedLanguages )-#endif--#if __GLASGOW_HASKELL__ >=704-import DynFlags     ( LogAction )+import DynFlags     ( xFlags, xopt, LogAction ) #endif -#if __GLASGOW_HASKELL__ >= 608 import PprTyThing   ( pprTypeForUser )-#elif __GLASGOW_HASKELL__ < 608-import SrcLoc       ( SrcSpan )-#endif--#if __GLASGOW_HASKELL__ >= 702 import SrcLoc       ( mkRealSrcLoc )-#endif  #if __GLASGOW_HASKELL__ >= 708 import ConLike      ( ConLike(RealDataCon) ) #endif -#if __GLASGOW_HASKELL__ >= 706 type Message = MsgDoc-#endif
src/Hint/InterpreterT.hs view
@@ -1,10 +1,9 @@ module Hint.InterpreterT (     InterpreterT, Interpreter, runInterpreter, runInterpreterWithArgs,     MultipleInstancesNotAllowed(..)-)--where+) where +import Control.Applicative import Prelude  import Hint.Base@@ -12,7 +11,6 @@ import Hint.Configuration import Hint.Extension -import Control.Applicative import Control.Monad.Reader import Control.Monad.Catch as MC @@ -21,11 +19,7 @@ import System.IO.Unsafe ( unsafePerformIO )  import Data.IORef-import Data.List import Data.Maybe-#if __GLASGOW_HASKELL__ < 610-import Data.Dynamic-#endif  import qualified GHC.Paths @@ -34,35 +28,9 @@  type Interpreter = InterpreterT IO -#if __GLASGOW_HASKELL__ < 610--newtype InterpreterT m a = InterpreterT{-                             unInterpreterT :: ReaderT InterpreterSession-                                               (ErrorT InterpreterError m) a}-    deriving (Functor, Monad, MonadIO, MonadThrow,MonadCatch,MonadMask)--execute :: (MonadIO m, MonadMask m, Functor m)-        => InterpreterSession-        -> InterpreterT m a-        -> m (Either InterpreterError a)-execute s = runErrorT . flip runReaderT s . unInterpreterT--instance MonadTrans InterpreterT where-    lift = InterpreterT . lift . lift--runGhc_impl :: (MonadIO m, MonadThrow m, MonadMask m, Functor m) => RunGhc (InterpreterT m) a-runGhc_impl f = do s <- fromSession versionSpecific -- i.e. the ghc session-                   r <- liftIO $ f' s-                   either throwError return r-    where f' = tryJust (fmap (GhcException . showGhcEx) . ghcExceptions) . f-          ghcExceptions (DynException e) = fromDynamic e-          ghcExceptions  _               = Nothing--#else-      -- ghc >= 6.10-newtype InterpreterT m a = InterpreterT{-                             unInterpreterT :: ReaderT  InterpreterSession-                                              (GHC.GhcT m) a}+newtype InterpreterT m a = InterpreterT {+                             unInterpreterT :: ReaderT InterpreterSession (GHC.GhcT m) a+                           }     deriving (Functor, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask)  execute :: (MonadIO m, MonadMask m, Functor m)@@ -74,12 +42,11 @@           . flip runReaderT s           . unInterpreterT - instance MonadTrans InterpreterT where     lift = InterpreterT . lift . lift -runGhc_impl :: (MonadIO m, MonadThrow m, MonadMask m, Functor m) => RunGhc (InterpreterT m) a-runGhc_impl a =+runGhcImpl :: (MonadIO m, MonadThrow m, MonadMask m, Functor m) => RunGhc (InterpreterT m) a+runGhcImpl a =   InterpreterT (lift a)    `catches`    [Handler (\(e :: GHC.SourceError)  -> do@@ -91,14 +58,9 @@   where     compilationError dynFlags       = WontCompile-#if __GLASGOW_HASKELL__ >= 706       . map (GhcError . GHC.showSDoc dynFlags)-#else-      . map (GhcError . GHC.showSDoc)-#endif       . GHC.pprErrMsgBagWithLoc       . GHC.srcErrorMessages-#endif  showGhcEx :: GHC.GhcException -> String showGhcEx = flip GHC.showGhcException ""@@ -115,40 +77,29 @@         let df1 = Compat.configureDynFlags df0        (df2, extra) <- runGhc2 Compat.parseDynamicFlags df1 args-       when (not . null $ extra) $+       unless (null extra) $             throwM $ UnknownError (concat [ "flags: '"-                                          , intercalate " " extra+                                          , unwords extra                                           , "' not recognized"])         -- Observe that, setSessionDynFlags loads info on packages        -- available; calling this function once is mandatory!        _ <- runGhc1 GHC.setSessionDynFlags df2{GHC.log_action = log_handler} -#if __GLASGOW_HASKELL__ >= 700-#if __GLASGOW_HASKELL__ >= 702 #if __GLASGOW_HASKELL__ >= 710        let extMap      = map (\fs -> (GHC.flagSpecName fs, GHC.flagSpecFlag fs)) GHC.xFlags-#elif __GLASGOW_HASKELL__ >= 704-       let extMap      = map (\(a,b,_) -> (a,b)) GHC.xFlags #else-       let extMap      = map (\(a,_,b,_) -> (a,b)) GHC.xFlags-#endif-#else        let extMap      = map (\(a,b,_) -> (a,b)) GHC.xFlags #endif        let toOpt e     = let err = error ("init error: unknown ext:" ++ show e)                          in fromMaybe err (lookup e extMap)        let getOptVal e = (asExtension e, GHC.xopt (toOpt e) df2)        let defExts = map  getOptVal Compat.supportedExtensions-#else-       let defExts = zip availableExtensions (repeat False)-#endif         onState (\s -> s{defaultExts = defExts})         reset - -- | Executes the interpreter. Returns @Left InterpreterError@ in case of error. -- -- NB. The underlying ghc will overwrite certain signal handlers@@ -169,22 +120,13 @@ runInterpreterWithArgs args action =   ifInterpreterNotRunning $     do s <- newInterpreterSession `MC.catch` rethrowGhcException-       -- SH.protectHandlers $ execute s (initialize args >> action)        execute s (initialize args >> action `finally` cleanSession)     where rethrowGhcException   = throwM . GhcException . showGhcEx-#if __GLASGOW_HASKELL__ < 610-          newInterpreterSession =  do s <- liftIO $-                                             Compat.newSession GHC.Paths.libdir-                                      newSessionData s-          cleanSession = cleanPhantomModules -- clean ghc session, too?-#else-          -- GHC >= 610           newInterpreterSession = newSessionData ()           cleanSession =                do cleanPhantomModules                   runGhc $ do dflags <- GHC.getSessionDynFlags                               GHC.defaultCleanupHandler dflags (return ())-#endif  {-# NOINLINE uniqueToken #-} uniqueToken :: MVar ()@@ -195,7 +137,7 @@     do maybe_token <- liftIO $ tryTakeMVar uniqueToken        case maybe_token of            Nothing -> throwM MultipleInstancesNotAllowed-           Just x  -> action `finally` (liftIO $ putMVar uniqueToken x)+           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@@ -209,20 +151,21 @@              "can't safely run two instances of the interpreter simultaneously"  initialState :: InterpreterState-initialState = St {active_phantoms      = [],-                   zombie_phantoms      = [],-                   hint_support_module  = error "No support module loaded!",-                   import_qual_hack_mod = Nothing,-                   qual_imports         = [],+initialState = St {+                   activePhantoms      = [],+                   zombiePhantoms      = [],+                   hintSupportModule  = error "No support module loaded!",+                   importQualHackMod = Nothing,+                   qualImports         = [],                    defaultExts          = error "defaultExts missing!",-                   configuration        = defaultConf}-+                   configuration        = defaultConf+                  }  newSessionData :: MonadIO m => a -> m (SessionData a) newSessionData  a =     do initial_state    <- liftIO $ newIORef initialState        ghc_err_list_ref <- liftIO $ newIORef []-       return SessionData{+       return SessionData {          internalState   = initial_state,          versionSpecific = a,          ghcErrListRef   = ghc_err_list_ref,@@ -230,14 +173,8 @@        }  mkLogHandler :: IORef [GhcError] -> GhcErrLogger-mkLogHandler r =-#if __GLASGOW_HASKELL__ < 706-  \_ src style msg ->-    let renderErrMsg = Compat.showSDoc ()-#else-  \df _ src style msg ->-    let renderErrMsg = Compat.showSDoc df-#endif+mkLogHandler r df _ src style msg =+    let renderErrMsg = GHC.showSDoc df         errorEntry = mkGhcError renderErrMsg src style msg     in modifyIORef r (errorEntry :) @@ -246,19 +183,16 @@     where niceErrMsg = render . GHC.withPprStyle style $                          Compat.mkLocMessage src_span msg - -- The MonadInterpreter instance  instance (MonadIO m, MonadMask m, Functor m) => MonadInterpreter (InterpreterT m) where     fromSession f = InterpreterT $ fmap f ask     --     modifySessionRef target f =-        do ref     <- fromSession target-           old_val <- liftIO $ atomicModifyIORef ref (\a -> (f a, a))-           return old_val+        do ref <- fromSession target+           liftIO $ atomicModifyIORef ref (\a -> (f a, a))     ---    runGhc a = runGhc_impl a-+    runGhc = runGhcImpl  instance (Monad m, Applicative m) => Applicative (InterpreterT m) where     pure  = return
src/Hint/Parsers.hs view
@@ -1,6 +1,4 @@-module Hint.Parsers--where+module Hint.Parsers where  import Prelude hiding(span) @@ -26,8 +24,8 @@        buf <- Compat.stringToStringBuffer expr        --        -- ghc >= 7 panics if noSrcLoc is given-       let srcLoc = Compat.mkSrcLoc (GHC.fsLit "<hint>") 1 1-       let parse_res = GHC.unP parser (Compat.mkPState dyn_fl buf srcLoc)+       let srcLoc = GHC.mkRealSrcLoc (GHC.fsLit "<hint>") 1 1+       let parse_res = GHC.unP parser (GHC.mkPState dyn_fl buf srcLoc)        --        case parse_res of            GHC.POk{}            -> return ParseOk@@ -50,15 +48,9 @@                           do -- parsing failed, so we report it just as all                              -- other errors get reported....                              logger <- fromSession ghcErrLogger-#if __GLASGOW_HASKELL__ >= 706                              dflags <- runGhc GHC.getSessionDynFlags                              let logger'  = logger dflags                                  errStyle = GHC.defaultErrStyle dflags-#else-                             let logger'  = logger-                                 errStyle = GHC.defaultErrStyle--#endif                              liftIO $ logger' GHC.SevError                                               span                                               errStyle
src/Hint/Reflection.hs view
@@ -1,18 +1,13 @@ module Hint.Reflection (-       ModuleElem(..), Id, name, children,       getModuleExports,--)--where+) where  import Data.List import Data.Maybe  import Hint.Base import qualified Hint.GHC as GHC-import qualified Hint.Compat as Compat  -- | An Id for a class, a type constructor, a data constructor, a binding, etc type Id = String@@ -30,7 +25,6 @@ children (Class _ ms)  = ms children (Data  _ dcs) = dcs - -- | Gets an abstract representation of all the entities exported by the module. --   It is similar to the @:browse@ command in GHCi. getModuleExports :: MonadInterpreter m => ModuleName -> m [ModuleElem]@@ -46,18 +40,13 @@ asModElemList df xs = concat [                         cs',                         ts',-                        ds \\ (concatMap (map Fun . children) ts'),-                        fs \\ (concatMap (map Fun . children) cs')+                        ds \\ concatMap (map Fun . children) ts',+                        fs \\ concatMap (map Fun . children) cs'                       ]     where (cs,ts,ds,fs) =            (-#if __GLASGOW_HASKELL__ < 704-             [asModElem df c | c@GHC.AClass{}   <- xs],-             [asModElem df t | t@GHC.ATyCon{}   <- xs],-#else              [asModElem df c | c@(GHC.ATyCon c')   <- xs, GHC.isClassTyCon c'],              [asModElem df t | t@(GHC.ATyCon c')   <- xs, (not . GHC.isClassTyCon) c'],-#endif #if __GLASGOW_HASKELL__ < 708              [asModElem df d | d@GHC.ADataCon{} <- xs], #else@@ -67,8 +56,7 @@            )           cs' = [Class n $ filter (alsoIn fs) ms  | Class n ms  <- cs]           ts' = [Data  t $ filter (alsoIn ds) dcs | Data  t dcs <- ts]-          alsoIn es = (`elem` (map name es))-+          alsoIn es = (`elem` map name es)  asModElem :: GHC.DynFlags -> GHC.TyThing -> ModuleElem asModElem df (GHC.AnId f)      = Fun $ getUnqualName df f@@ -77,18 +65,11 @@ #else asModElem df (GHC.AConLike (GHC.RealDataCon dc)) = Fun $ getUnqualName df dc #endif-#if __GLASGOW_HASKELL__ < 704-asModElem df(GHC.ATyCon tc)   = Data  (getUnqualName df tc)-                                      (map (getUnqualName df) $ GHC.tyConDataCons tc)-asModElem df (GHC.AClass c)    = Class (getUnqualName df c)-                                      (map (getUnqualName df) $ GHC.classMethods c)-#else asModElem df (GHC.ATyCon tc)   =   if GHC.isClassTyCon tc   then Class (getUnqualName df tc) (map (getUnqualName df) $ (GHC.classMethods . fromJust . GHC.tyConClass_maybe) tc)   else Data  (getUnqualName df tc) (map (getUnqualName df) $ GHC.tyConDataCons tc) asModElem _ _ = error "asModElem: can't happen!"-#endif  getUnqualName :: GHC.NamedThing a => GHC.DynFlags -> a -> String-getUnqualName dfs = Compat.showSDocUnqual dfs . GHC.pprParenSymName+getUnqualName dfs = GHC.showSDocUnqual dfs . GHC.pprParenSymName
− src/Hint/Sandbox.hs
@@ -1,74 +0,0 @@-module Hint.Sandbox ( sandboxed ) where--import Hint.Base-import Hint.Context-import Hint.Configuration-import Hint.Util--import {-# SOURCE #-} Hint.Typecheck ( typeChecks_unsandboxed )--import Control.Monad.Catch--sandboxed :: MonadInterpreter m => (Expr -> m a) -> (Expr -> m a)-sandboxed = if ghcVersion >= 610 then id else old_sandboxed--old_sandboxed :: MonadInterpreter m => (Expr -> m a) -> (Expr -> m a)-old_sandboxed do_stuff = \expr -> do no_sandbox <- fromConf all_mods_in_scope-                                     if no_sandbox-                                       then do_stuff expr-                                       else usingAModule do_stuff expr--usingAModule :: MonadInterpreter m => (Expr -> m a) -> (Expr -> m a)-usingAModule do_stuff_on = \expr ->-       ---       -- To avoid defaulting, we will evaluate this expression without the-       -- monomorphism-restriction. This means that expressions that normally-       -- would not typecheck, suddenly will. Thus, we first check if the-       -- expression typechecks as is. If it doesn't, there is no need in-       -- going on (if it does, it may not typecheck once we restrict the-       -- context; that is the whole idea of this!)-       ---    do type_checks <- typeChecks_unsandboxed expr-       case type_checks of-         False -> do_stuff_on expr -- fail as you wish...-         True  ->-             do (loaded, imports) <- allModulesInContext-                zombies           <- fromState zombie_phantoms-                quals             <- fromState qual_imports-                ---                let e = safeBndFor expr-                let mod_text no_prel mod_name = textify [-                     ["{-# LANGUAGE NoMonomorphismRestriction #-}"],-                     ["{-# LANGUAGE NoImplicitPrelude #-}" | no_prel],-                     ["module " ++ mod_name],-                     ["where"],-                     ["import " ++ m | m <- loaded ++ imports,-                                       not $ m `elem` (map pm_name zombies)],-                     ["import qualified " ++ m ++ " as " ++ q | (m,q) <- quals],-                     [e ++ " = " ++ expr] ]-                ---                let go no_prel = do pm <- addPhantomModule (mod_text no_prel)-                                    setTopLevelModules [pm_name pm]-                                    r <- do_stuff_on e-                                          `catchIE` (\err ->-                                             case err of-                                               WontCompile _ ->-                                                      do removePhantomModule pm-                                                         throwM err-                                               _ -> throwM err)-                                    removePhantomModule pm-                                    return r-                -- If the Prelude was not explicitly imported but implicitly-                -- imported in some interpreted module, then the user may-                -- get very unintuitive errors when turning sandboxing on. Thus-                -- we will import the Prelude if the operation fails...-                -- I guess this may lead to even more obscure errors, but-                -- hopefully in much less frequent situations...-                r <- onAnEmptyContext $ go True-                      `catchIE` (\err -> case err of-                                           WontCompile _ -> go False-                                           _             -> throwM err)-                ---                return r-           ---           where textify    = unlines . concat
− src/Hint/SignalHandlers.hs
@@ -1,40 +0,0 @@-module Hint.SignalHandlers (-    protectHandlers-)-where--import Control.Monad.Catch-import Control.Monad.Trans--#ifdef mingw32_HOST_OS-import GHC.ConsoleHandler as C--saveHandlers :: MonadIO m => m C.Handler-saveHandlers = liftIO $ C.installHandler Ignore--restoreHandlers :: MonadIO m => C.Handler -> m C.Handler-restoreHandlers = liftIO . C.installHandler--#else-import qualified System.Posix.Signals as S--helper :: MonadIO 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 :: MonadIO m => m [S.Handler]-saveHandlers = liftIO $ mapM (helper S.Ignore) signals--restoreHandlers :: MonadIO m => [S.Handler] -> m [S.Handler]-restoreHandlers h  = liftIO . sequence $ zipWith helper h signals--#endif--protectHandlers :: (MonadIO m, MonadMask m) => m a -> m a-protectHandlers a = bracket saveHandlers restoreHandlers $ const a
src/Hint/Typecheck.hs view
@@ -1,28 +1,18 @@ module Hint.Typecheck (-       typeOf, typeChecks, kindOf,--      typeOf_unsandboxed, typeChecks_unsandboxed--)--where+) where  import Control.Monad.Catch  import Hint.Base import Hint.Parsers import Hint.Conversions-import Hint.Sandbox  import qualified Hint.Compat as Compat  -- | Returns a string representation of the type of the expression. typeOf :: MonadInterpreter m => String -> m String-typeOf = sandboxed typeOf_unsandboxed--typeOf_unsandboxed :: MonadInterpreter m => String -> m String-typeOf_unsandboxed expr =+typeOf expr =     do -- First, make sure the expression has no syntax errors,        -- for this is the only way we have to "intercept" this        -- kind of errors@@ -34,30 +24,26 @@  -- | Tests if the expression type checks. typeChecks :: MonadInterpreter m => String -> m Bool-typeChecks = sandboxed typeChecks_unsandboxed--typeChecks_unsandboxed :: MonadInterpreter m => String -> m Bool-typeChecks_unsandboxed expr = (typeOf_unsandboxed expr >> return True)+typeChecks expr = (typeOf expr >> return True)                               `catchIE`                               onCompilationError (\_ -> return False)  -- | Returns a string representation of the kind of the type expression. kindOf :: MonadInterpreter m => String -> m String-kindOf = sandboxed go-    where go type_expr =-              do -- First, make sure the expression has no syntax errors,-                 -- for this is the only way we have to "intercept" this-                 -- kind of errors-                 failOnParseError parseType type_expr-                 ---                 kind <- mayFail $ runGhc1 Compat.typeKind type_expr-                 ---                 kindToString (Compat.Kind kind)+kindOf type_expr =+    do -- First, make sure the expression has no syntax errors,+       -- for this is the only way we have to "intercept" this+       -- kind of errors+       failOnParseError parseType type_expr+       --+       kind <- mayFail $ runGhc1 Compat.typeKind type_expr+       --+       kindToString (Compat.Kind kind)  onCompilationError :: MonadInterpreter m                    => ([GhcError] -> m a)                    -> (InterpreterError -> m a)-onCompilationError recover =-    \interp_error -> case interp_error of-                       WontCompile errs -> recover errs-                       otherErr         -> throwM otherErr+onCompilationError recover interp_error+    = case interp_error of+          WontCompile errs -> recover errs+          otherErr         -> throwM otherErr
− src/Hint/Typecheck.hs-boot
@@ -1,5 +0,0 @@-module Hint.Typecheck where--import Hint.Base (MonadInterpreter)--typeChecks_unsandboxed :: MonadInterpreter m => String -> m Bool
src/Hint/Util.hs view
@@ -14,7 +14,7 @@ safeBndFor expr = "e_1" ++ filter isDigit expr  partition :: (a -> Bool) -> [a] -> ([a], [a])-partition prop xs = foldr (select prop) ([],[]) xs+partition prop = foldr (select prop) ([],[])     where select p x ~(ts,fs) | p x       = (x:ts,fs)                               | otherwise = (ts, x:fs) @@ -22,7 +22,6 @@ partitionEither [] = ([],[]) partitionEither (Left  a:xs) = let (ls,rs) = partitionEither xs in (a:ls,rs) partitionEither (Right b:xs) = let (ls,rs) = partitionEither xs in (ls,b:rs)-  infixr 1 >=> (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
src/Language/Haskell/Interpreter.hs view
@@ -17,11 +17,9 @@     -- ** Interpreter options      Option, OptionVal((:=)),      get, set,-     languageExtensions, availableExtensions, glasgowExtensions, Extension(..),+     languageExtensions, availableExtensions, Extension(..),      installedModulesInScope, searchPath, -     setUseLanguageExtensions,-     setInstalledModsAreInScopeQualified,     -- ** Context handling      ModuleName, isModuleInterpreted,      loadModules, getLoadedModules, setTopLevelModules,@@ -30,15 +28,11 @@     -- ** Module querying      ModuleElem(..), Id, name, children,      getModuleExports,-#if __GLASGOW_HASKELL__ >= 611     -- ** Anotations-    -- | Please note below that annotations are an experimental-    -- feature in GHC HEAD.     -- In the snippets below we use \'LBRACE\' and \'RBRACE\'     -- to mean \'{\' and \'}\' respectively. We cannot put the     -- pragmas inline in the code since GHC scarfs them up.     getModuleAnnotations, getValAnnotations,-#endif     -- ** Type inference      typeOf, typeChecks, kindOf,     -- ** Evaluation@@ -47,14 +41,11 @@      InterpreterError(..), GhcError(..), MultipleInstancesNotAllowed(..),     -- * Miscellaneous      ghcVersion,parens,-     module Control.Monad.Trans)--where+     module Control.Monad.Trans+) where  import Hint.Base-#if __GLASGOW_HASKELL__ >= 611 import Hint.Annotations-#endif import Hint.InterpreterT import Hint.Configuration import Hint.Context
src/Language/Haskell/Interpreter/Extension.hs view
@@ -1,5 +1,5 @@-module Language.Haskell.Interpreter.Extension ( module Hint.Extension )--where+module Language.Haskell.Interpreter.Extension (+      module Hint.Extension+) where  import Hint.Extension
− src/Language/Haskell/Interpreter/GHC.hs
@@ -1,13 +0,0 @@--------------------------------------------------------------------------------- |--- DEPRECATED: use @Language.Haskell.Interpreter.Unsafe@ instead.-------------------------------------------------------------------------------module Language.Haskell.Interpreter.GHC-{-# DEPRECATED "Import Language.Haskell.Interpreter instead." #-}-(-    module Language.Haskell.Interpreter-)--where--import Language.Haskell.Interpreter
− src/Language/Haskell/Interpreter/GHC/Unsafe.hs
@@ -1,13 +0,0 @@--------------------------------------------------------------------------------- |--- DEPRECATED: use @Language.Haskell.Interpreter.Unsafe@ instead.-------------------------------------------------------------------------------module Language.Haskell.Interpreter.GHC.Unsafe-{-# DEPRECATED "Import Language.Haskell.Interpreter.Unsafe instead." #-}-(-    module Language.Haskell.Interpreter.Unsafe-)--where--import Language.Haskell.Interpreter.Unsafe
src/Language/Haskell/Interpreter/Unsafe.hs view
@@ -1,8 +1,6 @@ module Language.Haskell.Interpreter.Unsafe (     unsafeSetGhcOption, unsafeRunInterpreterWithArgs-)--where+) where  import Control.Monad.Trans import Control.Monad.Catch
unit-tests/run-unit-tests.hs view
@@ -5,7 +5,7 @@ import Control.Exception.Extensible ( ArithException(..) ) import Control.Monad.Catch as MC -import Control.Monad       ( liftM, when )+import Control.Monad       ( liftM, when, void )  import Control.Concurrent ( forkIO ) import Control.Concurrent.MVar@@ -15,7 +15,6 @@ import System.Directory import System.Exit - import Test.HUnit ( (@?=), (@?) ) import qualified Test.HUnit as HUnit @@ -45,8 +44,7 @@           --           get_f    =  do loadModules [mod_file]                          setTopLevelModules [mod_name]-                         r <- interpret "f" (as :: Int -> Int)-                         return r+                         interpret "f" (as :: Int -> Int)  test_lang_exts :: TestCase test_lang_exts = TestCase "lang_exts" [mod_file] $ do@@ -114,9 +112,9 @@ test_eval_layout :: TestCase test_eval_layout = TestCase "eval_layout" [] $ do                            eval layout_expr @@?= "10"-    where layout_expr = unlines $ ["let x = let y = 10",-                                   "        in y",-                                   "in x"]+    where layout_expr = unlines ["let x = let y = 10",+                                 "        in y",+                                 "in x"]  test_show_in_scope :: TestCase test_show_in_scope = TestCase "show_in_scope" [] $ do@@ -171,7 +169,6 @@                                   "y :: Bool",                                   "y = False"] - test_search_path_dot :: TestCase test_search_path_dot =     TestCase "search_path_dot" [mod_file, dir] $ do@@ -187,7 +184,6 @@                         writeFile mod_file $                            unlines ["x :: Int", "x = 42"] - test_catch :: TestCase test_catch = TestCase "catch" [] $ do         setImports ["Prelude"]@@ -197,7 +193,6 @@           action = do s <- eval "1 `div` 0 :: Int"                       return $! s - test_only_one_instance :: TestCase test_only_one_instance = TestCase "only_one_instance" [] $ do     liftIO $ do@@ -206,10 +201,9 @@                           `catch` \MultipleInstancesNotAllowed ->                                     do liftIO $ putMVar r True                                        return $ Right ()-        _ <- forkIO $ concurrent >> return ()+        _ <- forkIO $ Control.Monad.void concurrent         readMVar r @?  "concurrent instance did not fail" - tests :: [TestCase] tests = [test_reload_modified         ,test_lang_exts@@ -242,7 +236,7 @@        -- `catch` (\_ -> exitWith (ExitFailure $ -1))  printInterpreterError :: InterpreterError -> IO ()-printInterpreterError = hPutStrLn stderr . show+printInterpreterError = hPrint stderr  setSandbox :: Interpreter () setSandbox = set [installedModulesInScope := False]@@ -264,7 +258,6 @@  succeeds :: (MonadCatch m, MonadIO m) => m a -> m Bool succeeds = liftM not . fails-  data TestCase = TestCase String [FilePath] (Interpreter ())