ghc-tags-plugin 0.2.3.0 → 0.2.4.0
raw patch · 3 files changed
+77/−46 lines, 3 files
Files
- CHANGELOG.md +5/−0
- ghc-tags-plugin.cabal +1/−1
- lib/Plugin/GhcTags.hs +71/−45
CHANGELOG.md view
@@ -51,3 +51,8 @@ * Generate tags for template haskell splices (requires at least `GHC-8.10`). * Include types of class methods.++## 0.2.4.0 -- 2020-09-08++* `ghc-tags-vim` a vim plugin which helps to maintain a `cabal.project.local` file.+* better tag info
ghc-tags-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghc-tags-plugin-version: 0.2.3.0+version: 0.2.4.0 synopsis: A compiler plugin which generates tags file from GHC parsed syntax tree. description: A [GHC compiler plugin](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/extending_ghc.html?highlight=compiler%20plugin#compiler-plugins)
lib/Plugin/GhcTags.hs view
@@ -101,7 +101,7 @@ -- compiled module. -- -- __The syntax tree is left unchanged.__--- +-- -- The tags file will contain location information about: -- -- * /top level terms/@@ -119,7 +119,7 @@ -- plugin :: Plugin plugin = GhcPlugins.defaultPlugin {- parsedResultAction = ghcTagsPlugin,+ parsedResultAction = ghcTagsParserPlugin, #if __GLASGOW_HASKELL__ >= 810 dynflagsPlugin = ghcTagsDynflagsPlugin, #endif@@ -130,8 +130,9 @@ -- | IOExcption wrapper; it is useful for the user to know that it's the plugin -- not `ghc` that thrown the error. ---data GhcTagsPluginException =- GhcTagsPluginIOExceptino IOException+data GhcTagsPluginException+ = GhcTagsParserPluginIOException IOException+ | GhcTagsDynFlagsPluginIOException IOException deriving Show instance Exception GhcTagsPluginException@@ -139,10 +140,10 @@ -- | The plugin does not change the 'HsParedModule', it only runs side effects. ---ghcTagsPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule-ghcTagsPlugin options- moduleSummary@ModSummary {ms_mod, ms_hspp_opts = dynFlags}- hsParsedModule@HsParsedModule {hpm_module} =+ghcTagsParserPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule+ghcTagsParserPlugin options+ moduleSummary@ModSummary {ms_mod, ms_hspp_opts = dynFlags}+ hsParsedModule@HsParsedModule {hpm_module} = hsParsedModule <$ case runOptionParser options of@@ -157,8 +158,10 @@ -- wrap 'IOException's handle (\ioerr -> do- putDocLn dynFlags (messageDoc UnhandledException (Just ms_mod) (displayException ioerr))- throwIO $ GhcTagsPluginIOExceptino ioerr) $+ putDocLn dynFlags+ (messageDoc UnhandledException (Just ms_mod)+ (displayException ioerr))+ throwIO (GhcTagsParserPluginIOException ioerr)) $ flip finally (void $ try @IOException $ removeFile sourceFile) $ -- Take advisory exclusive lock (a BSD lock using `flock`) on the tags -- file. This is needed when `cabal` compiles in parallel.@@ -177,7 +180,7 @@ when (inSize > outSize) $ throwIO (userError $ concat [ "tags file '"- , tagsFile + , tagsFile , "' size shrinked: " , show inSize , "→"@@ -204,6 +207,7 @@ | OptionParserFailure | DebugMessage + instance Show MessageType where show ReadException = "read error" show ParserException = "tags parser error"@@ -212,6 +216,7 @@ show OptionParserFailure = "plugin options parser error" show DebugMessage = "" + -- | Extract tags from a module and update tags file -- updateTags :: Options Identity@@ -325,7 +330,7 @@ Right txt -> do pres <- try @IOException $ ETag.parseTagsFile txt case pres of- Left err -> + Left err -> putDocLn dynFlags $ messageDoc ParserException (Just ms_mod) (displayException err) Right (Left err) ->@@ -366,27 +371,6 @@ BB.hPutBuilder writeHandle (ETag.formatETagsFile tags') - where-- fixFilePath :: RawFilePath -- curent directory- -> RawFilePath -- tags directory- -> RawFilePath -> RawFilePath- fixFilePath cwd tagsDir =- FilePath.normalise- . FilePath.makeRelative tagsDir- . (cwd FilePath.</>)-- -- we are missing `Text` based `FilePath` library!- fixTagFilePath :: RawFilePath -> RawFilePath -> Tag tk -> Tag tk- fixTagFilePath cwd tagsDir tag@Tag { tagFilePath = TagFilePath fp } =- tag { tagFilePath =- TagFilePath- (Text.decodeUtf8- (fixFilePath cwd tagsDir- (Text.encodeUtf8 fp)))- }-- #if __GLASGOW_HASKELL__ >= 810 -- -- Tags for Template-Haskell splices@@ -413,13 +397,21 @@ lockFile = sourceFile ++ ".lock" withMetaD defaultRunMeta request expr $ \decls ->- GhcPlugins.liftIO $ withFileLock lockFile ExclusiveLock $ \_ -> do+ GhcPlugins.liftIO $+ handle (\ioerr -> do+ putDocLn dynFlags+ (messageDoc UnhandledException Nothing+ (displayException ioerr))+ throwIO (GhcTagsDynFlagsPluginIOException ioerr)) $+ withFileLock lockFile ExclusiveLock $ \_ -> do+ cwd <- BSC.pack <$> getCurrentDirectory+ tagsDir <- BSC.pack <$> canonicalizePath (fst $ splitFileName tagsFile) tagsContent <- BSC.readFile tagsFile if etags then do pr <- ETag.parseTagsFile tagsContent case pr of- Left err -> + Left err -> printMessageDoc dynFlags ParserException Nothing err Right tags -> do@@ -427,7 +419,8 @@ tags' = sortBy ETag.compareTags $ tags ++- ghcTagToTag SingETag dynFlags+ (fmap (fixTagFilePath cwd tagsDir)+ . ghcTagToTag SingETag dynFlags) `mapMaybe` hsDeclsToGhcTags Nothing decls BSL.writeFile tagsFile (BB.toLazyByteString $ ETag.formatTagsFile tags')@@ -441,13 +434,14 @@ let tags' :: [Either CTag.Header CTag] tags' = Left `map` headers ++ Right `map`- sortBy CTag.compareTags- ( tags- ++ - ghcTagToTag SingCTag dynFlags- `mapMaybe`- hsDeclsToGhcTags Nothing decls- )+ sortBy CTag.compareTags+ ( tags+ +++ (fmap (fixTagFilePath cwd tagsDir)+ . ghcTagToTag SingCTag dynFlags)+ `mapMaybe`+ hsDeclsToGhcTags Nothing decls+ ) BSL.writeFile tagsFile (BB.toLazyByteString $ CTag.formatTagsFile tags') Failure (ParserFailure f) ->@@ -476,10 +470,42 @@ MetaAW k -> k <$> GhcPlugins.metaRequestAW h e #endif + ----- Error Formatting+-- File path utils -- +fixFilePath :: RawFilePath+ -- ^ curent directory+ -> RawFilePath+ -- ^ tags file directory+ -> RawFilePath+ -- ^ tag's file path+ -> RawFilePath+fixFilePath cwd tagsDir =+ FilePath.normalise+ . FilePath.makeRelative tagsDir+ . (cwd FilePath.</>)+++-- we are missing `Text` based `FilePath` library!+fixTagFilePath :: RawFilePath+ -- ^ current directory+ -> RawFilePath+ -- ^ tags file directory+ -> Tag tk -> Tag tk+fixTagFilePath cwd tagsDir tag@Tag { tagFilePath = TagFilePath fp } =+ tag { tagFilePath =+ TagFilePath+ (Text.decodeUtf8+ (fixFilePath cwd tagsDir+ (Text.encodeUtf8 fp)))+ }++--+-- Error Formattng+--+ data MessageSeverity = Debug | Warning@@ -546,7 +572,7 @@ throwErrnoIfMinus1_ "ghc-tags-plugin" (c_fdatasync fdFD) foreign import ccall safe "fdatasync"- c_fdatasync :: CInt -> IO CInt + c_fdatasync :: CInt -> IO CInt #else hDataSync :: Handle -> IO () hDataSync _ = pure ()