ghc-tags 1.1 → 1.2
raw patch · 10 files changed
+198/−184 lines, 10 files
Files
- CHANGELOG.md +5/−0
- ghc-tags.cabal +1/−1
- src/GhcTags/CTag/Formatter.hs +19/−7
- src/GhcTags/CTag/Header.hs +12/−7
- src/GhcTags/CTag/Parser.hs +17/−26
- src/GhcTags/Config/Args.hs +9/−12
- src/GhcTags/ETag/Formatter.hs +2/−18
- src/GhcTags/ETag/Parser.hs +1/−1
- src/GhcTags/Tag.hs +87/−89
- src/Main.hs +45/−23
CHANGELOG.md view
@@ -1,3 +1,8 @@+# ghc-tags-1.2 (2021-05-22)+* Fix sorting of ctags.+* Express addresses of ctags as ex commands.+* Improve performance of parsing a ctags file.+ # ghc-tags-1.1 (2021-05-18) * Fix compatibility with GHC 8.10. * Drop support for GHC 8.8.
ghc-tags.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghc-tags-version: 1.1+version: 1.2 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.
src/GhcTags/CTag/Formatter.hs view
@@ -11,6 +11,7 @@ import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as BS import Data.Char (isAscii)+import Data.List (sortBy) import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text.Encoding as Text@@ -41,16 +42,13 @@ <> formatKindChar tagKind -- tag fields- <> foldMap ((BS.charUtf8 '\t' <>) . formatField) tagFields + <> foldMap ((BS.charUtf8 '\t' <>) . formatField) tagFields <> BS.stringUtf8 endOfLine where formatTagAddress :: CTagAddress -> Builder- formatTagAddress (TagLineCol lineNo _colNo) =- BS.intDec lineNo -- Vim only allows to use ranges; there's no way to- -- specify column (`c|` command is not allowed) formatTagAddress (TagLine lineNo) = BS.intDec lineNo formatTagAddress (TagCommand exCommand) =@@ -129,6 +127,20 @@ formatTagsFile :: [Header] -- ^ Headers -> CTagMap -- ^ 'CTag's -> Builder-formatTagsFile headers tags =- foldMap formatHeader headers- <> Map.foldMapWithKey (foldMap . formatTag) tags+formatTagsFile headers tags = foldMap formatHeader headers+ <> (foldMap formatTagLine . sortBy compareTagLine+ . Map.foldrWithKey concatTags []+ $ tags)+ where+ concatTags :: TagFileName -> [CTag] -> [CTagLine] -> [CTagLine]+ concatTags file ts acc = map (CTagLine file) ts ++ acc++ compareTagLine :: CTagLine -> CTagLine -> Ordering+ compareTagLine (CTagLine file0 tag0) (CTagLine file1 tag1) =+ compareTags tag0 tag1 <> compare file0 file1++ formatTagLine :: CTagLine -> Builder+ formatTagLine (CTagLine file tag) = formatTag file tag++-- | Helper data type for 'formatTagsFile'.+data CTagLine = CTagLine TagFileName CTag
src/GhcTags/CTag/Header.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE StandaloneDeriving #-}- module GhcTags.CTag.Header ( Header (..) , defaultHeaders@@ -14,6 +8,7 @@ , headerTypeSing ) where +import Control.DeepSeq import Data.Version import qualified Data.Text as T @@ -22,7 +17,7 @@ -- | A type safe representation of a /ctag/ header. -- data Header where- Header :: forall ty. Show ty =>+ Header :: forall ty. (NFData ty, Show ty) => { headerType :: HeaderType ty , headerLanguage :: Maybe T.Text , headerArg :: ty@@ -30,6 +25,12 @@ } -> Header +instance NFData Header where+ rnf Header{..} = rnf headerType+ `seq` rnf headerLanguage+ `seq` rnf headerArg+ `seq` rnf headerComment+ instance Eq Header where Header { headerType = headerType0 , headerLanguage = headerLanguage0@@ -117,6 +118,10 @@ ExtraDescription :: HeaderType T.Text FieldDescription :: HeaderType T.Text PseudoTag :: T.Text -> HeaderType T.Text++instance NFData (HeaderType ty) where+ rnf (PseudoTag t) = rnf t+ rnf ty = ty `seq` () deriving instance Eq (HeaderType ty) deriving instance Ord (HeaderType ty)
src/GhcTags/CTag/Parser.hs view
@@ -2,18 +2,16 @@ -- module GhcTags.CTag.Parser ( parseTagsFile- , parseTagLine -- * parse a ctag , parseTag -- * parse a pseudo-ctag , parseHeader ) where -import Control.Arrow ((***), second) import Control.Applicative (many, (<|>))+import Control.DeepSeq (NFData) import Data.Attoparsec.Text (Parser, (<?>)) import qualified Data.Attoparsec.Text as AT-import Data.Either (partitionEithers) import Data.Functor (void, ($>)) import qualified Data.Map.Strict as Map import Data.Text (Text)@@ -25,6 +23,7 @@ import GhcTags.CTag.Utils + -- | Parser for a 'CTag' from a single text line. -- parseTag :: Parser (TagFileName, CTag)@@ -54,22 +53,22 @@ endOfLine $> mempty) ) + -- kind encoded as a single letter, followed by a list+ -- of fields or end of line.+ <|> (,) <$> ( separator *> (charToTagKind <$> AT.satisfy notTabOrNewLine) )+ <*> ( separator *> parseFields <* endOfLine+ <|>+ endOfLine $> mempty+ )+ -- list of fields (kind field might be later, but don't check it, we -- always format it as the first field) or end of line.- <|> curry id NoKind+ <|> (NoKind, ) <$> ( separator *> parseFields <* endOfLine <|> endOfLine $> mempty ) - -- kind encoded as a single letter, followed by a list- -- of fields or end of line.- <|> curry (charToTagKind *** id)- <$> ( separator *> AT.satisfy notTabOrNewLine )- <*> ( separator *> parseFields <* endOfLine- <|>- endOfLine $> mempty- ) <|> endOfLine $> (NoKind, mempty) ) @@ -131,19 +130,11 @@ -- | A vim-style tag file parser. -- parseTags :: Parser ([Header], CTagMap)-parseTags = second (Map.fromListWith (++) . map (second (:[])))- . partitionEithers- <$> many parseTagLine----- | Parse either a header line ot a 'CTag'.----parseTagLine :: Parser (Either Header (TagFileName, CTag))-parseTagLine =- AT.eitherP- (parseHeader <?> "failed parsing tag")- (parseTag <?> "failed parsing header")-+parseTags = (\headers tags -> (headers, Map.fromListWith (++) $ map sndList tags))+ <$> many parseHeader+ <*> many parseTag+ where+ sndList (file, tag) = (file, [tag]) parseHeader :: Parser Header parseHeader = do@@ -198,7 +189,7 @@ error "parseHeader: impossible happened" where- parsePseudoTagArgs :: Show ty+ parsePseudoTagArgs :: (NFData ty, Show ty) => HeaderType ty -> Parser ty -> Parser Header
src/GhcTags/Config/Args.hs view
@@ -5,15 +5,12 @@ import Options.Applicative import GhcTags.Config.Project+import GhcTags.Tag import Paths_ghc_tags (version) --- | Generate either ctags or etags.-data TagType = CTags | ETags- deriving Show- defaultOutputFile :: TagType -> FilePath-defaultOutputFile CTags = "tags"-defaultOutputFile ETags = "TAGS"+defaultOutputFile CTag = "tags"+defaultOutputFile ETag = "TAGS" -- | Get source paths from the configuration file or command line arguments. data SourcePaths@@ -41,14 +38,14 @@ } where ctags :: Parser TagType- ctags = flag' CTags $ long "ctags"- <> short 'c'- <> help "Generate ctags"+ ctags = flag' CTag $ long "ctags"+ <> short 'c'+ <> help "Generate ctags" etags :: Parser TagType- etags = flag' ETags $ long "etags"- <> short 'e'- <> help "Generate etags"+ etags = flag' ETag $ long "etags"+ <> short 'e'+ <> help "Generate etags" tagFile :: Parser FilePath tagFile = strOption $ short 'f'
src/GhcTags/ETag/Formatter.hs view
@@ -1,8 +1,7 @@ -- | Simple etags formatter. See <https://en.wikipedia.org/wiki/Ctags#Etags> -- module GhcTags.ETag.Formatter- ( withByteOffset- , formatETagsFile + ( formatETagsFile , formatTagsFile , formatTag , BuilderWithSize (..)@@ -11,7 +10,6 @@ import qualified Data.ByteString as BS import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as BB-import Data.Foldable (foldl') import qualified Data.Map.Strict as Map import qualified Data.Text.Encoding as Text @@ -32,22 +30,8 @@ instance Monoid BuilderWithSize where mempty = BuilderWithSize mempty 0 -computeByteOffset- :: [Int]- -- ^ lengths of lines- -> ETagAddress- -> ETagAddress-computeByteOffset ll (TagLineCol line col) = TagLineCol line byteOffset- where- byteOffset =- foldl' (+) 0 (take (pred line) ll)- + col--withByteOffset :: [Int] -> ETag -> ETag-withByteOffset ll tag@Tag { tagAddr } = tag { tagAddr = computeByteOffset ll tagAddr }- formatTag :: ETag -> BuilderWithSize-formatTag Tag {tagName, tagAddr = TagLineCol lineNr byteOffset, tagDefinition} =+formatTag Tag {tagName, tagAddr = TagLineOff lineNr byteOffset, tagDefinition} = flip BuilderWithSize tagSize $ BB.byteString tagDefinitionBS <> BB.charUtf8 '\DEL' -- or '\x7f'
src/GhcTags/ETag/Parser.hs view
@@ -63,7 +63,7 @@ Nothing -> TagName tagDefinition Just name -> name , tagKind = NoKind- , tagAddr = TagLineCol lineNo byteOffset+ , tagAddr = TagLineOff lineNo byteOffset , tagDefinition = case mTagName of Nothing -> NoTagDefinition Just _ -> TagDefinition tagDefinition
src/GhcTags/Tag.hs view
@@ -1,7 +1,7 @@ module GhcTags.Tag ( -- * Tag- TAG_KIND (..)- , SingTagKind (..)+ TagType (..)+ , SingTagType (..) , Tag (..) , ETag , CTag@@ -44,7 +44,6 @@ ( SrcSpan (..) , srcSpanFile , srcSpanStartLine- , srcSpanStartCol ) import GhcTags.Ghc ( GhcTag (..)@@ -56,16 +55,17 @@ -- Tag -- --- | Promoted data type used to disntinguish 'CTAG's from 'ETAG's.+-- | Promoted data type used to disntinguish 'CTag's from 'ETag's. ---data TAG_KIND = CTAG | ETAG+data TagType = CTag | ETag+ deriving Show -- | Singletons for promoted types. ---data SingTagKind (tk :: TAG_KIND) where- SingCTag :: SingTagKind 'CTAG- SingETag :: SingTagKind 'ETAG+data SingTagType (tt :: TagType) where+ SingCTag :: SingTagType 'CTag+ SingETag :: SingTagType 'ETag -- | 'ByteString' which encodes a tag name.@@ -109,38 +109,38 @@ -- * 'TkForeignImport' - @I@ -- * 'TkForeignExport' - @E@ ---data TagKind (tk :: TAG_KIND) where- TkModule :: TagKind tk- TkTerm :: TagKind tk- TkFunction :: TagKind tk- TkTypeConstructor :: TagKind tk- TkDataConstructor :: TagKind tk- TkGADTConstructor :: TagKind tk- TkRecordField :: TagKind tk- TkTypeSynonym :: TagKind tk- TkTypeSignature :: TagKind tk- TkPatternSynonym :: TagKind tk- TkTypeClass :: TagKind tk- TkTypeClassMember :: TagKind tk- TkTypeClassInstance :: TagKind tk- TkTypeFamily :: TagKind tk- TkTypeFamilyInstance :: TagKind tk- TkDataTypeFamily :: TagKind tk- TkDataTypeFamilyInstance :: TagKind tk- TkForeignImport :: TagKind tk- TkForeignExport :: TagKind tk- CharKind :: Char -> TagKind tk- NoKind :: TagKind tk+data TagKind (tt :: TagType) where+ TkModule :: TagKind tt+ TkTerm :: TagKind tt+ TkFunction :: TagKind tt+ TkTypeConstructor :: TagKind tt+ TkDataConstructor :: TagKind tt+ TkGADTConstructor :: TagKind tt+ TkRecordField :: TagKind tt+ TkTypeSynonym :: TagKind tt+ TkTypeSignature :: TagKind tt+ TkPatternSynonym :: TagKind tt+ TkTypeClass :: TagKind tt+ TkTypeClassMember :: TagKind tt+ TkTypeClassInstance :: TagKind tt+ TkTypeFamily :: TagKind tt+ TkTypeFamilyInstance :: TagKind tt+ TkDataTypeFamily :: TagKind tt+ TkDataTypeFamilyInstance :: TagKind tt+ TkForeignImport :: TagKind tt+ TkForeignExport :: TagKind tt+ CharKind :: Char -> TagKind tt+ NoKind :: TagKind tt -instance NFData (TagKind tk) where+instance NFData (TagKind tt) where rnf x = x `seq` () -type CTagKind = TagKind 'CTAG-type ETagKind = TagKind 'ETAG+type CTagKind = TagKind 'CTag+type ETagKind = TagKind 'ETag -deriving instance Eq (TagKind tk)-deriving instance Ord (TagKind tk)-deriving instance Show (TagKind tk)+deriving instance Eq (TagKind tt)+deriving instance Ord (TagKind tt)+deriving instance Show (TagKind tt) newtype ExCommand = ExCommand { getExCommand :: Text }@@ -149,53 +149,50 @@ -- | Tag address, either from a parsed file or from Haskell's AST> ---data TagAddress (tk :: TAG_KIND) where- -- | Precise addres: line and column. This is what we infer from @GHC@- -- AST.- --- -- The two arguments are line number and either column number or offset- -- from the begining of the file.+data TagAddress (tt :: TagType) where+ -- | Address of an etag is a line number and byte offset from the begining+ -- of the file. --- TagLineCol :: Int -> Int -> TagAddress tk+ TagLineOff :: Int -> Int -> TagAddress 'ETag -- | ctags can only use range ex-commands as an address (or a sequence of -- them separated by `;`). We parse line number specifically, since they -- are useful for ordering tags. --- TagLine :: Int -> TagAddress 'CTAG+ TagLine :: Int -> TagAddress 'CTag -- | A tag address can be just an ex command. --- TagCommand :: ExCommand -> TagAddress 'CTAG+ TagCommand :: ExCommand -> TagAddress 'CTag -instance NFData (TagAddress tk) where+instance NFData (TagAddress tt) where rnf x = x `seq` () -- | 'CTag' addresses. ---type CTagAddress = TagAddress 'CTAG+type CTagAddress = TagAddress 'CTag -- | 'ETag' addresses. ---type ETagAddress = TagAddress 'ETAG+type ETagAddress = TagAddress 'ETag -deriving instance Eq (TagAddress tk)-deriving instance Ord (TagAddress tk)-deriving instance Show (TagAddress tk)+deriving instance Eq (TagAddress tt)+deriving instance Ord (TagAddress tt)+deriving instance Show (TagAddress tt) -- | Emacs tags specific field. ---data TagDefinition (tk :: TAG_KIND) where- TagDefinition :: Text -> TagDefinition 'ETAG- NoTagDefinition :: TagDefinition tk+data TagDefinition (tt :: TagType) where+ TagDefinition :: Text -> TagDefinition 'ETag+ NoTagDefinition :: TagDefinition tt -instance NFData (TagDefinition tk) where+instance NFData (TagDefinition tt) where rnf x = x `seq` () -deriving instance Show (TagDefinition tk)-deriving instance Eq (TagDefinition tk)+deriving instance Show (TagDefinition tt)+deriving instance Eq (TagDefinition tt) -- | Unit of data associated with a tag. Vim natively supports `file:` and -- `kind:` tags but it can display any other tags too.@@ -218,61 +215,61 @@ -- | Ctags specific list of 'TagField's. ---data TagFields (tk :: TAG_KIND) where- NoTagFields :: TagFields 'ETAG+data TagFields (tt :: TagType) where+ NoTagFields :: TagFields 'ETag TagFields :: [TagField]- -> TagFields 'CTAG+ -> TagFields 'CTag -instance NFData (TagFields tk) where+instance NFData (TagFields tt) where rnf NoTagFields = () rnf (TagFields fs) = rnf fs -deriving instance Show (TagFields tk)-deriving instance Eq (TagFields tk)-instance Semigroup (TagFields tk) where+deriving instance Show (TagFields tt)+deriving instance Eq (TagFields tt)+instance Semigroup (TagFields tt) where NoTagFields <> NoTagFields = NoTagFields (TagFields a) <> (TagFields b) = TagFields (a ++ b)-instance Monoid (TagFields 'CTAG) where+instance Monoid (TagFields 'CTag) where mempty = TagFields mempty-instance Monoid (TagFields 'ETAG) where+instance Monoid (TagFields 'ETag) where mempty = NoTagFields -type CTagFields = TagFields 'CTAG-type ETagFields = TagFields 'ETAG+type CTagFields = TagFields 'CTag+type ETagFields = TagFields 'ETag -- | Tag record. For either ctags or etags formats. It is either filled with -- information parsed from a tags file or from *GHC* ast. ---data Tag (tk :: TAG_KIND) = Tag+data Tag (tt :: TagType) = Tag { tagName :: TagName -- ^ name of the tag- , tagKind :: TagKind tk+ , tagKind :: TagKind tt -- ^ ctags specifc field, which classifies tags- , tagAddr :: TagAddress tk+ , tagAddr :: TagAddress tt -- ^ address in source file- , tagDefinition :: TagDefinition tk+ , tagDefinition :: TagDefinition tt -- ^ etags specific field; only tags read from emacs tags file contain this -- field.- , tagFields :: TagFields tk+ , tagFields :: TagFields tt -- ^ ctags specific field } deriving (Show, Eq) -instance NFData (Tag tk) where+instance NFData (Tag tt) where rnf Tag{..} = rnf tagName `seq` rnf tagKind `seq` rnf tagAddr `seq` rnf tagDefinition `seq` rnf tagFields -type CTag = Tag 'CTAG-type ETag = Tag 'ETAG+type CTag = Tag 'CTag+type ETag = Tag 'ETag -type TagMap tk = Map TagFileName [Tag tk]-type CTagMap = TagMap 'CTAG-type ETagMap = TagMap 'ETAG+type TagMap tt = Map TagFileName [Tag tt]+type CTagMap = TagMap 'CTag+type ETagMap = TagMap 'ETag -- | Total order relation on 'Tag' elements. --@@ -291,7 +288,7 @@ -- -- prop> a == b => compareTags a b == EQ ---compareTags :: forall (tk :: TAG_KIND). Ord (TagAddress tk) => Tag tk -> Tag tk -> Ordering+compareTags :: forall (tt :: TagType). Ord (TagAddress tt) => Tag tt -> Tag tt -> Ordering compareTags t0 t1 = on compare tagName t0 t1 -- sort type classes / type families before their instances, -- and take precendence over a file where they are defined.@@ -303,7 +300,7 @@ <> on compare tagKind t0 t1 where- getTkClass :: Tag tk -> Maybe (TagKind tk)+ getTkClass :: Tag tt -> Maybe (TagKind tt) getTkClass t = case tagKind t of TkTypeClass -> Just TkTypeClass TkTypeClassInstance -> Just TkTypeClassInstance@@ -319,7 +316,7 @@ -- | Create a 'Tag' from 'GhcTag'. ---ghcTagToTag :: SingTagKind tk -> DynFlags -> GhcTag -> Maybe (TagFileName, Tag tk)+ghcTagToTag :: SingTagType tt -> DynFlags -> GhcTag -> Maybe (TagFileName, Tag tt) ghcTagToTag sing dynFlags GhcTag { gtSrcSpan, gtTag, gtKind, gtIsExported, gtFFI } = case gtSrcSpan of UnhelpfulSpan {} -> Nothing@@ -327,8 +324,9 @@ Just . (fileName realSrcSpan, ) $ Tag { tagName = TagName tagName - , tagAddr = TagLineCol (srcSpanStartLine realSrcSpan)- (srcSpanStartCol realSrcSpan)+ , tagAddr = case sing of+ SingETag -> TagLineOff (srcSpanStartLine realSrcSpan) 0+ SingCTag -> TagLine (srcSpanStartLine realSrcSpan) , tagKind = fromGhcTagKind gtKind @@ -345,7 +343,7 @@ tagName = Text.decodeUtf8 gtTag - fromGhcTagKind :: GhcTagKind -> TagKind tk+ fromGhcTagKind :: GhcTagKind -> TagKind tt fromGhcTagKind = \case GtkModule -> TkModule GtkTerm -> TkTerm@@ -369,7 +367,7 @@ GtkForeignExport -> TkForeignExport -- static field (wheather term is exported or not)- staticField :: SingTagKind tk -> TagFields tk+ staticField :: SingTagType tt -> TagFields tt staticField = \case SingETag -> NoTagFields SingCTag ->@@ -379,7 +377,7 @@ else [fileField] -- ffi field- ffiField :: SingTagKind tk -> TagFields tk+ ffiField :: SingTagType tt -> TagFields tt ffiField = \case SingETag -> NoTagFields SingCTag ->@@ -390,7 +388,7 @@ -- 'TagFields' from 'GhcTagKind'- kindField :: SingTagKind tk -> TagFields tk+ kindField :: SingTagType tt -> TagFields tt kindField = \case SingETag -> NoTagFields SingCTag ->@@ -436,7 +434,7 @@ -- fields -- - mkField :: Out.Outputable p => Text -> p -> TagFields 'CTAG+ mkField :: Out.Outputable p => Text -> p -> TagFields 'CTag mkField fieldName p = TagFields [ TagField
src/Main.hs view
@@ -191,8 +191,8 @@ initWorkerData :: Args -> Int -> IO WorkerData initWorkerData args threads = do wdTags <- newMVar =<< case aTagType args of- ETags -> readTags SingETag (aTagFile args)- CTags -> readTags SingCTag (aTagFile args)+ ETag -> readTags SingETag (aTagFile args)+ CTag -> readTags SingCTag (aTagFile args) wdTimes <- newMVar =<< readTimes (timesFile args) wdQueue <- newTBQueueIO (fromIntegral threads) pure WorkerData{..}@@ -244,29 +244,31 @@ ---------------------------------------- -data DirtyTags = forall tk. DirtyTags- { dtKind :: SingTagKind tk+data DirtyTags = forall tt. DirtyTags+ { dtKind :: SingTagType tt , dtHeaders :: [CTag.Header]- , dtTags :: Map.Map TagFileName (Updated [Tag tk])+ , dtTags :: Map.Map TagFileName (Updated [Tag tt]) } -data Tags = forall tk. Tags- { tKind :: SingTagKind tk+data Tags = forall tt. Tags+ { tKind :: SingTagType tt , tHeaders :: [CTag.Header]- , tTags :: Map.Map TagFileName [Tag tk]+ , tTags :: Map.Map TagFileName [Tag tt] } -readTags :: forall tk. SingTagKind tk -> FilePath -> IO DirtyTags-readTags tk tagsFile = doesFileExist tagsFile >>= \case+readTags :: forall tt. SingTagType tt -> FilePath -> IO DirtyTags+readTags tt tagsFile = doesFileExist tagsFile >>= \case False -> pure newDirtyTags True -> do res <- tryIOError $ parseTagsFile . T.decodeUtf8 =<< BS.readFile tagsFile case res of Right (Right (headers, tags)) ->- pure $ DirtyTags { dtKind = tk- , dtHeaders = headers- , dtTags = Map.map (Updated False) tags- }+ -- full evaluation decreases performance variation+ deepseq headers . deepseq tags $ pure DirtyTags+ { dtKind = tt+ , dtHeaders = headers+ , dtTags = Map.map (Updated False) tags+ } -- reading failed Left err -> do putStrLn $ "Error while reading " ++ tagsFile ++ ": " ++ show err@@ -276,15 +278,15 @@ putStrLn $ "Error while parsing " ++ tagsFile ++ ": " ++ show err pure newDirtyTags where- newDirtyTags = DirtyTags { dtKind = tk+ newDirtyTags = DirtyTags { dtKind = tt , dtHeaders = [] , dtTags = Map.empty } parseTagsFile :: T.Text- -> IO (Either String ([CTag.Header], Map.Map TagFileName [Tag tk]))- parseTagsFile = case tk of+ -> IO (Either String ([CTag.Header], Map.Map TagFileName [Tag tt]))+ parseTagsFile = case tt of SingETag -> fmap (fmap ([], )) . ETag.parseTagsFile SingCTag -> CTag.parseTagsFile @@ -312,7 +314,7 @@ if | exists && updated -> do let cleanedTags = ignoreSimilarClose $ sortBy compareNAK tags case dtKind of- SingCTag -> pure $ Just cleanedTags+ SingCTag -> addExCommands file cleanedTags SingETag -> addFileOffsets file cleanedTags | exists && not updated -> pure $ Just tags | otherwise -> pure Nothing@@ -344,6 +346,27 @@ ) ignoreSimilarClose tags = tags +-- | Convert 'tagAddress' of CTags to an ex command as editors such as Kate or+-- VSCode don't support jumping to a line number and require a line match.+addExCommands :: TagFileName -> [CTag] -> IO (Maybe [CTag])+addExCommands file tags = do+ let path = T.unpack $ getTagFileName file+ tryIOError (BS.readFile path) >>= \case+ Left err -> do+ putStrLn $ "Unexpected error: " ++ show err+ pure Nothing+ Right content -> do+ let fileLines = V.fromList $ BS.lines content+ pure . Just $ fillExCommands fileLines tags+ where+ fillExCommands :: V.Vector BS.ByteString -> [CTag] -> [CTag]+ fillExCommands fileLines = mapMaybe $ \tag -> case tagAddr tag of+ TagCommand{} -> Just tag+ TagLine lineNo -> do+ line <- fileLines V.!? (lineNo - 1)+ let exCommand = mconcat ["/^" , T.decodeUtf8 line, "$/"]+ pure tag { tagAddr = TagCommand $ ExCommand exCommand }+ -- | Add file offsets to etags from a specific file. addFileOffsets :: TagFileName -> [ETag] -> IO (Maybe [ETag]) addFileOffsets file tags = do@@ -363,10 +386,10 @@ where fillOffsets :: V.Vector (Int, BS.ByteString) -> [ETag] -> [ETag] fillOffsets linesWithOffsets = mapMaybe $ \tag -> do- let TagLineCol lineNo _ = tagAddr tag- (lineOffset, line) <- linesWithOffsets V.!? (lineNo - 1)+ let TagLineOff lineNo _ = tagAddr tag+ (offset, line) <- linesWithOffsets V.!? (lineNo - 1) pure tag- { tagAddr = TagLineCol lineNo lineOffset+ { tagAddr = TagLineOff lineNo offset , tagDefinition = -- Prevent weird characters from ending up in the TAGS file. TagDefinition . T.takeWhile isPrint $ T.decodeUtf8 line@@ -377,8 +400,7 @@ BS.hPutBuilder h $ case tKind of SingETag -> (`Map.foldMapWithKey` tTags) $ \path -> ETag.formatTagsFile path . sortBy ETag.compareTags- SingCTag -> CTag.formatTagsFile headers $- Map.map (sortBy CTag.compareTags) tTags+ SingCTag -> CTag.formatTagsFile headers tTags where headers :: [Header] headers = if null tHeaders