diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for ghctags +## 0.6.1.0 -- 2024-01-11 + +- `GHC-9.8` support; droppped support of `GHC-{8.10, 9.0, 9.2}`. + ## 0.6.0.0 -- 2023-05-01 - `GHC-9.6` support; dropped support of `GHC-8.8`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,11 +12,7 @@ ● Requirements -------------- -The plugin requires at least: `ghc >= 8.8`; `ghc-tags-plugin` can generate tags -for template-haskell splices, but it requires: `ghc >= 8.10`. - -`ghc-9.4` includes a [fix][ghc-issue-20417] which makes `cabal` cache mechanism -works again. +The plugin requires at least: `ghc >= 9.4`. ● Plugin options ---------------- diff --git a/ghc-tags-plugin.cabal b/ghc-tags-plugin.cabal --- a/ghc-tags-plugin.cabal +++ b/ghc-tags-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghc-tags-plugin -version: 0.6.0.1 +version: 0.6.1.0 synopsis: A compiler plugin which generates tags file from GHC parsed syntax tree. description: __etags__ format. For a standalone `ghc-tags` command look for or @@ -12,14 +12,14 @@ license-file: LICENSE author: Marcin Szamotulski maintainer: coot@coot.me -copyright: (c) 2020-2023, Marcin Szamotulski +copyright: (c) 2020-2024, Marcin Szamotulski category: Development stability: alpha extra-source-files: CHANGELOG.md README.md homepage: https://github.com/coot/ghc-tags-plugin#readme bug-reports: https://github.com/coot/ghc-tags-plugin/issues -tested-with: GHC == { 8.10, 9.0, 9.2, 9.4, 9.6 } +tested-with: GHC == { 9.4, 9.6, 9.8 } -- Don't build gtp-check command by default; it's a development tool. flag gtp-check @@ -53,19 +53,19 @@ other-modules: Plugin.GhcTags.CTag Paths_ghc_tags_plugin autogen-modules: Paths_ghc_tags_plugin - build-depends: base >=4.12.0.0 && <4.19, - bytestring >=0.10 && < 0.12, + build-depends: base >=4.12.0.0 && <4.20, + bytestring >=0.10 && < 0.13, directory ^>=1.3, filepath ^>=1.4, ghc >=8.4 && <10, lukko ^>=0.1, mtl >=2.2 && <2.4, optparse-applicative - >=0.15.1 && < 0.17, + >=0.15.1 && < 0.19, pipes ^>=4.3, pipes-bytestring ^>=2.1, pipes-safe ^>=2.3, - text >=1.2 && <2.1, + text >=1.2 && <2.2, ghc-tags-core ^>=0.6, ghc-tags-pipes ^>=0.1.1 diff --git a/lib/Plugin/GhcTags.hs b/lib/Plugin/GhcTags.hs --- a/lib/Plugin/GhcTags.hs +++ b/lib/Plugin/GhcTags.hs @@ -30,7 +30,8 @@ import Data.Either (partitionEithers, rights) import Data.Foldable (traverse_) import Data.Maybe (mapMaybe) -#if __GLASGOW_HASKELL__ > 906 +#if MIN_VERSION_filepath(1,4,100) +import qualified System.OsPath as OsPath import System.Directory.OsPath #else import System.Directory @@ -45,17 +46,11 @@ import qualified Pipes.Safe import qualified Pipes.ByteString as Pipes.BS -#if __GLASGOW_HASKELL__ >= 900 import GHC.Driver.Plugins -#else -import GhcPlugins -#endif ( CommandLineOption , Plugin (..) ) -#if __GLASGOW_HASKELL__ >= 900 import qualified GHC.Driver.Plugins as GhcPlugins -#if __GLASGOW_HASKELL__ >= 902 import GHC.Driver.Env ( Hsc , HscEnv (..) ) @@ -71,20 +66,6 @@ , metaRequestP , metaRequestT ) -#else -import GHC.Driver.Types ( Hsc - , HsParsedModule (..) - , ModSummary (..) - , MetaHook - , MetaRequest (..) - , MetaResult - , metaRequestAW - , metaRequestD - , metaRequestE - , metaRequestP - , metaRequestT - ) -#endif import GHC.Driver.Hooks (Hooks (..)) import GHC.Unit.Types (Module) import GHC.Unit.Module.Location (ModLocation (..)) @@ -92,57 +73,13 @@ import GHC.Tc.Gen.Splice (defaultRunMeta) import GHC.Types.SrcLoc (Located) import qualified GHC.Types.SrcLoc as GHC (SrcSpan (..), getLoc, srcSpanFile) -#else -import qualified GhcPlugins -import GhcPlugins ( Hsc - , HsParsedModule (..) - , Located - , Module - , ModLocation (..) - , ModSummary (..) -#if __GLASGOW_HASKELL__ >= 810 - , MetaHook - , MetaRequest (..) - , MetaResult - , metaRequestAW - , metaRequestD - , metaRequestE - , metaRequestP - , metaRequestT -#endif - ) -import qualified SrcLoc as GHC (SrcSpan (..), getLoc, srcSpanFile) -#endif -#if __GLASGOW_HASKELL__ >= 902 import GHC.Driver.Session (DynFlags) -#elif __GLASGOW_HASKELL__ >= 900 -import GHC.Driver.Session (DynFlags (DynFlags, hooks)) -#else -import DynFlags (DynFlags (DynFlags, hooks)) -#endif -#if __GLASGOW_HASKELL__ >= 900 import GHC.Hs (GhcPs, GhcTc, HsModule (..), LHsDecl, LHsExpr) -#else -import GHC.Hs (GhcPs, GhcTc, HsModule (..), LHsDecl, LHsExpr) -import TcSplice -import TcRnMonad -import Hooks -#endif -#if __GLASGOW_HASKELL__ >= 900 import GHC.Utils.Outputable (($+$), ($$)) import qualified GHC.Utils.Outputable as Out import qualified GHC.Utils.Ppr.Colour as PprColour -#else -import Outputable (($+$), ($$)) -import qualified Outputable as Out -import qualified PprColour -#endif -#if __GLASGOW_HASKELL__ >= 900 import GHC.Data.FastString (bytesFS) -#else -import FastString (bytesFS) -#endif import GhcTags.Ghc import GhcTags.Tag @@ -157,10 +94,8 @@ #if __GLASGOW_HASKELL__ >= 906 type GhcPsModule = HsModule GhcPs -#elif __GLASGOW_HASKELL__ >= 900 -type GhcPsModule = HsModule #else -type GhcPsModule = HsModule GhcPs +type GhcPsModule = HsModule #endif @@ -194,18 +129,10 @@ plugin :: Plugin plugin = GhcPlugins.defaultPlugin { parsedResultAction = -#if __GLASGOW_HASKELL__ >= 904 -- TODO: add warnings / errors to 'ParsedResult' \args summary result@GhcPlugins.ParsedResult { GhcPlugins.parsedResultModule } -> result <$ ghcTagsParserPlugin args summary parsedResultModule, -#else - ghcTagsParserPlugin, -#endif -#if __GLASGOW_HASKELL__ >= 902 driverPlugin = ghcTagsDriverPlugin, -#else - dynflagsPlugin = ghcTagsDynflagsPlugin, -#endif pluginRecompile = GhcPlugins.purePlugin } @@ -238,6 +165,9 @@ } -> liftIO $ do +#if MIN_VERSION_filepath(1,4,100) + tagsPath <- OsPath.encodeUtf tagsFile +#endif -- wrap 'IOException's handle (\ioerr -> do putDocLn dynFlags @@ -252,13 +182,23 @@ withFileLock debug (lockFilePath tagsFile) ExclusiveLock $ \_ -> do mbInSize <- if debug - then Just <$> getFileSize tagsFile + then Just <$> getFileSize +#if MIN_VERSION_filepath(1,4,100) + tagsPath +#else + tagsFile +#endif `catch` \(_ :: IOException) -> pure 0 else pure Nothing updateTags opts moduleSummary hpm_module when debug $ do let Just inSize = mbInSize - outSize <- getFileSize tagsFile + outSize <- getFileSize +#if MIN_VERSION_filepath(1,4,100) + tagsPath +#else + tagsFile +#endif when (inSize > outSize) $ liftIO $ putDocLn dynFlags @@ -325,7 +265,15 @@ -- the current module. The results are written to a destination file which -- is then renamed to tags file. updateCTags_stream = do - tagsFileExists <- doesFileExist tagsFile +#if MIN_VERSION_filepath(1,4,100) + tagsPath <- OsPath.encodeUtf tagsFile +#endif + tagsFileExists <- doesFileExist +#if MIN_VERSION_filepath(1,4,100) + tagsPath +#else + tagsFile +#endif let destFile = case FilePath.splitFileName tagsFile of (dir, name) -> dir FilePath. "." ++ name @@ -333,17 +281,30 @@ if debug then if tagsFileExists - then Just <$> getFileSize tagsFile + then Just <$> getFileSize +#if MIN_VERSION_filepath(1,4,100) + tagsPath +#else + tagsFile +#endif `catch` \(_ :: IOException) -> pure 0 else pure (Just 0) else pure Nothing withFile destFile WriteMode $ \writeHandle -> withFile tagsFile ReadWriteMode $ \readHandle -> do +#if MIN_VERSION_filepath(1,4,100) + cwd <- getCurrentDirectory +#else cwd <- rawFilePathFromBS . BSC.pack <$> getCurrentDirectory +#endif -- absolute directory path of the tags file; we need canonical path -- (without ".." and ".") to make 'makeRelative' works. +#if MIN_VERSION_filepath(1,4,100) + tagsDir <- canonicalizePath (fst $ OsPath.splitFileName tagsPath) +#else tagsDir <- rawFilePathFromBS . BSC.pack <$> canonicalizePath (fst $ FilePath.splitFileName tagsFile) +#endif case ml_hs_file ms_location of Nothing -> pure () Just sourcePath -> do @@ -352,11 +313,7 @@ -- not the project. modulePath = case GHC.getLoc lmodule of -#if __GLASGOW_HASKELL__ >= 900 GHC.RealSrcSpan rss _ -> -#else - GHC.RealSrcSpan rss -> -#endif rawFilePathFromBS . bytesFS . GHC.srcSpanFile @@ -423,7 +380,12 @@ hFlush writeHandle when debug $ do - outSize <- getFileSize tagsFile + outSize <- getFileSize +#if MIN_VERSION_filepath(1,4,100) + tagsPath +#else + tagsFile +#endif let Just inSize = mbInSize printMessageDoc dynFlags DebugMessage (Just ms_mod) (concat [ "path: " @@ -438,33 +400,61 @@ , show outSize ]) +#if MIN_VERSION_filepath(1,4,100) + destPath <- OsPath.encodeUtf destFile + destFileExists <- doesFileExist destPath +#else destFileExists <- doesFileExist destFile +#endif when destFileExists $ +#if MIN_VERSION_filepath(1,4,100) + renameFile destPath tagsPath +#else renameFile destFile tagsFile +#endif -- -- update ctags (non streaming) -- updateCTags = do +#if MIN_VERSION_filepath(1,4,100) + tagsPath <- OsPath.encodeUtf tagsFile + tagsFileExists <- doesFileExist tagsPath +#else tagsFileExists <- doesFileExist tagsFile +#endif mbInSize <- if debug then if tagsFileExists - then Just <$> getFileSize tagsFile + then +#if MIN_VERSION_filepath(1,4,100) + Just <$> getFileSize tagsPath `catch` \(_ :: IOException) -> pure 0 +#else + Just <$> getFileSize tagsFile + `catch` \(_ :: IOException) -> pure 0 +#endif else pure (Just 0) else pure Nothing !tagsContent <- if tagsFileExists then BS.readFile tagsFile else return mempty withFile tagsFile WriteMode $ \writeHandle -> do +#if MIN_VERSION_filepath(1,4,100) + cwd <- getCurrentDirectory +#else cwd <- rawFilePathFromBS . BSC.pack <$> getCurrentDirectory +#endif -- absolute directory path of the tags file; we need canonical path -- (without ".." and ".") to make 'makeRelative' works. +#if MIN_VERSION_filepath(1,4,100) + tagsDir <- canonicalizePath (fst $ OsPath.splitFileName tagsPath) +#else tagsDir <- rawFilePathFromBS . BSC.pack <$> canonicalizePath (fst $ FilePath.splitFileName tagsFile) +#endif case ml_hs_file ms_location of Nothing -> pure () Just sourcePath -> do @@ -473,11 +463,7 @@ -- not the project. modulePath = case GHC.getLoc lmodule of -#if __GLASGOW_HASKELL__ >= 900 GHC.RealSrcSpan rss _ -> -#else - GHC.RealSrcSpan rss -> -#endif rawFilePathFromBS . bytesFS . GHC.srcSpanFile @@ -515,7 +501,11 @@ ) when debug $ do +#if MIN_VERSION_filepath(1,4,100) + outSize <- getFileSize tagsPath +#else outSize <- getFileSize tagsFile +#endif let Just inSize = mbInSize printMessageDoc dynFlags DebugMessage (Just ms_mod) (concat [ "parsed: " @@ -533,24 +523,43 @@ -- update etags file -- updateETags = do +#if MIN_VERSION_filepath(1,4,100) + tagsPath <- OsPath.encodeUtf tagsFile + tagsFileExists <- doesFileExist tagsPath +#else tagsFileExists <- doesFileExist tagsFile +#endif mbInSize <- if debug then if tagsFileExists - then Just <$> getFileSize tagsFile + then +#if MIN_VERSION_filepath(1,4,100) + Just <$> getFileSize tagsPath `catch` \(_ :: IOException) -> pure 0 +#else + Just <$> getFileSize tagsFile + `catch` \(_ :: IOException) -> pure 0 +#endif else pure (Just 0) else pure Nothing !tagsContent <- if tagsFileExists then BS.readFile tagsFile else return mempty withFile tagsFile WriteMode $ \writeHandle -> do +#if MIN_VERSION_filepath(1,4,100) + cwd <- getCurrentDirectory +#else cwd <- rawFilePathFromBS . BSC.pack <$> getCurrentDirectory +#endif -- absolute directory path of the tags file; we need canonical path -- (without ".." and ".") to make 'makeRelative' works. +#if MIN_VERSION_filepath(1,4,100) + tagsDir <- canonicalizePath (fst $ OsPath.splitFileName tagsPath) +#else tagsDir <- rawFilePathFromBS . BSC.pack <$> canonicalizePath (fst $ FilePath.splitFileName tagsFile) +#endif case ml_hs_file ms_location of Nothing -> pure () @@ -568,11 +577,7 @@ $ Text.encodeUtf8 (Text.pack sourcePath) modulePath = case GHC.getLoc lmodule of -#if __GLASGOW_HASKELL__ >= 900 GHC.RealSrcSpan rss _ -> -#else - GHC.RealSrcSpan rss -> -#endif rawFilePathFromBS . bytesFS . GHC.srcSpanFile @@ -594,7 +599,11 @@ BB.hPutBuilder writeHandle (ETag.formatETagsFile combined) when debug $ do +#if MIN_VERSION_filepath(1,4,100) + outSize <- getFileSize tagsPath +#else outSize <- getFileSize tagsFile +#endif let Just inSize = mbInSize printMessageDoc dynFlags DebugMessage (Just ms_mod) (concat [ "parsed: " @@ -644,26 +653,19 @@ -- next tags'' = case tags of - [] -> [] - _ -> map Just (tail tags) ++ [Nothing] + [] -> [] + _:ts -> map Just ts ++ [Nothing] -- -- Tags for Template-Haskell splices -- -#if __GLASGOW_HASKELL__ >= 902 ghcTagsDriverPlugin :: [CommandLineOption] -> HscEnv -> IO HscEnv ghcTagsDriverPlugin opts env@HscEnv{ hsc_hooks } = do let hook = ghcTagsMetaHook opts (hsc_dflags env) return env { hsc_hooks = hsc_hooks { runMetaHook = Just hook } } -#else -ghcTagsDynflagsPlugin :: [CommandLineOption] -> DynFlags -> IO DynFlags -ghcTagsDynflagsPlugin options dynFlags@DynFlags { hooks } = do - let hook = ghcTagsMetaHook options dynFlags - return dynFlags { hooks = hooks { runMetaHook = Just hook } } -#endif -- | DynFlags plugin which extract tags from TH splices. -- @@ -683,8 +685,17 @@ (displayException ioerr)) throwIO (GhcTagsDynFlagsPluginIOException ioerr)) $ withFileLock debug (lockFilePath tagsFile) ExclusiveLock $ \_ -> do +#if MIN_VERSION_filepath(1,4,100) + cwd <- getCurrentDirectory +#else cwd <- rawFilePathFromBS . BSC.pack <$> getCurrentDirectory +#endif +#if MIN_VERSION_filepath(1,4,100) + tagsPath <- OsPath.encodeUtf tagsFile + tagsDir <- canonicalizePath (fst $ OsPath.splitFileName tagsPath) +#else tagsDir <- rawFilePathFromBS . BSC.pack <$> canonicalizePath (fst $ FilePath.splitFileName tagsFile) +#endif tagsContent <- BSC.readFile tagsFile if etags then do @@ -835,29 +846,11 @@ putDocLn :: DynFlags -> Out.SDoc -> IO () -#if __GLASGOW_HASKELL__ >= 902 putDocLn _dynFlags sdoc = -#else -putDocLn dynFlags sdoc = -#endif putStrLn $ -#if __GLASGOW_HASKELL__ >= 902 Out.renderWithContext Out.defaultSDocContext { Out.sdocStyle = Out.mkErrStyle Out.neverQualify } sdoc -#elif __GLASGOW_HASKELL__ >= 900 - Out.renderWithStyle - (Out.initSDocContext - dynFlags - (Out.setStyleColoured False - $ Out.mkErrStyle Out.neverQualify)) - sdoc -#else - Out.renderWithStyle - dynFlags - sdoc - (Out.setStyleColoured True $ Out.defaultErrStyle dynFlags) -#endif printMessageDoc :: DynFlags -> MessageType -> Maybe Module -> String -> IO () diff --git a/lib/Plugin/GhcTags/Options.hs b/lib/Plugin/GhcTags/Options.hs --- a/lib/Plugin/GhcTags/Options.hs +++ b/lib/Plugin/GhcTags/Options.hs @@ -29,7 +29,7 @@ <> help ( "stream tags from the tags file when updating its contents" ++ " with the tags found in the current module" ) -filePathParser :: Parser (FilePath) +filePathParser :: Parser FilePath filePathParser = strArgument $ help "tags file: default tags or TAGS (when --etags is specified)" @@ -49,9 +49,9 @@ , stream :: Bool -- ^ be default we read the tags file and overwrite it. When this option - -- is on, we stream tags from it while interliving the tags found in the + -- is on, we stream tags from it while interleaving the tags found in the -- current module to a new destination, which is then moved to the tags - -- file desintation. + -- file destination. , filePath :: f FilePath -- ^ file path to the tags file (relative to the @*.cabal@ file). The