diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# ghc-tags-1.4 (2022-02-28) +* Add support for GHC 9.2. +* Require aeson >= 2.0. +* Enable `BlockArguments`, `ExplicitNamespaces`, `GADTSyntax`, + `NumericUnderscores`, `PatternSynonyms` and `UnicodeSyntax` by default. + # ghc-tags-1.3 (2021-05-23) * Properly escape ex mode search commands. * Fix parsing of generated ctags file. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,9 @@ [![Build Status](https://github.com/arybczak/ghc-tags/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/arybczak/ghc-tags/actions?query=branch%3Amaster) [![Hackage](https://img.shields.io/hackage/v/ghc-tags.svg)](https://hackage.haskell.org/package/ghc-tags) -A command line tool that generates etags (Emacs) and ctags (Vim, VSCode with +A command line tool that generates etags +([Emacs](https://www.gnu.org/software/emacs)) and ctags +([Vim](https://www.vim.org), [VSCode](https://code.visualstudio.com) with [ctagsx](https://marketplace.visualstudio.com/items?itemName=jtanx.ctagsx) etc.) for efficient code navigation (jump to definition). diff --git a/ghc-tags.cabal b/ghc-tags.cabal --- a/ghc-tags.cabal +++ b/ghc-tags.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghc-tags -version: 1.3 +version: 1.4 synopsis: Utility for generating ctags and etags with GHC API. description: Utility for generating etags (Emacs) and ctags (Vim and other editors) with GHC API for efficient project navigation. @@ -14,7 +14,7 @@ README.md homepage: https://github.com/arybczak/ghc-tags bug-reports: https://github.com/arybczak/ghc-tags/issues -tested-with: GHC ==8.10.4 || ==9.0.1 +tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.1 source-repository head type: git @@ -28,13 +28,13 @@ executable ghc-tags ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-A4m - if !flag(ghc-lib) && impl(ghc == 9.0.*) + if !flag(ghc-lib) && impl(ghc == 9.2.*) build-depends: ghc, ghc-boot else - build-depends: ghc-lib == 9.0.* + build-depends: ghc-lib == 9.2.* - build-depends: base >=4.14 && <4.16 - , aeson + build-depends: base >=4.14 && <4.17 + , aeson >= 2.0.0.0 , async , attoparsec , bytestring @@ -49,7 +49,6 @@ , temporary , text , time - , unordered-containers , vector , yaml diff --git a/src/GhcTags/Config/Project.hs b/src/GhcTags/Config/Project.hs --- a/src/GhcTags/Config/Project.hs +++ b/src/GhcTags/Config/Project.hs @@ -10,9 +10,10 @@ import GHC.LanguageExtensions import GHC.Settings import System.Directory +import qualified Data.Aeson.Key as K +import qualified Data.Aeson.KeyMap as K import qualified Data.ByteString.Char8 as BS import qualified Data.Map.Strict as Map -import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import qualified Data.Yaml as Y import qualified Data.Yaml.Pretty as Y @@ -36,11 +37,17 @@ ] , pcLanguage = Haskell2010 , pcExtensions = [ BangPatterns + , BlockArguments , ExplicitForAll + , ExplicitNamespaces + , GADTSyntax , LambdaCase , MultiWayIf + , NumericUnderscores , OverloadedLabels + , PatternSynonyms , TypeApplications + , UnicodeSyntax ] , pcCppIncludes = [] , pcCppOptions = [] @@ -101,7 +108,7 @@ instance FromJSON ProjectConfig where parseJSON (Object v) = do - checkUnknownKeys $ HM.keys v + checkUnknownKeys . map K.toText $ K.keys v pcSourcePaths <- def pcSourcePaths <$> v .:! "source_paths" pcExcludePaths <- def pcExcludePaths <$> v .:! "exclude_paths" pcLanguage <- def pcLanguage <$> explicitParseFieldMaybe' diff --git a/src/GhcTags/Ghc.hs b/src/GhcTags/Ghc.hs --- a/src/GhcTags/Ghc.hs +++ b/src/GhcTags/Ghc.hs @@ -11,17 +11,17 @@ import Data.Maybe import GHC.Data.Bag import GHC.Data.FastString -import GHC.Hs (HsModule(..)) +import GHC.Hs (HsModule(..), NoExtField(..)) import GHC.Hs.Binds import GHC.Hs.Decls hiding (famResultKindSignature) import GHC.Hs.Expr import GHC.Hs.Extension import GHC.Hs.ImpExp import GHC.Hs.Type hiding (hsSigWcType) -import GHC.Types.Basic -import GHC.Types.FieldLabel +import GHC.Parser.Annotation import GHC.Types.Name (nameOccName, occNameFS) import GHC.Types.Name.Reader +import GHC.Types.SourceText import GHC.Types.SrcLoc import GHC.Unit.Module.Name @@ -71,7 +71,7 @@ -- | Check if an identifier is exported. -- -isExported :: Maybe [IE GhcPs] -> Located RdrName -> Bool +isExported :: Maybe [IE GhcPs] -> LocatedN RdrName -> Bool isExported Nothing _name = True isExported (Just ies) (L _ name) = any (\ie -> listToMaybe (ieNames ie) == Just name) ies @@ -79,8 +79,8 @@ -- | Check if a class member or a type constructors is exported. -- isMemberExported :: Maybe [IE GhcPs] - -> Located RdrName -- member name / constructor name - -> Located RdrName -- type class name / type constructor name + -> LocatedN RdrName -- member name / constructor name + -> LocatedN RdrName -- type class name / type constructor name -> Bool isMemberExported Nothing _memberName _className = True isMemberExported (Just ies) memberName className = any go ies @@ -93,31 +93,30 @@ go (IEThingAll _ (L _ n)) = ieWrappedName n == unLoc className - go (IEThingWith _ _ IEWildcard{} _ _) = True + go (IEThingWith _ _ IEWildcard{} _) = True - go (IEThingWith _ (L _ n) NoIEWildcard ns lfls) = + go (IEThingWith _ (L _ n) NoIEWildcard ns) = ieWrappedName n == unLoc className - && (isInWrappedNames || isInFieldLbls) + && isInWrappedNames where -- the 'NameSpace' does not agree between things that are in the 'IE' -- list and passed member or type class names (constructor / type -- constructor names, respectively) isInWrappedNames = any ((== occNameFS (rdrNameOcc (unLoc memberName))) . occNameFS . rdrNameOcc . ieWrappedName . unLoc) ns - isInFieldLbls = any ((== occNameFS (rdrNameOcc (unLoc memberName))) . occNameFS . rdrNameOcc . flSelector. unLoc) lfls go _ = False -- | Create a 'GhcTag', effectively a smart constructor. -- -mkGhcTag :: Located RdrName +mkGhcTag :: LocatedN RdrName -- ^ @RdrName ~ IdP GhcPs@ it *must* be a name of a top level identifier. -> GhcTagKind -- ^ tag's kind -> Bool -- ^ is term exported -> GhcTag -mkGhcTag (L gtSrcSpan rdrName) gtKind gtIsExported = +mkGhcTag (L SrcSpanAnn { locA = gtSrcSpan } rdrName) gtKind gtIsExported = case rdrName of Unqual occName -> GhcTag { gtTag = bytesFS (occNameFS occName) @@ -180,9 +179,9 @@ mies :: Maybe [IE GhcPs] mies = map unLoc . unLoc <$> hsmodExports - mkModNameTag :: Located ModuleName -> GhcTag - mkModNameTag (L gtSrcSpan modName) = - GhcTag { gtSrcSpan + mkModNameTag :: LocatedA ModuleName -> GhcTag + mkModNameTag (L l modName) = + GhcTag { gtSrcSpan = locA l , gtTag = bytesFS $ moduleNameFS modName , gtKind = GtkModule , gtIsExported = True @@ -203,7 +202,7 @@ -- ^ declaration's location; it is useful when the term does not -- contain useful inforamtion (e.g. code generated from template -- haskell splices). - -> Located RdrName + -> LocatedN RdrName -- ^ @RdrName ~ IdP GhcPs@ it *must* be a name of a top level -- identifier. -> GhcTagKind @@ -214,8 +213,8 @@ mkGhcTagForMember :: SrcSpan -- ^ declartion's 'SrcSpan' - -> Located RdrName -- member name - -> Located RdrName -- class name + -> LocatedN RdrName -- member name + -> LocatedN RdrName -- class name -> GhcTagKind -> GhcTag mkGhcTagForMember decLoc memberName className kind = @@ -225,7 +224,7 @@ -- Main routine which traverse all top level declarations. -- go :: LHsDecl GhcPs -> [GhcTag] -> [GhcTag] - go (L decLoc hsDecl) tags = case hsDecl of + go (L SrcSpanAnn { locA = decLoc } hsDecl) tags = case hsDecl of -- type or class declaration TyClD _ tyClDecl -> @@ -271,8 +270,8 @@ -- associated type defaults (data type families, type families -- (open or closed) ++ foldr - (\(L _ decl@(TyFamInstDecl (HsIB { hsib_body = tyFamDeflEqn }))) tags' -> - case tyFamDeflEqn of + (\(L _ decl@(TyFamInstDecl { tfid_eqn })) tags' -> + case tfid_eqn of FamEqn { feqn_rhs = L _ hsType } -> case hsTypeTagName hsType of -- TODO: add a `default` field @@ -296,8 +295,8 @@ , cid_binds, cid_sigs } -> case cid_poly_ty of -- TODO: @hsbib_body :: LHsType GhcPs@ - HsIB { hsib_body } -> - case mkLHsTypeTag decLoc hsib_body of + L _ HsSig { sig_body } -> + case mkLHsTypeTag decLoc sig_body of Nothing -> tags' Just tag -> tag : tags' where @@ -368,23 +367,23 @@ -- generate tags of all constructors of a type -- mkConsTags :: SrcSpan - -> Located RdrName + -> LocatedN RdrName -- name of the type -> ConDecl GhcPs -- constructor declaration -> [GhcTag] - mkConsTags decLoc tyName con@ConDeclGADT { con_names, con_args } = + mkConsTags decLoc tyName con@ConDeclGADT { con_names, con_g_args } = (\n -> mkGhcTagForMember decLoc n tyName (GtkGADTConstructor con)) `map` con_names - ++ mkHsConDeclDetails decLoc tyName con_args + ++ mkHsConDeclGADTDetails decLoc tyName con_g_args mkConsTags decLoc tyName con@ConDeclH98 { con_name, con_args } = mkGhcTagForMember decLoc con_name tyName (GtkDataConstructor con) - : mkHsConDeclDetails decLoc tyName con_args + : mkHsConDeclH98Details decLoc tyName con_args - mkHsLocalBindsTags :: SrcSpan -> HsLocalBindsLR GhcPs GhcPs -> [GhcTag] + mkHsLocalBindsTags :: SrcSpan -> HsLocalBinds GhcPs -> [GhcTag] mkHsLocalBindsTags decLoc (HsValBinds _ (ValBinds _ hsBindsLR sigs)) = -- where clause bindings concatMap (mkHsBindLRTags decLoc . unLoc) (bagToList hsBindsLR) @@ -392,8 +391,12 @@ mkHsLocalBindsTags _ _ = [] - mkHsConDeclDetails :: SrcSpan -> Located RdrName -> HsConDeclDetails GhcPs -> [GhcTag] - mkHsConDeclDetails decLoc tyName (RecCon (L _ fields)) = + mkHsConDeclGADTDetails + :: SrcSpan + -> LocatedN RdrName + -> HsConDeclGADTDetails GhcPs + -> [GhcTag] + mkHsConDeclGADTDetails decLoc tyName (RecConGADT (L _ fields)) = foldr f [] fields where f :: LConDeclField GhcPs -> [GhcTag] -> [GhcTag] @@ -402,9 +405,23 @@ g :: LFieldOcc GhcPs -> GhcTag g (L _ FieldOcc { rdrNameFieldOcc }) = mkGhcTagForMember decLoc rdrNameFieldOcc tyName GtkRecordField + mkHsConDeclGADTDetails _ _ _ = [] - mkHsConDeclDetails _ _ _ = [] + mkHsConDeclH98Details + :: SrcSpan + -> LocatedN RdrName + -> HsConDeclH98Details GhcPs + -> [GhcTag] + mkHsConDeclH98Details decLoc tyName (RecCon (L _ fields)) = + foldr f [] fields + where + f :: LConDeclField GhcPs -> [GhcTag] -> [GhcTag] + f (L _ ConDeclField { cd_fld_names }) ts = ts ++ map g cd_fld_names + g :: LFieldOcc GhcPs -> GhcTag + g (L _ FieldOcc { rdrNameFieldOcc }) = + mkGhcTagForMember decLoc rdrNameFieldOcc tyName GtkRecordField + mkHsConDeclH98Details _ _ _ = [] mkHsBindLRTags :: SrcSpan -- ^ declaration's 'SrcSpan' @@ -412,7 +429,7 @@ -> [GhcTag] mkHsBindLRTags decLoc hsBind = case hsBind of FunBind { fun_id, fun_matches } -> - let binds = map (unLoc . grhssLocalBinds . m_grhss . unLoc) + let binds = map (grhssLocalBinds . m_grhss . unLoc) . unLoc . mg_alts $ fun_matches @@ -426,14 +443,16 @@ -- ``` PatBind {} -> [] - VarBind { var_id, var_rhs = L srcSpan _ } -> [mkGhcTag' decLoc (L srcSpan var_id) GtkTerm] + -- According to the GHC documentation VarBinds are introduced by the + -- type checker, so ghc-tags will never encounter them. + VarBind {} -> [] -- abstraction binding is only used after translation AbsBinds {} -> [] PatSynBind _ PSB { psb_id } -> [mkGhcTag' decLoc psb_id GtkPatternSynonym] - mkClsMemberTags :: SrcSpan -> Located RdrName -> Sig GhcPs -> [GhcTag] + mkClsMemberTags :: SrcSpan -> LocatedN RdrName -> Sig GhcPs -> [GhcTag] mkClsMemberTags decLoc clsName (TypeSig _ lhs hsSigWcType) = (\n -> mkGhcTagForMember decLoc n clsName (GtkTypeSignature hsSigWcType)) `map` lhs mkClsMemberTags decLoc clsName (PatSynSig _ lhs hsSigWcType) = @@ -477,7 +496,7 @@ mkFamilyDeclTags :: SrcSpan -> FamilyDecl GhcPs -- ^ declaration's 'SrcSpan' - -> Maybe (Located RdrName) + -> Maybe (LocatedN RdrName) -- if this type family is associate, pass the name of the -- associated class -> Maybe GhcTag @@ -508,7 +527,7 @@ <$> hsTypeTagName hsType - hsTypeTagName :: HsType GhcPs -> Maybe (Located RdrName) + hsTypeTagName :: HsType GhcPs -> Maybe (LocatedN RdrName) hsTypeTagName hsType = case hsType of HsForAllTy {hst_body} -> hsTypeTagName (unLoc hst_body) @@ -529,8 +548,7 @@ mkDataFamInstDeclTag :: SrcSpan -> DataFamInstDecl GhcPs -> [GhcTag] mkDataFamInstDeclTag decLoc DataFamInstDecl { dfid_eqn } = case dfid_eqn of - - HsIB { hsib_body = FamEqn { feqn_tycon, feqn_rhs } } -> + FamEqn { feqn_tycon, feqn_rhs } -> case feqn_rhs of HsDataDefn { dd_cons, dd_kindSig } -> mkGhcTag' decLoc feqn_tycon @@ -545,7 +563,7 @@ mkTyFamInstDeclTag decLoc decl@TyFamInstDecl { tfid_eqn } = case tfid_eqn of -- TODO: should we check @feqn_rhs :: LHsType GhcPs@ as well? - HsIB { hsib_body = FamEqn { feqn_tycon } } -> + FamEqn { feqn_tycon } -> Just $ mkGhcTag' decLoc feqn_tycon (GtkTypeFamilyInstance decl) -- diff --git a/src/GhcTags/GhcCompat.hs b/src/GhcTags/GhcCompat.hs --- a/src/GhcTags/GhcCompat.hs +++ b/src/GhcTags/GhcCompat.hs @@ -7,6 +7,7 @@ import Data.IORef import GHC.Data.FastString import GHC.Data.StringBuffer +import GHC.Driver.Config import GHC.Driver.Main import GHC.Driver.Monad import GHC.Driver.Session @@ -16,7 +17,6 @@ import GHC.Platform import GHC.Settings import GHC.Settings.Config -import GHC.Settings.Platform import GHC.Settings.Utils import GHC.SysTools import GHC.SysTools.BaseDir @@ -26,7 +26,6 @@ import System.Directory import System.FilePath import qualified Data.Map.Strict as Map -import qualified Data.Set as Set import qualified GHC import qualified GHC.Parser as Parser @@ -38,7 +37,7 @@ parseModule filename flags buffer = unP Parser.parseModule parseState where location = mkRealSrcLoc (mkFastString filename) 1 1 - parseState = mkPState flags buffer location + parseState = initParserState (initParserOpts flags) buffer location runGhc :: Ghc a -> IO a runGhc m = do @@ -62,23 +61,15 @@ -- dynamically or not. platformCanGenerateDynamicToo = platformOS (targetPlatform dflags) /= OSMinGW32 - refCanGenerateDynamicToo <- newIORef platformCanGenerateDynamicToo - refNextTempSuffix <- newIORef 0 - refFilesToClean <- newIORef emptyFilesToClean - refDirsToClean <- newIORef Map.empty - refGeneratedDumps <- newIORef Set.empty + refDynamicTooFailed <- newIORef (not platformCanGenerateDynamicToo) refRtldInfo <- newIORef Nothing refRtccInfo <- newIORef Nothing wrapperNum <- newIORef emptyModuleEnv pure dflags - { canGenerateDynamicToo = refCanGenerateDynamicToo - , nextTempSuffix = refNextTempSuffix - , filesToClean = refFilesToClean - , dirsToClean = refDirsToClean - , generatedDumps = refGeneratedDumps - , nextWrapperNum = wrapperNum - , rtldInfo = refRtldInfo - , rtccInfo = refRtccInfo + { dynamicTooFailed = refDynamicTooFailed + , nextWrapperNum = wrapperNum + , rtldInfo = refRtldInfo + , rtccInfo = refRtccInfo } -- | Stripped version of 'GHC.Settings.IO.initSettings' that ignores the @@ -111,12 +102,12 @@ -- just partially applying those functions and throwing 'Left's; they're -- written in a very portable style to keep ghc-boot light. let getSetting key = either error pure $ - getFilePathSetting0 top_dir settingsFile mySettings key + getRawFilePathSetting top_dir settingsFile mySettings key getToolSetting :: String -> IO String getToolSetting key = expandToolDir mtool_dir <$> getSetting key getBooleanSetting :: String -> IO Bool getBooleanSetting key = either error pure $ - getBooleanSetting0 settingsFile mySettings key + getRawBooleanSetting settingsFile mySettings key myExtraGccViaCFlags <- getSetting "GCC extra via C opts" -- On Windows, mingw is distributed with GHC, -- so we look in TopDir/../mingw/bin, @@ -252,7 +243,6 @@ -- Lots of uninitialized fields here. , sPlatformMisc = PlatformMisc {} - , sPlatformConstants = PlatformConstants { pc_DYNAMIC_BY_DEFAULT = False } , sRawSettings = settingsList } @@ -264,18 +254,15 @@ compatGetTargetPlatform settingsFile mySettings = do let readSetting :: (Show a, Read a) => String -> Either String a - readSetting = readSetting0 settingsFile mySettings + readSetting = readRawSetting settingsFile mySettings - targetArch <- readSetting "target arch" - targetOS <- readSetting "target os" + targetArchOS <- getTargetArchOS settingsFile mySettings targetWordSize <- readSetting "target word size" pure $ Platform - { platformMini = PlatformMini - { platformMini_arch = targetArch - , platformMini_os = targetOS - } + { platformArchOS = targetArchOS , platformWordSize = targetWordSize + , platform_constants = Nothing -- below is irrelevant , platformByteOrder = LittleEndian , platformUnregisterised = True diff --git a/src/GhcTags/Tag.hs b/src/GhcTags/Tag.hs --- a/src/GhcTags/Tag.hs +++ b/src/GhcTags/Tag.hs @@ -37,7 +37,7 @@ import qualified Data.Text.Encoding as Text -- GHC imports -import GHC.Driver.Session (DynFlags) +import GHC.Driver.Session (DynFlags, initSDocContext) import GHC.Data.FastString (bytesFS) import GHC.Types.SrcLoc @@ -447,8 +447,8 @@ Text.intercalate " " -- remove all line breaks, tabs and multiple spaces . Text.words . Text.pack - $ Out.renderWithStyle - (Out.initSDocContext + $ Out.renderWithContext + (initSDocContext dynFlags (Out.setStyleColoured False $ Out.mkErrStyle Out.neverQualify)) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -13,13 +13,17 @@ import Data.Maybe (mapMaybe) import Data.Time import Data.Time.Format.ISO8601 +import GHC (GhcException, setSessionDynFlags) import GHC.Conc (getNumProcessors) import GHC.Data.Bag import GHC.Data.StringBuffer +import GHC.Driver.Env.Types import GHC.Driver.Monad +import GHC.Driver.Pipeline +import GHC.Driver.Ppr import GHC.Driver.Session -import GHC.Driver.Types (HscEnv(..)) import GHC.Hs +import GHC.Parser.Errors.Ppr import GHC.Parser.Lexer import GHC.Types.SrcLoc import GHC.Utils.Error @@ -39,9 +43,6 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import qualified Data.Vector as V -import qualified GHC -import qualified GHC.Driver.Pipeline as DP -import qualified GHC.Utils.Outputable as Out import GhcTags import GhcTags.Config.Args @@ -102,7 +103,7 @@ -- Extract tags from a given file and update the TagMap. worker :: IO () worker = runGhc $ do - void $ GHC.setSessionDynFlags . adjustDynFlags pc =<< getSessionDynFlags + void $ setSessionDynFlags . adjustDynFlags pc =<< getSessionDynFlags env <- getSession liftIO . fix $ \loop -> atomically (readTBQueue $ wdQueue wd) >>= \case Nothing -> pure () @@ -110,7 +111,7 @@ where processFile :: HscEnv -> FilePath -> HsFileType -> UTCTime -> IO () processFile env rawFile hsType mtime = withHsFile rawFile hsType $ \hsFile -> do - handle showErr $ DP.preprocess env hsFile Nothing Nothing >>= \case + handle showErr $ preprocess env hsFile Nothing Nothing >>= \case Left errs -> report (hsc_dflags env) errs Right (flags, file) -> do --when (file /= rawFile) $ do @@ -118,13 +119,13 @@ buffer <- hGetStringBuffer file case parseModule file flags buffer of PFailed pstate -> do - let (wrns, errs) = getMessages pstate flags - report flags wrns - report flags errs + let (wrns, errs) = getMessages pstate + report flags (pprWarning <$> wrns) + report flags (pprError <$> errs) POk pstate hsModule -> do - let (wrns, errs) = getMessages pstate flags - report flags wrns - report flags errs + let (wrns, errs) = getMessages pstate + report flags (pprWarning <$> wrns) + report flags (pprError <$> errs) when (isEmptyBag errs) $ do modifyMVar_ (wdTags wd) $ \tags -> do pure $! updateTagsWith flags hsModule tags @@ -135,10 +136,10 @@ showErr :: GHC.GhcException -> IO () showErr = putStrLn . show - report :: DynFlags -> Bag ErrMsg -> IO () + report :: DynFlags -> Bag (MsgEnvelope DecoratedSDoc) -> IO () report flags msgs = - sequence_ [ putStrLn $ Out.showSDoc flags msg - | msg <- pprErrMsgBagWithLoc msgs + sequence_ [ putStrLn $ showSDoc flags msg + | msg <- pprMsgEnvelopeBagWithLoc msgs ] -- Alex and Hsc files need to be preprocessed before going into GHC. @@ -269,7 +270,7 @@ case res of Right (Right (headers, tags)) -> -- full evaluation decreases performance variation - deepseq headers . deepseq tags $ pure DirtyTags + deepseq headers `seq` deepseq tags `seq` pure DirtyTags { dtKind = tt , dtHeaders = headers , dtTags = Map.map (Updated False) tags