packages feed

trace-embrace 1.1.0 → 1.2.0

raw patch · 11 files changed

+106/−128 lines, 11 filesdep ~aesondep ~basedep ~bytestring

Dependency ranges changed: aeson, base, bytestring, containers, cpphs, directory, generic-lens, ghc, haddock-use-refs, lens, radix-tree, refined, tagged, template-haskell, text, th-lock, transformers, yaml

Files

changelog.md view
@@ -1,5 +1,8 @@ # trace-embrace changelog +## Version 1.2.0 2025-06-05+  * support GHC-9.12.2+ ## Version 1.1.0 2025-06-04   * add `a`, `u` and `tg` for tracing guarded functions
src/Debug/TraceEmbrace/Config/Load.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Debug.TraceEmbrace.Config.Load where
src/Debug/TraceEmbrace/Config/Type/Mode.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveLift #-} {-# LANGUAGE OverloadedStrings #-} module Debug.TraceEmbrace.Config.Type.Mode where
src/Debug/TraceEmbrace/Config/Validation.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PolyKinds #-} module Debug.TraceEmbrace.Config.Validation where  import Data.Functor.Identity
src/Debug/TraceEmbrace/FileIndex.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE DeriveLift #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -8,25 +6,40 @@ module Debug.TraceEmbrace.FileIndex where  import Data.IntMap.Strict qualified as IM-import Data.String-import GHC.Data.Bag-import GHC.Data.FastString-import GHC.Data.StringBuffer-import GHC.Driver.Config.Parser-import GHC.Driver.DynFlags-import GHC.Parser-import GHC.Parser.Annotation-import GHC.Parser.Lexer hiding (buffer)-import GHC.Tc.Types-import GHC.Types.Name hiding (Name)-import GHC.Types.Name.Reader+import Data.String ( IsString )+import GHC.Data.FastString ( mkFastString )+import GHC.Data.StringBuffer ( stringToStringBuffer )+import GHC.Driver.Config.Parser ( initParserOpts )+import GHC.Driver.DynFlags ( HasDynFlags(..) )+import GHC.Exts (IsList (toList))+import GHC.Hs.Extension (GhcPs)+import GHC.Parser ( parseModule )+import GHC.Parser.Lexer+    ( ParserOpts,+      P(unP),+      ParseResult(..),+      getPsErrorMessages,+      initParserState )+import GHC.Tc.Types ( TcM )+import GHC.Types.Name ( occNameString )+import GHC.Types.Name.Reader ( RdrName(Unqual) ) import GHC.Types.SrcLoc-import GHC.Utils.Outputable hiding ((<>))+    ( GenLocated(L), mkRealSrcLoc, realSrcSpanStart, srcLocLine )+import GHC.Utils.Outputable+    ( Outputable(ppr), defaultSDocContext, renderWithContext ) import Language.Haskell.Syntax import Language.Haskell.TH.Syntax (Q (..), runIO, getQ, putQ, Loc (..), Lift, reportWarning) import Language.Preprocessor.Cpphs (runCpphs, defaultCpphsOptions)-import Unsafe.Coerce+import Unsafe.Coerce ( unsafeCoerce ) +#if MIN_VERSION_base(4,21,0)+import GHC.Parser.Annotation (epaLocationRealSrcSpan, SrcSpanAnnA, EpAnn(entry, EpAnn) )+#else+import GHC.Parser.Annotation (anchor, SrcSpanAnnA, EpAnn(entry, EpAnn))+import GHC.Types.SrcLoc (EpaLocation', RealSrcSpan)+epaLocationRealSrcSpan :: EpaLocation' a -> RealSrcSpan+epaLocationRealSrcSpan = anchor+#endif  newtype FunName = FunName { unFunName :: String } deriving (Show, Eq, Ord, IsString, Lift) type LineFileIndex = IM.IntMap FunName@@ -46,6 +59,17 @@ getLineFileIndex :: Loc -> Q LineFileIndex getLineFileIndex = getLineFileIndex' . loc_filename +indexEntry :: EpAnn ann -> GenLocated l RdrName -> [(Int, FunName)]+indexEntry EpAnn {entry} = \case+  L _ fi ->+    case fi of+      Unqual s ->+          [ ( srcLocLine (realSrcSpanStart (epaLocationRealSrcSpan entry))+            , FunName $ occNameString s+            )+          ]+      _ -> []+ mkLineFunIndex :: FilePath -> Q LineFileIndex mkLineFunIndex fp = do   fileContent <- runIO (runCpphs defaultCpphsOptions fp =<< readFile fp)@@ -60,26 +84,15 @@         "\n--------------------------------------------------------------------"       pure mempty   where-    indexEntry EpAnn {entry} = \case-      L _ fi ->-        case fi of-          Unqual s ->-              [ ( srcLocLine (realSrcSpanStart (anchor entry))-                , FunName $ occNameString s-                )-              ]-          _ -> []-     methodExtract (L l (FunBind {fun_id})) = indexEntry l fun_id     methodExtract _ = []-+    extract :: GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [(IM.Key, FunName)]     extract (L l (ValD _ (FunBind {fun_id}))) = indexEntry l fun_id     extract (L _ (InstD _ (ClsInstD {cid_inst}))) =       case cid_inst of-        ClsInstDecl {cid_binds} -> concatMap methodExtract (bagToList cid_binds)-        _ -> []+        ClsInstDecl {cid_binds} -> concatMap methodExtract (toList cid_binds)     extract (L _ (TyClD _ (ClassDecl {tcdMeths}))) =-      concatMap methodExtract (bagToList tcdMeths)+      concatMap methodExtract (toList tcdMeths)     extract _ = []  runParser :: FilePath -> ParserOpts -> String -> P a -> ParseResult a
src/Debug/TraceEmbrace/Internal/Rewrap.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE FunctionalDependencies #-}  module Debug.TraceEmbrace.Internal.Rewrap where
src/Debug/TraceEmbrace/Show.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedNewtypes #-}
src/Debug/TraceEmbrace/ShowTh.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedNewtypes #-}
test/Debug/TraceEmbrace/Test/TraceEmbrace/Yaml.hs view
@@ -2,11 +2,14 @@ {-# LANGUAGE OverloadedStrings #-} module Debug.TraceEmbrace.Test.TraceEmbrace.Yaml where -import Data.Text-import Data.Yaml as Y+import Data.Text (Text, pack)+import Data.Yaml as Y ( decodeEither', encode ) import Debug.TraceEmbrace.Config.Type.Level import Test.Tasty.HUnit ((@=?)) import Test.Tasty.QuickCheck+    ( Arbitrary(arbitrary),+      UnicodeString(getUnicodeString),+      arbitraryBoundedEnum )  instance Arbitrary TraceLevel where   arbitrary = arbitraryBoundedEnum
test/Demo.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE CPP #-} -- | File combines samples which are important for FileIndex -- such us top functions, method instances and default methods@@ -6,6 +5,7 @@  #if !MIN_VERSION_base(4,8,0) #endif+   (***) :: Int -> Int -> Int
trace-embrace.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            trace-embrace-version:         1.1.0+version:         1.2.0 license:         BSD-3-Clause license-file:    LICENSE category:        Development@@ -343,30 +343,47 @@     Module:fun: 7 get; x#: 1#  tested-with:-  GHC == 9.10.1+  GHC == 9.10.1, GHC == 9.12.2 extra-doc-files:   changelog.md-library++common base+  ghc-options: -Wall+  default-language: GHC2024+  default-extensions:+    DefaultSignatures+    DuplicateRecordFields+    FunctionalDependencies+    MagicHash+    OverloadedLabels+    TemplateHaskell+    TypeFamilyDependencies   build-depends:-    aeson < 3.0,+    aeson < 3,     base < 5,-    bytestring > 0.11 && < 0.12.3,+    bytestring >= 0.11 && < 0.12.3,     containers < 0.9,-    cpphs < 2.0,-    deepseq < 1.8,-    directory < 2.0,-    lens < 6.0,+    directory < 2,+    lens < 6,     lrucache < 1.3,-    generic-lens < 3.0,-    ghc < 9.12,-    haddock-use-refs < 2.0,-    radix-tree < 2.0,-    refined < 1.0,-    tagged < 1.0,-    template-haskell < 2.24.0.0,-    text < 3.0,-    transformers < 1.0,-    yaml < 0.12,+    generic-lens < 3,+    refined < 1,+    template-haskell < 2.24,+    text < 3,+    yaml < 0.12++library+  import: base+  hs-source-dirs: src+  build-depends:+    cpphs < 2,+    deepseq < 1.8,+    ghc < 9.13,+    haddock-use-refs < 2,+    radix-tree < 2,+    tagged < 1,+    transformers < 1+   exposed-modules:     Debug.TraceEmbrace     Debug.TraceEmbrace.ByteString@@ -385,31 +402,26 @@     Debug.TraceEmbrace.ShowTh     Debug.TraceEmbrace.TH -  ghc-options: -Wall-  hs-source-dirs: src-  default-language: Haskell2010-  default-extensions:-    BangPatterns-    DataKinds-    DeriveGeneric-    DeriveLift-    DisambiguateRecordFields-    DuplicateRecordFields-    FlexibleContexts-    FlexibleInstances-    ImportQualifiedPost-    LambdaCase-    MultiParamTypeClasses-    OverloadedLabels-    ScopedTypeVariables-    StandaloneDeriving-    TemplateHaskell-    TypeApplications-    TypeFamilies- test-suite test+  import: base   type: exitcode-stdio-1.0   main-is: Driver.hs+  default-extensions:+    RecordWildCards+  autogen-modules:+    Paths_trace_embrace+  hs-source-dirs:+    test+  ghc-options: -Wall -rtsopts -threaded -main-is Driver+  build-depends:+    , filepath < 1.6+    , tasty+    , tasty-discover+    , tasty-hunit+    , tasty-quickcheck+    , temporary < 1.5+    , th-lock < 1+    , trace-embrace   other-modules:     Debug.TraceEmbrace.Test.TraceEmbrace.Config     Debug.TraceEmbrace.Test.TraceEmbrace.DemoIndex@@ -425,44 +437,6 @@     Demo     Discovery     Paths_trace_embrace-  autogen-modules:-    Paths_trace_embrace-  hs-source-dirs:-    test-  default-extensions:-    BangPatterns-    DisambiguateRecordFields-    DuplicateRecordFields-    FlexibleContexts-    ImportQualifiedPost-    LambdaCase-    NamedFieldPuns-    OverloadedLabels-    RecordWildCards-    ScopedTypeVariables-    TemplateHaskell-  ghc-options: -Wall -rtsopts -threaded -main-is Driver-  build-depends:-      base-    , bytestring-    , containers-    , directory-    , filepath < 1.6-    , generic-lens-    , lens-    , lrucache < 1.3-    , refined-    , tasty-    , tasty-discover-    , tasty-hunit-    , tasty-quickcheck-    , template-haskell-    , temporary < 1.5-    , text-    , th-lock < 1.0.0-    , trace-embrace-    , yaml-  default-language: Haskell2010  source-repository head   type:     git