diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,13 @@ -### 0.9.0.5 +### 0.9.0.6 +* Fixes the 0.9.0.5 regression +* Small fix in documentation (thanks to Ed Behn) + +### 0.9.0.5 (deprecated) + * Support GHC 9.2.1 +* Deprecated because it breaks the common pattern of using + 'unsafeRunInterpreterWithArgs' to load a custom package database. ### 0.9.0.4 diff --git a/hint.cabal b/hint.cabal --- a/hint.cabal +++ b/hint.cabal @@ -1,5 +1,5 @@ name: hint -version: 0.9.0.5 +version: 0.9.0.6 description: This library defines an Interpreter monad. It allows to load Haskell modules, browse them, type-check and evaluate strings with Haskell @@ -9,7 +9,7 @@ It is, essentially, a huge subset of the GHC API wrapped in a simpler API. -synopsis: Runtime Haskell interpreter (GHC API wrapper) +synopsis: A Haskell interpreter built on top of the GHC API category: Language, Compilers/Interpreters license: BSD3 license-file: LICENSE @@ -37,12 +37,15 @@ default-language: Haskell2010 build-depends: base == 4.*, + bytestring, hint, HUnit, directory, filepath, exceptions >= 0.10.0, stm, + text, + typed-process, -- packages used by setImports calls containers diff --git a/src/Hint/InterpreterT.hs b/src/Hint/InterpreterT.hs --- a/src/Hint/InterpreterT.hs +++ b/src/Hint/InterpreterT.hs @@ -77,8 +77,6 @@ -> InterpreterT m () initialize args = do logger <- fromSession ghcLogger - runGhc $ GHC.modifyLogger (const logger) - -- Set a custom log handler, to intercept error messages :S df0 <- runGhc GHC.getSessionDynFlags @@ -91,6 +89,7 @@ -- Observe that, setSessionDynFlags loads info on packages -- available; calling this function once is mandatory! + runGhc $ GHC.modifyLogger (const logger) _ <- runGhc $ GHC.setSessionDynFlags df2 let extMap = [ (GHC.flagSpecName flagSpec, GHC.flagSpecFlag flagSpec) diff --git a/src/Hint/Typecheck.hs b/src/Hint/Typecheck.hs --- a/src/Hint/Typecheck.hs +++ b/src/Hint/Typecheck.hs @@ -23,8 +23,8 @@ -- | Tests if the expression type checks. -- --- NB. Be careful if there is `-fdefer-type-errors` involved. --- Perhaps unsurprisingly, that can falsely make @typeChecks@ and @getType@ +-- NB. Be careful if @unsafeSetGhcOption "-fdefer-type-errors"@ is used. +-- Perhaps unsurprisingly, that can falsely make @typeChecks@ and @typeChecksWithDetails@ -- return @True@ and @Right _@ respectively. typeChecks :: MonadInterpreter m => String -> m Bool typeChecks expr = (True <$ typeOf expr) diff --git a/src/Language/Haskell/Interpreter.hs b/src/Language/Haskell/Interpreter.hs --- a/src/Language/Haskell/Interpreter.hs +++ b/src/Language/Haskell/Interpreter.hs @@ -1,14 +1,3 @@ ------------------------------------------------------------------------------ --- | --- Module : Language.Haskell.Interpreter --- License : BSD-style --- --- Maintainer : mvdan@mvdan.cc --- Stability : experimental --- Portability : non-portable (GHC API) --- --- A Haskell interpreter built on top of the GHC API ------------------------------------------------------------------------------ module Language.Haskell.Interpreter( -- * The interpreter monad transformer MonadInterpreter(..), InterpreterT, Interpreter, diff --git a/unit-tests/run-unit-tests.hs b/unit-tests/run-unit-tests.hs --- a/unit-tests/run-unit-tests.hs +++ b/unit-tests/run-unit-tests.hs @@ -11,12 +11,18 @@ import Control.Concurrent.MVar import Control.Concurrent.STM +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Data.Function ((&)) import Data.IORef import System.IO import System.FilePath import System.Directory +import System.Environment (getEnvironment, unsetEnv) import System.Exit +import System.Process.Typed #if defined(mingw32_HOST_OS) || defined(__MINGW32__) #else import System.Posix.Signals @@ -26,6 +32,7 @@ import qualified Test.HUnit as HUnit import Language.Haskell.Interpreter +import Language.Haskell.Interpreter.Unsafe test_reload_modified :: TestCase test_reload_modified = TestCase "reload_modified" [mod_file] $ do @@ -291,6 +298,63 @@ ,"type instance Foo x = ()"] mod_file = "TEST_NormalizeType.hs" +test_package_db :: IOTestCase +test_package_db = IOTestCase "package_db" [dir] $ \wrapInterp -> do + setup + ghcVersionOutput <- readProcessStdout_ $ proc "ghc" ["--version"] + let ghcVersion + :: String + ghcVersion + = ghcVersionOutput + -- "The Glorious Glasgow Haskell Compilation System, version 8.8.4" :: ByteString.Lazy + & ByteString.toStrict + -- "The Glorious Glasgow Haskell Compilation System, version 8.8.4" :: ByteString + & Text.decodeUtf8 + -- "The Glorious Glasgow Haskell Compilation System, version 8.8.4" :: Text + & Text.unpack + -- "The Glorious Glasgow Haskell Compilation System, version 8.8.4" :: String + & words + -- ["The","Glorious","Glasgow","Haskell","Compilation","System,","version","8.8.4"] + & last + -- "8.8.4" + let pkgdb = dir "dist-newstyle" "packagedb" ("ghc-" ++ ghcVersion) + ghc_args = ["-package-db=" ++ pkgdb] + + -- stack sets GHC_ENVIRONMENT to a file which pins down the versions of + -- all the packages we can load, and since it does not list my-package, + -- we cannot load it. + unsetEnv "GHC_ENVIRONMENT" + + wrapInterp (unsafeRunInterpreterWithArgs ghc_args) $ do + --succeeds (setImports [mod]) @@? "module from package-db must be visible" + setImports [mod] + -- + where pkg = "my-package" + dir = pkg + mod_file = dir mod <.> "hs" + mod = "MyModule" + cabal_file = dir pkg <.> "cabal" + setup = do createDirectory dir + writeFile cabal_file $ unlines + [ "cabal-version: 2.4" + , "name: " ++ pkg + , "version: 0.1.0.0" + , "" + , "library" + , " exposed-modules: " ++ mod + ] + writeFile mod_file $ unlines + [ "{-# LANGUAGE NoImplicitPrelude #-}" + , "module " ++ mod ++ " where" + ] + env <- getEnvironment + runProcess_ + $ setWorkingDir dir + $ -- stack sets GHC_PACKAGE_PATH, but cabal complains + -- that it cannot run if that variable is set. + setEnv (filter ((/= "GHC_PACKAGE_PATH") . fst) env) + $ proc "cabal" ["build"] + -- earlier versions of hint were accidentally overwriting the signal handlers -- for ^C and others. -- @@ -299,9 +363,9 @@ -- succeeds when executed from ghci and ghcid, regardless of whether the problematic -- behaviour has been fixed or not. test_signal_handlers :: IOTestCase -test_signal_handlers = IOTestCase "signal_handlers" [] $ \runInterp -> do +test_signal_handlers = IOTestCase "signal_handlers" [] $ \wrapInterp -> do #if defined(mingw32_HOST_OS) || defined(__MINGW32__) - runInterp $ do + wrapInterp runInterpreter $ do pure () #else signalDetectedRef <- newIORef False @@ -311,7 +375,7 @@ acquire = installHandler sigINT (Catch detectSignal) Nothing release handler = installHandler sigINT handler Nothing r <- bracket acquire release $ \_ -> do - runInterp $ do + wrapInterp runInterpreter $ do liftIO $ do r <- try $ do raiseSignal sigINT @@ -357,6 +421,7 @@ ioTests :: [IOTestCase] ioTests = [test_signal_handlers + ,test_package_db ] main :: IO () @@ -406,16 +471,23 @@ noInterpreterError (Left e) = assertFailure (show e) noInterpreterError (Right a) = pure a -data IOTestCase = IOTestCase String [FilePath] ((Interpreter () -> IO (Either InterpreterError ())) -> IO (Either InterpreterError ())) +data IOTestCase = IOTestCase + String -- test name + [FilePath] -- temporary files and folders to delete after the test + ( ( (Interpreter () -> IO (Either InterpreterError ())) + -> (Interpreter () -> IO (Either InterpreterError ())) + ) -- please wrap your 'runInterpreter' calls with this + -> IO (Either InterpreterError ()) -- create temporary files and run the test + ) runIOTests :: Bool -> [IOTestCase] -> IO HUnit.Counts runIOTests sandboxed = HUnit.runTestTT . HUnit.TestList . map build - where build (IOTestCase title tmps test) = HUnit.TestLabel title $ - HUnit.TestCase test_case + where build (IOTestCase title tmps test) + = HUnit.TestLabel title $ HUnit.TestCase test_case where test_case = go `finally` clean_up clean_up = mapM_ removeIfExists tmps - go = do r <- test (\body -> runInterpreter - (when sandboxed setSandbox >> body)) + wrapInterp runInterp body = runInterp (when sandboxed setSandbox >> body) + go = do r <- test wrapInterp noInterpreterError r removeIfExists f = do existsF <- doesFileExist f if existsF @@ -423,12 +495,16 @@ else do existsD <- doesDirectoryExist f when existsD $ - removeDirectory f + removeDirectoryRecursive f -data TestCase = TestCase String [FilePath] (Interpreter ()) +data TestCase = TestCase + String -- test name + [FilePath] -- temporary files and folders to delete after the test + (Interpreter ()) -- create temporary files and run the test runTests :: Bool -> [TestCase] -> IO HUnit.Counts runTests sandboxed = runIOTests sandboxed . map toIOTestCase where toIOTestCase :: TestCase -> IOTestCase - toIOTestCase (TestCase title tmps test) = IOTestCase title tmps ($ test) + toIOTestCase (TestCase title tmps test) = IOTestCase title tmps $ \wrapInterp -> do + wrapInterp runInterpreter test