diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. 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.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. diff --git a/src/GhcTags/CTag/Formatter.hs b/src/GhcTags/CTag/Formatter.hs --- a/src/GhcTags/CTag/Formatter.hs +++ b/src/GhcTags/CTag/Formatter.hs @@ -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 diff --git a/src/GhcTags/CTag/Header.hs b/src/GhcTags/CTag/Header.hs --- a/src/GhcTags/CTag/Header.hs +++ b/src/GhcTags/CTag/Header.hs @@ -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) diff --git a/src/GhcTags/CTag/Parser.hs b/src/GhcTags/CTag/Parser.hs --- a/src/GhcTags/CTag/Parser.hs +++ b/src/GhcTags/CTag/Parser.hs @@ -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 diff --git a/src/GhcTags/Config/Args.hs b/src/GhcTags/Config/Args.hs --- a/src/GhcTags/Config/Args.hs +++ b/src/GhcTags/Config/Args.hs @@ -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' diff --git a/src/GhcTags/ETag/Formatter.hs b/src/GhcTags/ETag/Formatter.hs --- a/src/GhcTags/ETag/Formatter.hs +++ b/src/GhcTags/ETag/Formatter.hs @@ -1,8 +1,7 @@ -- | Simple etags formatter. See -- 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' diff --git a/src/GhcTags/ETag/Parser.hs b/src/GhcTags/ETag/Parser.hs --- a/src/GhcTags/ETag/Parser.hs +++ b/src/GhcTags/ETag/Parser.hs @@ -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 diff --git a/src/GhcTags/Tag.hs b/src/GhcTags/Tag.hs --- a/src/GhcTags/Tag.hs +++ b/src/GhcTags/Tag.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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