diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +### 0.9.0.4 + +* Support GHC 9.0.1 + ### 0.9.0.3 * Support GHC 8.10 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,4 @@ -# hint - -[![Build Status](https://travis-ci.com/haskell-hint/hint.svg?branch=master)](https://travis-ci.com/haskell-hint/hint) -[![Hackage](https://img.shields.io/hackage/v/hint.svg)](https://hackage.haskell.org/package/hint) +# hint [![Hackage](https://img.shields.io/hackage/v/hint.svg)](https://hackage.haskell.org/package/hint) [![Build Status](https://github.com/haskell-hint/hint/workflows/CI/badge.svg)](https://github.com/haskell-hint/hint/actions) This library defines an Interpreter monad within which you can interpret strings like `"[1,2] ++ [3]"` into values like `[1,2,3]`. You can easily @@ -16,13 +13,10 @@ ## Limitations -It is possible to run the interpreter inside a thread, but you can't run two -instances of the interpreter simlutaneously. +It is possible to run the interpreter inside a thread, but on GHC 8.8 and +below, you can't run two instances of the interpreter simultaneously. GHC must be installed on the system on which the compiled executable is running. - -Compatibility is kept with the three last major GHC releases. For example, if -the current version is GHC 8.6, `hint` will work on 8.6, 8.4 and 8.2. ## Example diff --git a/hint.cabal b/hint.cabal --- a/hint.cabal +++ b/hint.cabal @@ -1,5 +1,5 @@ name: hint -version: 0.9.0.3 +version: 0.9.0.4 description: This library defines an Interpreter monad. It allows to load Haskell modules, browse them, type-check and evaluate strings with Haskell @@ -14,10 +14,10 @@ license: BSD3 license-file: LICENSE author: The Hint Authors -maintainer: mvdan@mvdan.cc +maintainer: "Samuel Gélineau" homepage: https://github.com/haskell-hint/hint -cabal-version: >= 1.9.2 +cabal-version: >= 1.10 build-type: Simple extra-source-files: README.md @@ -34,6 +34,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: unit-tests main-is: run-unit-tests.hs + default-language: Haskell2010 build-depends: base == 4.*, hint, @@ -54,11 +55,12 @@ build-depends: unix >= 2.2.0.0 } - extensions: CPP + default-extensions: CPP library + default-language: Haskell2010 build-depends: base == 4.*, - ghc >= 8.4 && < 8.11, + ghc >= 8.4 && < 9.2, ghc-paths, ghc-boot, transformers, @@ -99,12 +101,12 @@ hs-source-dirs: src ghc-options: -Wall - extensions: CPP - GeneralizedNewtypeDeriving - DeriveDataTypeable - MagicHash - FunctionalDependencies - Rank2Types - ScopedTypeVariables - ExistentialQuantification - LambdaCase + default-extensions: CPP + GeneralizedNewtypeDeriving + DeriveDataTypeable + MagicHash + FunctionalDependencies + Rank2Types + ScopedTypeVariables + ExistentialQuantification + LambdaCase diff --git a/src/Control/Monad/Ghc.hs b/src/Control/Monad/Ghc.hs --- a/src/Control/Monad/Ghc.hs +++ b/src/Control/Monad/Ghc.hs @@ -14,11 +14,19 @@ import Data.IORef import qualified GHC +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Utils.Monad as GHC +import qualified GHC.Utils.Exception as GHC +import qualified GHC.Driver.Monad as GHC + +import qualified GHC.Driver.Session as GHC +#else import qualified MonadUtils as GHC import qualified Exception as GHC import qualified GhcMonad as GHC import qualified DynFlags as GHC +#endif newtype GhcT m a = GhcT { unGhcT :: GHC.GhcT (MTLAdapter m) a } deriving (Functor, Monad, GHC.HasDynFlags) @@ -50,7 +58,11 @@ throwM = lift . throwM instance (MonadIO m, MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where +#if MIN_VERSION_ghc(9,0,0) + m `catch` f = GhcT (unGhcT m `catch` (unGhcT . f)) +#else m `catch` f = GhcT (unGhcT m `GHC.gcatch` (unGhcT . f)) +#endif instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where mask f = wrap $ \s -> @@ -75,9 +87,11 @@ wrap g = GhcT $ GHC.GhcT $ \s -> MTLAdapter (g s) unwrap m = unMTLA . GHC.unGhcT (unGhcT m) +#if !MIN_VERSION_ghc(9,0,0) instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (GhcT m) where gcatch = catch gmask = mask +#endif instance (Functor m, MonadIO m, MonadCatch m, MonadMask m) => GHC.GhcMonad (GhcT m) where getSession = GhcT GHC.getSession @@ -90,6 +104,22 @@ instance MonadIO m => GHC.MonadIO (MTLAdapter m) where liftIO = MTLAdapter . liftIO +#if MIN_VERSION_ghc(9,0,0) +instance MonadCatch m => MonadCatch (MTLAdapter m) where + m `catch` f = MTLAdapter $ unMTLA m `catch` (unMTLA . f) + +instance MonadMask m => MonadMask (MTLAdapter m) where + mask io = MTLAdapter $ mask (\f -> unMTLA $ io (MTLAdapter . f . unMTLA)) + uninterruptibleMask f = MTLAdapter (unMTLA (uninterruptibleMask f)) + generalBracket acquire release body + = MTLAdapter (generalBracket (unMTLA acquire) + (\a exitCase -> unMTLA (release a exitCase)) + (unMTLA . body)) + +instance MonadThrow m => MonadThrow (MTLAdapter m) where + throwM = MTLAdapter . throwM +#else 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)) +#endif diff --git a/src/Hint/Annotations.hs b/src/Hint/Annotations.hs --- a/src/Hint/Annotations.hs +++ b/src/Hint/Annotations.hs @@ -4,13 +4,20 @@ ) where import Data.Data -import Annotations import GHC.Serialized -import MonadUtils (concatMapM) import Hint.Base -import HscTypes (hsc_mod_graph, ms_mod) import qualified Hint.GHC as GHC + +#if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Types (hsc_mod_graph, ms_mod) +import GHC.Types.Annotations +import GHC.Utils.Monad (concatMapM) +#else +import Annotations +import HscTypes (hsc_mod_graph, ms_mod) +import MonadUtils (concatMapM) +#endif -- Get the annotations associated with a particular module. getModuleAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a] diff --git a/src/Hint/Configuration.hs b/src/Hint/Configuration.hs --- a/src/Hint/Configuration.hs +++ b/src/Hint/Configuration.hs @@ -70,7 +70,7 @@ -- | Retrieves the value of an option. get :: MonadInterpreter m => Option m a -> m a -get = _get +get = \o -> _get o -- | Language extensions in use by the interpreter. -- diff --git a/src/Hint/GHC.hs b/src/Hint/GHC.hs --- a/src/Hint/GHC.hs +++ b/src/Hint/GHC.hs @@ -1,10 +1,44 @@ module Hint.GHC ( Message, module X +#if MIN_VERSION_ghc(9,0,0) + , dynamicGhc +#endif ) where import GHC as X hiding (Phase, GhcT, runGhcT) import Control.Monad.Ghc as X (GhcT, runGhcT) +#if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Types as X (SourceError, srcErrorMessages, GhcApiError) +-- import GHC.Driver.Types as X (mgModSummaries) + +import GHC.Utils.Outputable as X (PprStyle, SDoc, Outputable(ppr), + showSDoc, showSDocForUser, showSDocUnqual, + withPprStyle, defaultErrStyle, vcat) + +import GHC.Utils.Error as X (mkLocMessage, pprErrMsgBagWithLoc, MsgDoc, + errMsgSpan, pprErrMsgBagWithLoc) + -- we alias MsgDoc as Message below + +import GHC.Driver.Phases as X (Phase(Cpp), HscSource(HsSrcFile)) +import GHC.Data.StringBuffer as X (stringToStringBuffer) +import GHC.Parser.Lexer as X (P(..), ParseResult(..), mkPState, + getErrorMessages) +import GHC.Parser as X (parseStmt, parseType) +import GHC.Data.FastString as X (fsLit) + +import GHC.Driver.Session as X (xFlags, xopt, LogAction, FlagSpec(..), + WarnReason(NoReason), addWay') +import GHC.Driver.Ways as X (Way (..), hostIsDynamic) + +import GHC.Core.Ppr.TyThing as X (pprTypeForUser) +import GHC.Types.SrcLoc as X (combineSrcSpans, mkRealSrcLoc) + +import GHC.Core.ConLike as X (ConLike(RealDataCon)) + +dynamicGhc :: Bool +dynamicGhc = hostIsDynamic +#else import HscTypes as X (SourceError, srcErrorMessages, GhcApiError) import HscTypes as X (mgModSummaries) @@ -35,5 +69,6 @@ import SrcLoc as X (combineSrcSpans, mkRealSrcLoc) import ConLike as X (ConLike(RealDataCon)) +#endif type Message = MsgDoc diff --git a/src/Hint/InterpreterT.hs b/src/Hint/InterpreterT.hs --- a/src/Hint/InterpreterT.hs +++ b/src/Hint/InterpreterT.hs @@ -182,7 +182,18 @@ ghcErrLogger = mkLogHandler ghc_err_list_ref } +#if MIN_VERSION_ghc(9,0,0) mkLogHandler :: IORef [GhcError] -> GhcErrLogger +mkLogHandler r df _ _ src msg = + let renderErrMsg = GHC.showSDoc df + errorEntry = mkGhcError renderErrMsg src msg + in modifyIORef r (errorEntry :) + +mkGhcError :: (GHC.SDoc -> String) -> GHC.SrcSpan -> GHC.Message -> GhcError +mkGhcError render src_span msg = GhcError{errMsg = niceErrMsg} + where niceErrMsg = render $ GHC.mkLocMessage GHC.SevError src_span msg +#else +mkLogHandler :: IORef [GhcError] -> GhcErrLogger mkLogHandler r df _ _ src style msg = let renderErrMsg = GHC.showSDoc df errorEntry = mkGhcError renderErrMsg src style msg @@ -192,6 +203,7 @@ mkGhcError render src_span style msg = GhcError{errMsg = niceErrMsg} where niceErrMsg = render . GHC.withPprStyle style $ GHC.mkLocMessage GHC.SevError src_span msg +#endif -- The MonadInterpreter instance diff --git a/src/Hint/Parsers.hs b/src/Hint/Parsers.hs --- a/src/Hint/Parsers.hs +++ b/src/Hint/Parsers.hs @@ -54,12 +54,16 @@ logger <- fromSession ghcErrLogger dflags <- runGhc GHC.getSessionDynFlags let logger' = logger dflags +#if !MIN_VERSION_ghc(9,0,0) errStyle = GHC.defaultErrStyle dflags +#endif liftIO $ logger' GHC.NoReason GHC.SevError span +#if !MIN_VERSION_ghc(9,0,0) errStyle +#endif err -- -- behave like the rest of the GHC API functions