ghc-tags-pipes 0.1.1.0 → 0.2.0.1

raw patch · 3 files changed

+107/−31 lines, 3 filesdep ~attoparsecdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec, base, bytestring, ghc-tags-core, mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• ghc-tags-pipes.cabal +9/−14
• lib/GhcTags/Stream.hs +85/−17

@@ -1,5 +1,18 @@ # Revision history for ghc-tags-pipes +## 0.2.0.1 -- 2026-10-23++## 0.2.0.0 -- 2026-10-22++- Recover streamed tags after malformed lines. Add `tagParserWithWarnings` to+  report skipped records without stopping tag updates.++- Add a complete streaming merge that removes duplicates from old and new tags,+  retaining distinct tags with equal sorting keys.++- Match complete module paths when merging streamed tags, preserving files with+  matching filename or directory suffixes.+ ## 0.1.1.0 -- 2023-05-01  * `GHC-9.6` support.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ghc-tags-pipes-version:            0.1.1.0+version:            0.2.0.1 synopsis:           Streaming interface for ghc-tags-core description:        Interface to stream tags using `pipes` library. homepage:           https://github.com/coot/ghc-tags-plugin#readme@@ -9,7 +9,7 @@ license-file:       LICENSE author:             Marcin Szamotulski maintainer:         coot@coot.me-copyright:          (c) 2022, Marcin Szamotulski+copyright:          (c) 2022-2026, Marcin Szamotulski category:           Development build-type:         Simple extra-doc-files:    CHANGELOG.md@@ -19,27 +19,22 @@     ghc-options: -Wall                  -Wno-unticked-promoted-constructors                  -Wcompat-                 -- the following three warnings are enabled by -Wall in-                 -- ghc-9.2-                 -Wno-incomplete-uni-patterns-                 -Wno-incomplete-record-updates                  -Wpartial-fields                  -Widentities                  -Wredundant-constraints-  if impl(ghc >= 9)-    ghc-options: -Wunused-packages+                 -Wunused-packages  library   import:              warnings   hs-source-dirs:      lib   exposed-modules:     GhcTags.Stream-  build-depends:       attoparsec           >=0.13.0.0,-                       base                 >=4.12.0.0 && <4.19,-                       bytestring           >=0.10,-                       mtl,+  build-depends:       attoparsec           >=0.13 && <0.15,+                       base                 >=4.12 && <4.23,+                       bytestring           >=0.10 && <0.13,+                       mtl                   <2.4,                        pipes               ^>=4.3,                        pipes-attoparsec    ^>=0.6,                        pipes-bytestring    ^>=2.1,-                       text                 >=1.2 && <2.1,-                       ghc-tags-core+                       text                 >=1.2 && <2.2,+                       ghc-tags-core       ^>=1.0.0.0   default-language:    Haskell2010

