diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +# ghc-tags-1.3 (2021-05-23) +* Properly escape ex mode search commands. +* Fix parsing of generated ctags file. +* Remove non-ascii kind symbols (ctags). +* Make generation of Ex mode search commands optional (ctags). +* Don't check stored mtimes if there are no tags. + # ghc-tags-1.2 (2021-05-22) * Fix sorting of ctags. * Express addresses of ctags as ex commands. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,8 +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 and other -editors) for efficient code navigation (jump to definition). +A command line tool that generates etags (Emacs) and ctags (Vim, VSCode with +[ctagsx](https://marketplace.visualstudio.com/items?itemName=jtanx.ctagsx) etc.) +for efficient code navigation (jump to definition). Main features: * Leverages GHC API to obtain accurate information. 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.2 +version: 1.3 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. @@ -33,7 +33,7 @@ else build-depends: ghc-lib == 9.0.* - build-depends: base >=4.14 && <5 + build-depends: base >=4.14 && <4.16 , aeson , async , attoparsec 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 @@ -174,20 +174,20 @@ , Header FieldDescription haskellLang "instance" "class, type or data type instance" , Header FieldDescription haskellLang "Kind" "kind of a type" - , Header KindDescription haskellLang "`" "module top level term, but not a function" - , Header KindDescription haskellLang "λ" "module top level function term" - , Header KindDescription haskellLang "Λ" "type constructor" + , Header KindDescription haskellLang "M" "module" + , Header KindDescription haskellLang "f" "function" + , Header KindDescription haskellLang "A" "type constructor" , Header KindDescription haskellLang "c" "data constructor" , Header KindDescription haskellLang "g" "gadt constructor" , Header KindDescription haskellLang "r" "record field" - , Header KindDescription haskellLang "≡" "type synonym" - , Header KindDescription haskellLang "~" "type signature" + , Header KindDescription haskellLang "=" "type synonym" + , Header KindDescription haskellLang ":" "type signature" , Header KindDescription haskellLang "p" "pattern synonym" , Header KindDescription haskellLang "C" "type class" , Header KindDescription haskellLang "m" "type class member" , Header KindDescription haskellLang "i" "type class instance" - , Header KindDescription haskellLang "F" "type family" - , Header KindDescription haskellLang "f" "type family instance" + , Header KindDescription haskellLang "T" "type family" + , Header KindDescription haskellLang "t" "type family instance" , Header KindDescription haskellLang "D" "data type family" , Header KindDescription haskellLang "d" "data type family instance" , Header KindDescription haskellLang "I" "foreign import" 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 @@ -12,13 +12,12 @@ import Control.DeepSeq (NFData) import Data.Attoparsec.Text (Parser, ()) import qualified Data.Attoparsec.Text as AT -import Data.Functor (void, ($>)) +import Data.Functor (($>)) import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text as Text import GhcTags.Tag -import qualified GhcTags.Utils as Utils import GhcTags.CTag.Header import GhcTags.CTag.Utils @@ -42,37 +41,28 @@ <*> parseFileName <* separator - -- includes an optional ';"' separator <*> parseTagAddress - <*> ( -- kind field followed by list of fields or end of line, e.g. - -- '(TagField, CTagFields)'. - ((,) <$> ( separator *> parseKindField ) - <*> ( separator *> parseFields <* endOfLine - <|> - 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 - ) + <*> ( -- kind followed by list of fields or end of line + (,) <$ AT.string ";\"" + <* separator + <*> (charToTagKind <$> AT.satisfy notTabOrNewLine) + <*> fieldsInLine -- 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. - <|> (NoKind, ) - <$> ( separator *> parseFields <* endOfLine - <|> - endOfLine $> mempty - ) + <|> (NoKind, ) <$ AT.string ";\"" + <*> fieldsInLine <|> endOfLine $> (NoKind, mempty) ) where + fieldsInLine :: Parser CTagFields + fieldsInLine = separator *> parseFields <* endOfLine + <|> + endOfLine $> mempty + separator :: Parser Char separator = AT.char '\t' @@ -83,37 +73,25 @@ parseFileName :: Parser TagFileName parseFileName = TagFileName <$> AT.takeWhile (/= '\t') - parseExCommand :: Parser ExCommand - parseExCommand = (\x -> ExCommand $ Text.take (Text.length x - 1) x) - <$> AT.scan "" go - <* AT.anyChar + parseExSearchCommand :: Parser ExCommand + parseExSearchCommand = ExCommand <$> AT.scan (Nothing, '\0', '\\') go where - -- go until either eol or ';"' sequence is found. - go :: String -> Char -> Maybe String - - go !s c | -- eol - take (length Utils.endOfLine) (c : s) - == reverse Utils.endOfLine - = Nothing - - | -- ';"' sequence - l == "\";" = Nothing + go :: (Maybe Char, Char, Char) -> Char -> Maybe (Maybe Char, Char, Char) + go (Nothing, c0, c1) delim + -- Support both forward and backward searches. + | delim == '/' || delim == '?' = go (Just delim, c0, c1) delim + | otherwise = Nothing - | otherwise = Just l - where - l = take 2 (c : s) + go (jdelim@(Just delim), c0, c1) c2 + -- Continue until the next unescaped delimiter. + | c0 /= '\\' && c1 == delim = Nothing + | otherwise = Just (jdelim, c1, c2) -- We only parse `TagLine` or `TagCommand`. parseTagAddress :: Parser CTagAddress - parseTagAddress = - TagLine <$> AT.decimal <* (endOfLine <|> void (AT.string ";\"")) - <|> - TagCommand <$> parseExCommand - - parseKindField :: Parser CTagKind - parseKindField = - charToTagKind <$> - (AT.string "kind:" *> AT.satisfy notTabOrNewLine) + parseTagAddress = TagLine <$> AT.decimal + <|> + TagCommand <$> parseExSearchCommand parseFields :: Parser CTagFields parseFields = TagFields <$> AT.sepBy parseField separator diff --git a/src/GhcTags/CTag/Utils.hs b/src/GhcTags/CTag/Utils.hs --- a/src/GhcTags/CTag/Utils.hs +++ b/src/GhcTags/CTag/Utils.hs @@ -9,21 +9,22 @@ tagKindToChar :: CTagKind -> Maybe Char tagKindToChar tk = case tk of + -- No 'F' kind since it's for a filename. TkModule -> Just 'M' TkTerm -> Just '`' - TkFunction -> Just 'λ' - TkTypeConstructor -> Just 'Λ' + TkFunction -> Just 'f' + TkTypeConstructor -> Just 'A' TkDataConstructor -> Just 'c' TkGADTConstructor -> Just 'g' TkRecordField -> Just 'r' - TkTypeSynonym -> Just '≡' - TkTypeSignature -> Just '⊢' + TkTypeSynonym -> Just '=' + TkTypeSignature -> Just ':' TkPatternSynonym -> Just 'p' TkTypeClass -> Just 'C' TkTypeClassMember -> Just 'm' TkTypeClassInstance -> Just 'i' - TkTypeFamily -> Just 'f' - TkTypeFamilyInstance -> Just 'F' + TkTypeFamily -> Just 'T' + TkTypeFamilyInstance -> Just 't' TkDataTypeFamily -> Just 'd' TkDataTypeFamilyInstance -> Just 'D' TkForeignImport -> Just 'I' @@ -37,19 +38,19 @@ charToTagKind c = case c of 'M' -> TkModule '`' -> TkTerm - 'λ' -> TkFunction - 'Λ' -> TkTypeConstructor + 'f' -> TkFunction + 'A' -> TkTypeConstructor 'c' -> TkDataConstructor 'g' -> TkGADTConstructor 'r' -> TkRecordField - '≡' -> TkTypeSynonym - '⊢' -> TkTypeSignature + '=' -> TkTypeSynonym + ':' -> TkTypeSignature 'p' -> TkPatternSynonym 'C' -> TkTypeClass 'm' -> TkTypeClassMember 'i' -> TkTypeClassInstance - 'f' -> TkTypeFamily - 'F' -> TkTypeFamilyInstance + 't' -> TkTypeFamily + 'T' -> TkTypeFamilyInstance 'd' -> TkDataTypeFamily 'D' -> TkDataTypeFamilyInstance 'I' -> TkForeignImport 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 @@ -23,14 +23,16 @@ , aTagFile :: FilePath , aThreads :: Int , aSourcePaths :: SourcePaths + , aExModeSearch :: Bool } deriving Show argsParser :: Int -> Parser Args argsParser defaultThreads = do - aTagType <- ctags <|> etags - aTagFile0 <- tagFile - aThreads <- threads - aSourcePaths <- (SourceArgs <$> sourcePaths) <|> (ConfigFile <$> configFile) + aTagType <- ctags <|> etags + aTagFile0 <- tagFile + aThreads <- threads + aSourcePaths <- (SourceArgs <$> sourcePaths) <|> (ConfigFile <$> configFile) + aExModeSearch <- exModeSearch pure $ Args { aTagFile = if null aTagFile0 then defaultOutputFile aTagType else aTagFile0 @@ -62,9 +64,6 @@ <> showDefaultWith id <> help "Configuration file" - sourcePaths :: Parser [FilePath] - sourcePaths = some . argument str $ metavar "" - threads :: Parser Int threads = option auto $ long "threads" <> short 'j' @@ -72,6 +71,13 @@ <> value defaultThreads <> showDefault <> help "Number of threads to use" + + sourcePaths :: Parser [FilePath] + sourcePaths = some . argument str $ metavar "" + + exModeSearch :: Parser Bool + exModeSearch = switch $ long "ex-mode-search" + <> help "Use Ex mode commands instead of line numbers (ctags)" parseArgs :: Int -> [String] -> IO Args parseArgs defaultThreads = handleParseResult . execParserPure defaultPrefs opts diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -182,7 +182,7 @@ forM_ pcs $ generateTagsForProject (aThreads args) wd setNumCapabilities 1 - cleanTagMap <- withMVar (wdTags wd) cleanupTags + cleanTagMap <- withMVar (wdTags wd) (cleanupTags args) writeTags (aTagFile args) cleanTagMap withMVar (wdTimes wd) $ writeTimes (timesFile args) <=< cleanupTimes cleanTagMap where @@ -190,10 +190,15 @@ initWorkerData :: Args -> Int -> IO WorkerData initWorkerData args threads = do - wdTags <- newMVar =<< case aTagType args of + tags@DirtyTags{dtTags} <- case aTagType args of ETag -> readTags SingETag (aTagFile args) CTag -> readTags SingCTag (aTagFile args) - wdTimes <- newMVar =<< readTimes (timesFile args) + -- If tags are empty there is no point looking at mtimes. + mtimes <- if Map.null dtTags + then pure Map.empty + else readTimes (timesFile args) + wdTags <- newMVar tags + wdTimes <- newMVar mtimes wdQueue <- newTBQueueIO (fromIntegral threads) pure WorkerData{..} @@ -303,8 +308,8 @@ $ getGhcTags hsModule in Map.map (Updated True) $!! tags -cleanupTags :: DirtyTags -> IO Tags -cleanupTags DirtyTags{..} = do +cleanupTags :: Args -> DirtyTags -> IO Tags +cleanupTags args DirtyTags{..} = do newTags <- (`Map.traverseMaybeWithKey` dtTags) $ \file (Updated updated tags) -> do let path = T.unpack $ getTagFileName file -- The file might not exists even though it was updated, e.g. when .x files @@ -314,7 +319,9 @@ if | exists && updated -> do let cleanedTags = ignoreSimilarClose $ sortBy compareNAK tags case dtKind of - SingCTag -> addExCommands file cleanedTags + SingCTag -> if aExModeSearch args + then addExCommands file cleanedTags + else pure $ Just cleanedTags SingETag -> addFileOffsets file cleanedTags | exists && not updated -> pure $ Just tags | otherwise -> pure Nothing @@ -346,8 +353,8 @@ ) 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. +-- | Convert 'tagAddress' of CTags to an Ex mode search command as some editors +-- (e.g. Kate) 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 @@ -364,8 +371,13 @@ TagCommand{} -> Just tag TagLine lineNo -> do line <- fileLines V.!? (lineNo - 1) - let exCommand = mconcat ["/^" , T.decodeUtf8 line, "$/"] - pure tag { tagAddr = TagCommand $ ExCommand exCommand } + let TagFields fields = tagFields tag + -- Ex mode forward search command. Slashes need to be escaped. + exCommand = T.concat ["/^", T.replace "/" "\\/" $ T.decodeUtf8 line, "$/"] + pure tag + { tagAddr = TagCommand $ ExCommand exCommand + , tagFields = TagFields $ TagField "line" (T.pack $ show lineNo) : fields + } -- | Add file offsets to etags from a specific file. addFileOffsets :: TagFileName -> [ETag] -> IO (Maybe [ETag])