diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for auto-instrument +## 0.1.0.2 -- 2025-04-06 + +* Support GHC 9.10 + ## 0.1.0.1 -- 2024-03-31 * Improved messaging for TOML parsing failures diff --git a/hs-opentelemetry-instrumentation-auto.cabal b/hs-opentelemetry-instrumentation-auto.cabal --- a/hs-opentelemetry-instrumentation-auto.cabal +++ b/hs-opentelemetry-instrumentation-auto.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hs-opentelemetry-instrumentation-auto -version: 0.1.0.1 +version: 0.1.0.2 synopsis: Plugin for instrumenting an application description: A GHC plugin that auto-instruments an application for emitting open telementry tracing. license: BSD-3-Clause @@ -15,8 +15,10 @@ README.md extra-source-files: test-config.toml tested-with: + GHC == 9.8.2 GHC == 9.4.8 GHC == 9.6.2 + GHC == 9.10.1 bug-reports: https://github.com/aaronallen8455/opentelemetry-auto/issues source-repository head type: git @@ -37,14 +39,14 @@ -- other-modules: -- other-extensions: build-depends: - base >=4.17.0.0 && <4.20.0.0, - ghc >=9.4.0 && <9.9.0, + base >=4.17.0.0 && <4.22.0.0, + ghc >=9.4.0 && <9.11.0, bytestring ^>= 0.11 || ^>= 0.12, directory ^>= 1.3, - containers ^>= 0.6, + containers ^>= 0.6 || ^>= 0.7, unliftio ^>= 0.2, - hs-opentelemetry-api ^>= 0.0.3 || ^>= 0.1, - text ^>= 2.0, + hs-opentelemetry-api ^>= 0.0.3 || ^>= 0.1 || ^>= 0.2, + text ^>= 2.0 || ^>= 2.1, toml-parser >= 2.0.0.0 && < 3.0.0.0, parsec ^>= 3.1, time ^>= 1.12 @@ -60,7 +62,7 @@ hs-source-dirs: test main-is: Main.hs build-depends: - base >=4.17.0.0 && <4.20.0.0, + base >=4.17.0.0 && <4.22.0.0, unordered-containers, hs-opentelemetry-instrumentation-auto, hs-opentelemetry-exporter-in-memory, diff --git a/src/AutoInstrument/Internal/GhcFacade.hs b/src/AutoInstrument/Internal/GhcFacade.hs --- a/src/AutoInstrument/Internal/GhcFacade.hs +++ b/src/AutoInstrument/Internal/GhcFacade.hs @@ -3,9 +3,11 @@ module AutoInstrument.Internal.GhcFacade ( module Ghc , mkParseError + , noAnn' + , getSrcSpan' ) where -#if MIN_VERSION_ghc(9,6,0) +#if MIN_VERSION_ghc(9,10,0) import GHC.Plugins as Ghc hiding (getHscEnv, putMsg, fatalErrorMsg, errorMsg, debugTraceMsg) import GHC.Fingerprint as Ghc import GHC.Iface.Env as Ghc @@ -14,11 +16,25 @@ import Language.Haskell.Syntax as Ghc import GHC.Hs as Ghc (HsParsedModule(..)) import GHC.Hs.Extension as Ghc -import GHC.Parser.Annotation as Ghc (SrcSpanAnn'(..), SrcSpanAnnA, noAnn, noSrcSpanA, realSrcSpan) +import GHC.Parser.Annotation as Ghc (EpAnn, SrcSpanAnnA, entry, noAnn, noSrcSpanA, realSrcSpan) import GHC.Parser.Errors.Types as Ghc import GHC.Types.SourceText as Ghc import GHC.Types.Error as Ghc import GHC.Utils.Error as Ghc +#elif MIN_VERSION_ghc(9,6,0) +import GHC.Plugins as Ghc hiding (getHscEnv, putMsg, fatalErrorMsg, errorMsg, debugTraceMsg) +import GHC.Fingerprint as Ghc +import GHC.Iface.Env as Ghc +import GHC.Unit.Finder as Ghc +import GHC.Driver.Main as Ghc +import Language.Haskell.Syntax as Ghc +import GHC.Hs as Ghc (HsParsedModule(..)) +import GHC.Hs.Extension as Ghc +import GHC.Parser.Annotation as Ghc (EpAnn, SrcSpanAnn'(..), SrcSpanAnnA, noAnn, noSrcSpanA, realSrcSpan) +import GHC.Parser.Errors.Types as Ghc +import GHC.Types.SourceText as Ghc +import GHC.Types.Error as Ghc +import GHC.Utils.Error as Ghc #elif MIN_VERSION_ghc(9,4,0) import GHC.Plugins as Ghc hiding (getHscEnv, putMsg, fatalErrorMsg, errorMsg, debugTraceMsg) import GHC.Fingerprint as Ghc @@ -28,7 +44,7 @@ import Language.Haskell.Syntax as Ghc import GHC.Hs as Ghc (HsParsedModule(..), HsModule(..)) import GHC.Hs.Extension as Ghc -import GHC.Parser.Annotation as Ghc (SrcSpanAnn'(..), SrcSpanAnnA, noAnn, noSrcSpanA, realSrcSpan) +import GHC.Parser.Annotation as Ghc (EpAnn, SrcSpanAnn'(..), SrcSpanAnnA, noAnn, noSrcSpanA, realSrcSpan) import GHC.Parser.Errors.Types as Ghc import GHC.Types.SourceText as Ghc import GHC.Types.Error as Ghc @@ -46,3 +62,21 @@ #endif . Ghc.mkPlainError Ghc.noHints . Ghc.text + +#if MIN_VERSION_ghc(9,10,0) +noAnn' :: Ghc.NoExtField +noAnn' = Ghc.noExtField +#else +noAnn' :: Ghc.EpAnn a +noAnn' = Ghc.noAnn +#endif + +#if MIN_VERSION_ghc(9,10,0) +getSrcSpan' :: Ghc.EpAnn ann -> SrcSpan +getSrcSpan' x = case Ghc.entry x of + EpaSpan s -> s + _ -> Ghc.noSrcSpan +#else +getSrcSpan' :: SrcSpanAnn' a -> SrcSpan +getSrcSpan' = Ghc.locA +#endif diff --git a/src/AutoInstrument/Internal/Plugin/Parser.hs b/src/AutoInstrument/Internal/Plugin/Parser.hs --- a/src/AutoInstrument/Internal/Plugin/Parser.hs +++ b/src/AutoInstrument/Internal/Plugin/Parser.hs @@ -157,11 +157,11 @@ go :: Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs go (Ghc.L loc x) = let instrVar = Ghc.HsVar Ghc.noExtField (Ghc.L Ghc.noSrcSpanA (Ghc.Exact instrName)) - mkStringExpr = Ghc.L Ghc.noSrcSpanA . Ghc.HsLit Ghc.noAnn + mkStringExpr = Ghc.L Ghc.noSrcSpanA . Ghc.HsLit Ghc.noAnn' . Ghc.HsString Ghc.NoSourceText app :: Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs - app l r = Ghc.L Ghc.noSrcSpanA $ Ghc.HsApp Ghc.noAnn l r - srcSpan = Ghc.realSrcSpan . Ghc.locA $ loc :: Ghc.RealSrcSpan + app l r = Ghc.L Ghc.noSrcSpanA $ Ghc.HsApp Ghc.noAnn' l r + srcSpan = Ghc.realSrcSpan . Ghc.getSrcSpan' $ loc :: Ghc.RealSrcSpan instr = Ghc.L Ghc.noSrcSpanA instrVar `app` @@ -175,4 +175,4 @@ `app` mkStringExpr (Ghc.unitIdFS unitId) - in Ghc.L loc $ Ghc.HsApp Ghc.noAnn instr (Ghc.L loc x) + in Ghc.L loc $ Ghc.HsApp Ghc.noAnn' instr (Ghc.L loc x) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -242,7 +242,7 @@ , ("code.filepath", AttributeValue (TextAttribute "test/Main.hs")) , ("code.function", AttributeValue (TextAttribute funName)) , ("code.namespace", AttributeValue (TextAttribute "Main")) - , ("code.package", AttributeValue (TextAttribute "main")) + , ("code.package", AttributeValue (TextAttribute "hs-opentelemetry-instrumentation-auto-0.1.0.2-inplace-auto-instrument-test")) ] }