@@ -10,21 +10,25 @@ -- module GhcTags.Stream     ( tagParser+    , tagParserWithWarnings+    , ParsingError (..)+    , combineTagsStream     , combineTagsPipe     , runCombineTagsPipe     ) where -#if __GLASGOW_HASKELL__ >= 906+#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) import           Control.Monad.State.Strict #else import           Control.Monad.State.Strict hiding (void) #endif+import           Control.Exception (throwIO) import           Data.ByteString (ByteString) import           Data.Attoparsec.ByteString (Parser)-import qualified Data.ByteString as BS import           Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as BS-import           Data.Functor (void, ($>))+import           Data.Foldable (traverse_)+import           Data.Functor (($>)) import qualified Data.Text.Encoding as Text import           System.IO @@ -32,12 +36,16 @@ import qualified Pipes as Pipes import qualified Pipes.Lift as Pipes import qualified Pipes.Attoparsec as Pipes.AP+import           Pipes.Attoparsec (ParsingError (..)) import qualified Pipes.ByteString as Pipes.BS  import           GhcTags.Tag+import qualified GhcTags.Utils as Utils   -- | Parse a stream of tags, coming from a 'Text' producer.+-- Skips malformed lines and continues parsing. Use 'tagParserWithWarnings' to+-- report skipped records. I/O exceptions still propagate to the consumer. -- tagParser :: MonadIO m           => Parser (Maybe (Tag tk))@@ -45,21 +53,83 @@           -- line and return the tag, e.g  'parseTagLine'.           -> Pipes.Producer ByteString m ()           -> Pipes.Producer (Tag tk) m ()-tagParser parser producer = void $-  Pipes.for-    (Pipes.AP.parsed parser producer)-    $ \case-      -- ignore header lines-      Just tag -> Pipes.yield tag-      Nothing  -> pure ()+tagParser = tagParserWithWarnings (const (pure ()))  --- | Streaming version of 'GhcTags.Tag.combineTags'.+-- | Recover a stream of tags and report every skipped line.+tagParserWithWarnings :: MonadIO m+                      => (String -> m ())+                      -> Parser (Maybe (Tag tk))+                      -> Pipes.Producer ByteString m ()+                      -> Pipes.Producer (Tag tk) m ()+tagParserWithWarnings report parser producer = do+      Pipes.for+        (Pipes.AP.parsed (Utils.parseLine parser) producer)+        (\case+          Left err -> Pipes.lift (report err)+          -- ignore header lines+          Right (Just tag) -> Pipes.yield tag+          Right Nothing   -> pure ())+  >>= \case+        Left (err, _) -> liftIO (throwIO err)+        Right ()      -> pure ()+++-- | Merge a sorted stream of old tags with sorted new tags from one module.+-- Replaces that module's old tags and removes duplicate output tags, including+-- when the old stream is empty. The comparison must be consistent with equality.+combineTagsStream+    :: forall m (tk :: TAG_KIND). Monad m+    => (Tag tk -> Tag tk -> Ordering)+    -> RawFilePath -- ^ normalised module path, relative to the tags file directory+    -> [Tag tk]   -- ^ new tags, sorted by the supplied comparison+    -> Pipes.Producer (Tag tk) m () -- ^ sorted old tags+    -> Pipes.Producer (Tag tk) m ()+combineTagsStream compareFn modPath new old =+    merged >-> deduplicateTags compareFn modPath+  where+    merged :: Pipes.Producer (Tag tk) m ()+    merged = do+      ((), remaining) <- Pipes.runStateP new $+        Pipes.for (Pipes.hoist Pipes.lift old)+          (\tag -> Pipes.stateP $ fmap ((),) . combineTagsPipe compareFn modPath tag)+      traverse_ Pipes.yield remaining+++-- Equal tags have equal sorting keys, so only the current comparison group+-- needs to be remembered. Keep distinct tags with equal keys: compareTags+-- does not compare fields or definitions.  Only deduplicate groups that+-- contain at least one new (modPath) tag; old-only groups are preserved as-is+-- because etags loses tagKind on round-trip, making formerly-distinct tags+-- look identical after parsing.+deduplicateTags :: Monad m+                => (Tag tk -> Tag tk -> Ordering)+                -> RawFilePath+                -> Pipes.Pipe (Tag tk) (Tag tk) m r+deduplicateTags compareFn modPath = go [] False+  where+    modPath' = rawFilePathToBS modPath+    isNew t  = modPath' == Text.encodeUtf8 (getRawFilePath (tagFilePath t))+    go seen hasNew = do+      tag <- Pipes.await+      let inGroup = case seen of+            previous : _ | compareFn previous tag == EQ -> True+            _ -> False+      if inGroup+        then let hasNew' = hasNew || isNew tag+             in if hasNew' && tag `elem` seen+                then go seen hasNew'+                else Pipes.yield tag >> go (tag : seen) hasNew'+        else Pipes.yield tag >> go [tag] (isNew tag)+++-- | One merge step for an old tag. This does not deduplicate the complete+-- output; use 'combineTagsStream' for a complete merge. -- combineTagsPipe     :: forall m (tk :: TAG_KIND).  Applicative m     => (Tag tk -> Tag tk -> Ordering)-    -> RawFilePath -- ^ file path from which the new tags were obtained, it should be normalised+    -> RawFilePath -- ^ normalised module path, relative to the tags file directory     -> Tag tk      -- ^ tag read from disc     -> [Tag tk]    -- ^ new tags     -> Pipes.Producer (Tag tk) m [Tag tk]@@ -69,12 +139,10 @@     go :: Tag tk -> [Tag tk]        -> Pipes.Producer (Tag tk) m [Tag tk] -    -- omitt all the tags which point to 'modPath'-    ---    -- note: we check that 'tagFilePath' ends with 'modPath', which is-    -- a relative path from the corresponding cabal file.+    -- Omit only tags pointing to the exact module path. Both paths are+    -- normalised and relative to the tags file directory.     go tag as-      | modPath' `BS.isSuffixOf` Text.encodeUtf8 (getRawFilePath (tagFilePath tag))+      | modPath' == Text.encodeUtf8 (getRawFilePath (tagFilePath tag))       = pure as      go tag as@(a : as')