diff --git a/README b/README --- a/README +++ b/README @@ -1,75 +1,82 @@ -hasktags: a tool to generate tag files for vim and emacs - - What is it for? A tag file is a index containing key items of your project such as - - function names - - module names - - data declarations - - ... +# hasktags +A tool to generate tag files for vim and emacs - so that you can find / jump to them fast. +What is it for? A tag file is a index containing key items of your project such as +- function names +- module names +- data declarations +- ... -HOWTO (GENERATING TAG FILES): - Build hasktags (standard cabal build) +So that you can find / jump to them fast. - I've been using this bash function or something similar for a long time. - It may be cumbersome but works: +## HOWTO (GENERATING TAG FILES): +Build hasktags (standard cabal build) - runHaskTagsVim() { - # use --etags instead of --ctags for emacs - hasktags --ignore-close-implementation --ctags .; sort tags - } +I've been using this bash function or something similar for a long time. +It may be cumbersome but works: -HOWTO (USING TAG FILES): - VIM: let tags+=tagifle " tags,TAGS is the default setting so probably you don't have to do anything - :tjump foo or such. See :h tags - - NEdit: - Load the "tags" file using File/Load Tags File. - Use "Ctrl-D" to search for a tag. +```bash +runHaskTagsVim() { + # use --etags instead of --ctags for emacs + hasktags --ignore-close-implementation --ctags .; sort tags +} +``` - XEmacs/Emacs: - Load the "TAGS" file using "visit-tags-table" - Use "M-." to search for a tag. +## HOWTO (USING TAG FILES): +### ViM +```viml +let tags+=tagfile " tags,TAGS is the default setting so probably you don't have to do anything +``` +`:tjump foo` or such. See `:h` tags - jedit: - There is a plugin - +### NEdit +Load the "tags" file using File/Load Tags File. +Use "Ctrl-D" to search for a tag. +### XEmacs/Emacs +Load the "TAGS" file using "visit-tags-table" +Use "M-." to search for a tag. -run test cases: - cd testcases; sh test.sh +### jedit +There is a plugin. +### Tests +To run the tests, do `cd testcases; sh test.sh`. -history: +## History In the past this tool was distributed with ghc. I forked and added some features. hasktags itself was moved out of the ghc repository. Then I only verified that my fork finds at least as much tags as the one forked by Igloo. +## Future Things which could be done in the future: - make json support optional - Marco Túlio Pimenta Gontijo proposed replacing json by aeson because it might be faster -- write a nice README.md file instead -maintainers: See cabal file +## Maintainers +See cabal file +## Comments about literate haskell ([lhs][]): +Alex no longer supports bird style ">", so should we drop support, too? -comments about literate haskell (lhs): -======================================= -http://www.haskell.org/haskellwiki/Literate_programming -alex no longer supports bird style ">", so should we drop support, too? +## Contributors +- Tsuru Capital (github/liyang) +- Marco Túlio Pimenta Gontijo (github/marcotmarcot) -contributors: - Tsuru Capital (github/liyang) - Marco Túlio Pimenta Gontijo (github/marcotmarcot) - TODO: add all people having contributed before Oct 2012 - This includes people contributing to the darcs repository as well as people - having contributed when this repository has been part of ghc +## TODO +Add all people having contributed before Oct 2012 +This includes people contributing to the darcs repository as well as people +having contributed when this repository has been part of ghc -related work (list taken from announce of lushtags: - https://github.com/bitc/lushtags - http://hackage.haskell.org/package/hasktags - http://kingfisher.nfshost.com/sw/gasbag/ - http://hackage.haskell.org/package/hothasktags - http://majutsushi.github.com/tagbar/ -and probably much more +# Related work +List taken from announce of lushtags. +- https://github.com/bitc/lushtags +- http://hackage.haskell.org/package/hasktags +- http://kingfisher.nfshost.com/sw/gasbag/ +- http://hackage.haskell.org/package/hothasktags +- http://majutsushi.github.com/tagbar/ + +And probably much more + +[lhs]: http://www.haskell.org/haskellwiki/Literate_programming diff --git a/hasktags.cabal b/hasktags.cabal --- a/hasktags.cabal +++ b/hasktags.cabal @@ -1,17 +1,18 @@ Name: hasktags -Version: 0.69.1 +Version: 0.69.2 Copyright: The University Court of the University of Glasgow License: BSD3 License-File: LICENSE Author: The GHC Team Maintainer: + Jack Henahan , Marc Weber , Marco Túlio Pimenta Gontijo homepage: http://github.com/MarcWeber/hasktags bug-reports: http://github.com/MarcWeber/hasktags/issues Synopsis: Produces ctags "tags" and etags "TAGS" files for Haskell programs Description: - Produces ctags "tags" and etags "TAGS" files for Haskell programs. + Produces ctags "tags" and etags "TAGS" files for Haskell programs. Category: Development build-type: Simple cabal-version: >=1.10 @@ -56,8 +57,8 @@ hs-source-dirs: src ghc-options: -Wall exposed-modules: Hasktags - other-modules: Tags, DebugShow - build-depends: + other-modules: Tags, DebugShow + build-depends: utf8-string, base >= 4 && < 5, bytestring >= 0.9 && < 0.11, @@ -84,38 +85,43 @@ if flag(debug) cpp-options: -Ddebug --- Either ./Setup sdist complains about missing executable for test case or --- ./Setup configure (having same executable twice, "consider this a bug") +Executable test + Main-Is: Test.hs + Build-Depends: + utf8-string, + base, + bytestring, + directory, + filepath, + json, + HUnit + other-modules: Tags, Hasktags, DebugShow + hs-source-dirs: src, tests + ghc-options: -Wall + default-language: Haskell2010 --- Executable test --- Main-Is: Test.hs --- Build-Depends: --- utf8-string, --- base >= 4 && < 5, --- bytestring >= 0.9 && < 0.11, --- directory >= 1.1 && < 1.3, --- filepath, --- json >= 0.5 && < 0.8, --- HUnit >= 1.2 && < 1.3 --- other-modules: Tags, Hasktags, DebugShow --- hs-source-dirs: src, tests --- ghc-options: -Wall --- default-language: Haskell2010 --- --- if !os(windows) --- build-depends: unix --- --- if flag(debug) --- cpp-options: -Ddebug --- --- Test-Suite test --- Type: exitcode-stdio-1.0 --- Main-Is: Test.hs --- hs-source-dirs: src, tests --- Build-Depends: base, bytestring, directory, filepath, json, --- HUnit >= 1.2 && < 1.3 --- ghc-options: -Wall --- default-language: Haskell2010 --- --- if flag(debug) --- cpp-options: -Ddebug + if !os(windows) + build-depends: unix + + if flag(debug) + cpp-options: -Ddebug + +Test-Suite testsuite + Type: exitcode-stdio-1.0 + Main-Is: Test.hs + hs-source-dirs: src, tests + Build-Depends: + utf8-string, + base, + bytestring, + directory, + filepath, + json, + HUnit, + unix + other-modules: Tags, Hasktags, DebugShow + ghc-options: -Wall + default-language: Haskell2010 + + if flag(debug) + cpp-options: -Ddebug diff --git a/src/DebugShow.hs b/src/DebugShow.hs --- a/src/DebugShow.hs +++ b/src/DebugShow.hs @@ -14,7 +14,7 @@ #else -- id function - should have no effect -trace_ :: (Show a) => String -> a -> b -> b +trace_ :: String -> a -> b -> b trace_ _ _ ret = ret {-# INLINE trace_ #-} diff --git a/src/Hasktags.hs b/src/Hasktags.hs --- a/src/Hasktags.hs +++ b/src/Hasktags.hs @@ -15,29 +15,42 @@ dirToFiles ) where - import Tags - --- the lib + ( FileData(..), + FoundThing(..), + FoundThingType(FTConsAccessor, FTFuncTypeDef, FTClass, FTType, + FTCons, FTNewtype, FTData, FTDataGADT, FTModule, FTFuncImpl), + Pos(..), + FileName, + mywords, + writectagsfile, + writeetagsfile ) import qualified Data.ByteString.Char8 as BS - -import qualified Data.ByteString.UTF8 as BS8 -- see notes at utf8_to_char8_hack - -import Data.Char -import Data.List -import Data.Maybe - + ( ByteString, unpack, readFile ) +import qualified Data.ByteString.UTF8 as BS8 ( fromString ) +import Data.Char ( isSpace ) +import Data.List ( tails, nubBy, isSuffixOf, isPrefixOf ) +import Data.Maybe ( maybeToList ) import System.IO + ( IOMode(WriteMode, AppendMode), + Handle, + hGetContents, + stdout, + stdin, + openFile, + hClose ) import System.Directory -import Text.JSON.Generic -import Control.Monad - -import DebugShow - + ( getModificationTime, + getDirectoryContents, + doesFileExist, + doesDirectoryExist ) +import Text.JSON.Generic ( encodeJSON, decodeJSON ) +import Control.Monad ( when ) +import DebugShow ( trace_ ) #ifdef VERSION_unix -import System.Posix.Files +import System.Posix.Files ( isSymbolicLink, getSymbolicLinkStatus ) #endif -import System.FilePath (()) +import System.FilePath ( () ) -- search for definitions of things -- we do this by looking for the following patterns: @@ -89,14 +102,14 @@ -- Reference: http://ctags.sourceforge.net/FORMAT --- | getMode takes a list of modes and extract the mode with the +-- | getMode takes a list of modes and extracts the mode with the -- highest precedence. These are as follows: Both, CTags, ETags -- The default case is Both. getMode :: [Mode] -> Mode getMode [] = BothTags getMode xs = maximum xs --- | getOutFile scan the modes searching for output redirection +-- | getOutFile scans the modes searching for output redirection -- if not found, open the file with name passed as parameter. -- Handle special file -, which is stdout getOutFile :: String -> IOMode -> [Mode] -> IO Handle @@ -453,8 +466,8 @@ -- this only exists for test case testcases/HUnitBase.lhs (bird literate haskell style) getTopLevelIndent :: Bool -> [[Token]] -> Int -getTopLevelIndent _ [] = 0 -- (no import found , assuming indent 0 : this can be - -- done better but should suffice for most needs +getTopLevelIndent _ [] = 0 -- (no import found, assuming indent 0: this can be + -- done better but should suffice for most needs getTopLevelIndent isLiterate ((nl:next:_):xs) = if "import" == (tokenString next) then let (NewLine i) = nl in i else getTopLevelIndent isLiterate xs diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} + module Main (main) where import Hasktags @@ -7,7 +7,6 @@ import Data.List -import System.IO import System.Directory import System.Console.GetOpt import System.Exit @@ -25,11 +24,11 @@ (NoArg BothTags) "generate both CTAGS and ETAGS" , Option "a" ["append"] (NoArg Append) - $ "append to existing CTAGS and/or ETAGS file(s). After this file " - ++ "will no longer be sorted!" + $ "append to existing CTAGS and/or ETAGS file(s). Afterward this " + ++ "file will no longer be sorted!" , Option "" ["ignore-close-implementation"] (NoArg IgnoreCloseImpl) - $ "ignores found implementation if its closer than 7 lines - so " + $ "ignores found implementation if it is closer than 7 lines - so " ++ "you can jump to definition in one shot" , Option "o" ["output"] (ReqArg OutRedir "") diff --git a/src/Tags.hs b/src/Tags.hs --- a/src/Tags.hs +++ b/src/Tags.hs @@ -3,12 +3,11 @@ -- this should be moved into its own library (after cleaning up most of it ..) -- yes, this is still specific to hasktags :( module Tags where -import Data.Char -import Data.List -import Data.Data - -import System.IO -import Control.Monad +import Data.Char ( isSpace ) +import Data.List ( sortBy ) +import Data.Data ( Data, Typeable ) +import System.IO ( Handle, hPutStrLn, hPutStr ) +import Control.Monad ( when ) -- my words is mainly copied from Data.List. -- difference abc::def is recognized as three words @@ -16,7 +15,7 @@ mywords :: Bool -> String -> [String] mywords spaced s = case rest of ')':xs -> (blanks' ++ ")") : mywords spaced xs - "" -> [] + "" -> [] '{':'-':xs -> (blanks' ++ "{-") : mywords spaced xs '-':'}':xs -> (blanks' ++ "-}") : mywords spaced xs '{':xs -> (blanks' ++ "{") : mywords spaced xs @@ -26,22 +25,22 @@ '=':xs -> (blanks' ++ "=") : mywords spaced xs ',':xs -> (blanks' ++ ",") : mywords spaced xs ':':':':xs -> (blanks' ++ "::") : mywords spaced xs - s' -> (blanks' ++ w) : mywords spaced s'' - where (w, s'') = myBreak s' - myBreak [] = ([],[]) - myBreak (':':':':xs) = ([], "::"++xs) - myBreak (')':xs) = ([],')':xs) + s' -> (blanks' ++ w) : mywords spaced s'' + where (w, s'') = myBreak s' + myBreak [] = ([],[]) + myBreak (':':':':xs) = ([], "::"++xs) + myBreak (')':xs) = ([],')':xs) myBreak ('(':xs) = ([],'(':xs) - myBreak ('`':xs) = ([],'`':xs) - myBreak ('=':xs) = ([],'=':xs) - myBreak (',':xs) = ([],',':xs) + myBreak ('`':xs) = ([],'`':xs) + myBreak ('=':xs) = ([],'=':xs) + myBreak (',':xs) = ([],',':xs) myBreak xss@(x:xs) | isSpace x = if spaced then ([], xss) else ([], dropWhile isSpace xss) | otherwise = let (a,b) = myBreak xs - in (x:a,b) + in (x:a,b) where blanks' = if spaced then blanks else "" (blanks, rest) = span {-partain:Char.-}isSpace s @@ -115,6 +114,7 @@ ++ "\t/^" ++ concatMap ctagEncode lineText ++ "$/;\"\t" ++ show kind ++ "\tline:" ++ show (line + 1) + ++ "\tlanguage:Haskell" -- stuff for dealing with ctags output format @@ -158,4 +158,3 @@ ++ "\x7f" ++ name ++ "\x01" ++ show line ++ "," ++ show (line + 1) ++ "\n" - diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,101 @@ +module Main where + +import Hasktags +import Tags + +import Control.Monad +import Data.List +import System.Directory +import System.Exit + +import qualified Data.ByteString.Char8 as BS + +import Test.HUnit + +{- TODO +Test the library (recursive, caching, ..) +But that's less likely to break +-} + +-- all comments should differ at the beginning +comments :: [BS.ByteString] -> String -> [String] +comments lns comment = filter (not . null) $ map hitOrEmpty lns + where + c = BS.pack $ comment ++ " " + hitOrEmpty :: BS.ByteString -> String + hitOrEmpty bs = + let ds = BS.dropWhile (== ' ') bs + in if c `BS.isPrefixOf` ds + then BS.unpack $ BS.drop (BS.length c) ds + else "" + +tagComments :: [BS.ByteString] -> String -> [String] +tagComments lns comment + = map (takeWhile (not . (`elem` "\n\r "))) $ comments lns comment + +testToBeFound :: [String] -> [String] -> Test +testToBeFound foundTagNames toBeFound = + "these were not found" + ~: [] ~?= filter (not . (`elem` foundTagNames)) toBeFound + +testNotToBeFound :: [String] -> [String] -> Test +testNotToBeFound foundTagNames notToBeFound = + "these should not have been found" + ~: [] ~=? filter (`elem` foundTagNames) notToBeFound + +testToBeFoundOnce :: [String] -> [String] -> Test +testToBeFoundOnce foundTagNames list = + "these should have been found exactly one time" + ~: [] + ~=? [name + | name <- list, 1 /= length (filter (== name ) foundTagNames)] + +etagsToBeFound :: String -> [String] -> Test +etagsToBeFound etags toBeFound = + "these were not found on TAGS" + ~: [] ~=? filter (not . (`isInfixOf` etags)) toBeFound + +etagsNotToBeFound :: String -> [String] -> Test +etagsNotToBeFound etags notToBeFound = + "these should not have been found on TAGS" + ~: [] ~=? filter (`isInfixOf` etags) notToBeFound + +etagsToBeFoundOnce :: String -> [String] -> Test +etagsToBeFoundOnce etags list = + "these should not have been found on TAGS" + ~: [] ~=? [ name | name <- list, 1 /= length (infixes name etags)] + +infixes :: Eq a => [a] -> [a] -> [[a]] +infixes needle haystack = filter (isPrefixOf needle) (tails haystack) + +createTestCase :: FilePath -> IO Test +createTestCase filename = do + bs <- BS.readFile filename + let lns = BS.lines bs + let fd = findThingsInBS True filename bs + let FileData _ things = fd + + let foundTagNames = [name | FoundThing _ name _ <- things] + let etags = etagsDumpFileData fd + + let testList = TestList [ + testToBeFound foundTagNames (tagComments lns "-- to be found"), + testNotToBeFound foundTagNames (tagComments lns "-- not to be found"), + testToBeFoundOnce + foundTagNames + (tagComments lns "-- once to be found"), + etagsToBeFound etags (comments lns "-- TAGS to be found"), + etagsNotToBeFound etags (comments lns "-- TAGS not to be found"), + etagsToBeFoundOnce etags (comments lns "-- TAGS once to be found") + ] + + return $ filename ~: testList + +main :: IO () +main + = do + setCurrentDirectory "testcases" + files <- getDirectoryContents "." + tests <- mapM createTestCase $ filter (not . (`elem` [".", "..", "expected_failures_testing_suite.hs"])) files + counts_ <- runTestTT $ TestList tests + when (errors counts_ + failures counts_ > 0) exitFailure