hasktags 0.68 → 0.68.1
raw patch · 2 files changed
+162/−103 lines, 2 filesdep +bytestringdep ~base
Dependencies added: bytestring
Dependency ranges changed: base
Files
- hasktags.cabal +2/−3
- hasktags.hs +160/−100
hasktags.cabal view
@@ -1,5 +1,5 @@ Name: hasktags-Version: 0.68+Version: 0.68.1 Copyright: The University Court of the University of Glasgow License: BSD3 License-File: LICENSE@@ -20,5 +20,4 @@ Executable hasktags Main-Is: hasktags.hs- Build-Depends: haskell98, base <= 4.2-+ Build-Depends: haskell98, base < 5, bytestring
hasktags.hs view
@@ -1,11 +1,15 @@ module Main (main) where-import Char+import qualified Data.ByteString.Char8 as BS+import Data.Char import Data.List+import Data.Maybe+import Control.Monad( when )+ import IO import System.Environment import System.Console.GetOpt import System.Exit-import Debug.Trace+--import Debug.Trace -- search for definitions of things@@ -59,30 +63,38 @@ args <- getArgs let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]" let (modes, filenames, errs) = getOpt Permute options args- if errs /= [] || elem Help modes || filenames == []- then do- putStr $ unlines errs- putStr $ usageInfo usageString options- exitWith (ExitFailure 1)- else return ()++ when (errs /= [] || elem Help modes || filenames == [])+ (do putStr $ unlines errs+ putStr $ usageInfo usageString options+ exitWith (ExitFailure 1))+ let mode = getMode (filter ( `elem` [BothTags, CTags, ETags, Append] ) modes)- let openFileMode = if elem Append modes+ openFileMode = if elem Append modes then AppendMode else WriteMode filedata <- mapM (findthings (IgnoreCloseImpl `elem` modes)) filenames- if mode == BothTags || mode == CTags- then do- ctagsfile <- openFile "tags" openFileMode- writectagsfile ctagsfile filedata- hClose ctagsfile- else return ()- if mode == BothTags || mode == ETags- then do- etagsfile <- openFile "TAGS" openFileMode- writeetagsfile etagsfile filedata- hClose etagsfile- else return () + when (mode == CTags)+ (do ctagsfile <- getOutFile "tags" openFileMode modes+ writectagsfile ctagsfile (ExtendedCtag `elem` modes) filedata+ hClose ctagsfile)++ when (mode == ETags)+ (do etagsfile <- openFile "TAGS" openFileMode+ writeetagsfile etagsfile filedata+ hClose etagsfile)++ -- avoid problem when both is used in combination+ -- with redirection on stdout+ when (mode == BothTags)+ (do etagsfile <- getOutFile "TAGS" openFileMode modes+ writeetagsfile etagsfile filedata+ ctagsfile <- getOutFile "tags" openFileMode modes+ writectagsfile ctagsfile (ExtendedCtag `elem` modes) filedata+ hClose etagsfile+ hClose ctagsfile)+ -- | getMode takes a list of modes and extract the mode with the -- highest precedence. These are as follows: Both, CTags, ETags -- The default case is Both.@@ -90,10 +102,24 @@ getMode [] = BothTags getMode xs = maximum xs +-- | getOutFile scan 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+getOutFile _ _ ((OutRedir "-"):_) = return stdout+getOutFile _ openMode ((OutRedir f):_) = openFile f openMode+getOutFile name openMode (_:xs) = getOutFile name openMode xs+getOutFile defaultName openMode [] = openFile defaultName openMode -data Mode = ETags | CTags | BothTags | Append - | IgnoreCloseImpl- | Help deriving (Ord, Eq, Show)+data Mode = ExtendedCtag+ | IgnoreCloseImpl+ | ETags + | CTags + | BothTags + | Append + | OutRedir String+ | Help+ deriving (Ord, Eq, Show) options :: [OptDescr Mode] options = [ Option "c" ["ctags"]@@ -101,11 +127,17 @@ , Option "e" ["etags"] (NoArg ETags) "generate ETAGS file (etags)" , Option "b" ["both"]- (NoArg BothTags) ("generate both CTAGS and ETAGS")+ (NoArg BothTags) "generate both CTAGS and ETAGS" , Option "a" ["append"]- (NoArg Append) ("append to existing CTAGS and/or ETAGS file(s)")+ (NoArg Append) "append to existing CTAGS and/or ETAGS file(s)" , Option "" ["ignore-close-implementation"]- (NoArg IgnoreCloseImpl) ("ignores found implementation if its closer than 7 lines - so you can jump to definition in one shot")+ (NoArg IgnoreCloseImpl) "ignores found implementation if its closer than 7 lines - so you can jump to definition in one shot"+ , Option "o" ["output"]+ (ReqArg OutRedir "") "output to given file, instead of 'tags', '-' file is stdout"+ , Option "f" ["file"]+ (ReqArg OutRedir "") "same as -o, but used as compatibility with ctags"+ , Option "x" ["extendedctag"]+ (NoArg ExtendedCtag) "Generate additional information in ctag file." , Option "h" ["help"] (NoArg Help) "This help" ] @@ -131,12 +163,12 @@ show FTFuncImpl = "fi" show FTType = "t" show FTData = "d"- show FTDataGADT = "d-gadt"+ show FTDataGADT = "d_gadt" show FTNewtype = "nt" show FTClass = "c" show FTModule = "m" show FTCons = "cons"- show FTConsGADT = "c-gadt"+ show FTConsGADT = "c_gadt" show FTConsAccessor = "c_a" show FTOther = "o" @@ -151,51 +183,70 @@ deriving (Eq) instance Show Token where -- show (Token t (Pos _ l _ _) ) = "Token " ++ t ++ " " ++ (show l)- show (Token t (Pos _ l _ _) ) = " " ++ t ++ " "- show (NewLine i) = "NewLine " ++ (show i)+ show (Token t (Pos _ _l _ _) ) = " " ++ t ++ " "+ show (NewLine i) = "NewLine " ++ show i +tokenString :: Token -> String tokenString (Token s _) = s tokenString (NewLine _) = "\n"++isNewLine :: Maybe Int -> Token -> Bool isNewLine Nothing (NewLine _) = True isNewLine (Just c) (NewLine c') = c == c' isNewLine _ _ = False +trimNewlines :: [Token] -> [Token] trimNewlines = filter (not . isNewLine Nothing) -- stuff for dealing with ctags output format -writectagsfile :: Handle -> [FileData] -> IO ()-writectagsfile ctagsfile filedata = do- let things = concat $ map getfoundthings filedata- mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) (sortThings things)+writectagsfile :: Handle -> Bool -> [FileData] -> IO ()+writectagsfile ctagsfile extended filedata = do+ let things = concatMap getfoundthings filedata+ when extended+ (do hPutStrLn ctagsfile "!_TAG_FILE_FORMAT\t2\t/extended format; --format=1 will not append ;\" to lines/"+ hPutStrLn ctagsfile "!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted, 2=foldcase/"+ hPutStrLn ctagsfile "!_TAG_PROGRAM_NAME\thasktags")+ mapM_ (hPutStrLn ctagsfile . dumpthing extended) (sortThings things) +sortThings :: [FoundThing] -> [FoundThing] sortThings = sortBy (\(FoundThing _ a _) (FoundThing _ b _) -> compare a b) getfoundthings :: FileData -> [FoundThing] getfoundthings (FileData _ things) = things -dumpthing :: FoundThing -> String-dumpthing (FoundThing ftt name (Pos filename line _ _)) =- name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1) ++ ";\"" ++ "\t" ++ (show ftt) -- Using backward compatible tag kind extension here+-- | Dump found tag in normal or extended (read : vim like) ctag+-- line+dumpthing :: Bool -> FoundThing -> String+dumpthing False (FoundThing _ name (Pos filename line _ _)) =+ name ++ "\t" ++ filename ++ "\t" ++ show (line + 1)+dumpthing True (FoundThing kind name (Pos filename line _ lineText)) =+ name ++ "\t" ++ filename+ ++ "\t/^" ++ concatMap ctagEncode lineText+ ++ "$/;\"\t" ++ show kind+ ++ "\tline:" ++ show (line + 1) +ctagEncode :: Char -> String+ctagEncode '/' = "\\/"+ctagEncode '\\' = "\\\\"+ctagEncode a = [a] -- stuff for dealing with etags output format writeetagsfile :: Handle -> [FileData] -> IO ()-writeetagsfile etagsfile filedata = do- mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata+writeetagsfile etagsfile = mapM_ (hPutStr etagsfile . etagsDumpFileData) -e_dumpfiledata :: FileData -> String-e_dumpfiledata (FileData filename things) =- "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump- where thingsdump = concat $ map e_dumpthing things+etagsDumpFileData :: FileData -> String+etagsDumpFileData (FileData filename things) =+ "\x0c\n" ++ filename ++ "," ++ show thingslength ++ "\n" ++ thingsdump+ where thingsdump = concatMap etagsDumpThing things thingslength = length thingsdump -e_dumpthing :: FoundThing -> String-e_dumpthing (FoundThing _ name (Pos filename line token fullline)) =- (concat $ take (token + 1) $ spacedwords fullline)- ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"+etagsDumpThing :: FoundThing -> String+etagsDumpThing (FoundThing _ _name (Pos _filename line token fullline)) =+ concat (take (token + 1) $ spacedwords fullline)+ ++ "\x7f" ++ show line ++ "," ++ show (line + 1) ++ "\n" -- like "words", but keeping the whitespace, and so letting us build@@ -203,42 +254,35 @@ spacedwords :: String -> [String] spacedwords [] = []-spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)- where (blanks,rest) = span Char.isSpace xs- (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest------ makes sure file is fully closed after reading (taken from haskell-pandoc)-readFile' :: FilePath -> IO String-readFile' f = do s <- readFile f- return $! (length s `seq` s)+spacedwords xs = (blanks ++ wordchars) : spacedwords rest2+ where (blanks,rest) = span isSpace xs+ (wordchars,rest2) = break isSpace rest -- Find the definitions in a file findthings :: Bool -> FileName -> IO FileData findthings ignoreCloseImpl filename = do- aslines <- fmap ( lines . evaluate) $ readFile' filename+ aslines <- fmap ( lines . evaluate . BS.unpack) $ BS.readFile filename let stripNonHaskellLines = let- emptyLine l = ( all ((all isSpace) . tokenString) )- $ filter (not . (isNewLine Nothing)) l- cppLine (nl:t:_) = ("#" `isPrefixOf`) $ tokenString t+ emptyLine = all (all isSpace . tokenString)+ . filter (not . isNewLine Nothing)+ cppLine (_nl:t:_) = ("#" `isPrefixOf`) $ tokenString t cppLine _ = False in filter (not . emptyLine) . filter (not . cppLine) -- remove -- comments, then break each line into tokens (adding line numbers) -- then remove {- -} comments -- split by lines again ( to get indent- let (lines , numbers) = unzip . fromLiterate filename $ zip aslines [0..]+ let (fileLines, numbers) = unzip . fromLiterate filename $ zip aslines [0..] let tokenLines = stripNonHaskellLines $ stripslcomments- $ (splitByNL Nothing)+ $ splitByNL Nothing $ stripblockcomments $ concat $ zipWith3 (withline filename)- (map ( filter (not . (all isSpace)). mywords) $ lines)- lines+ (map ( filter (not . all isSpace) . mywords) fileLines)+ fileLines numbers @@ -252,7 +296,7 @@ let sections = map tail -- strip leading NL (no longer needed $ filter (not . null) $ splitByNL (Just (getTopLevelIndent tokenLines) )- $ concat $ tokenLines+ $ concat tokenLines -- only take one of -- a 'x' = 7 -- a _ = 0@@ -261,8 +305,8 @@ -> f1 == f2 && n1 == n2 && t1 == FTFuncImpl && t2 == FTFuncImpl ) let iCI = if ignoreCloseImpl - then nubBy (\(FoundThing t1 n1 (Pos f1 l1 _ _)) - (FoundThing t2 n2 (Pos f2 l2 _ _))+ then nubBy (\(FoundThing _ n1 (Pos f1 l1 _ _)) + (FoundThing _ n2 (Pos f2 l2 _ _)) -> f1 == f2 && n1 == n2 && ( ( <= 7 ) $ abs $ l2 - l1)) else id return $ FileData filename $ iCI $ filterAdjacentFuncImpl $ concatMap findstuff sections@@ -275,6 +319,7 @@ -- difference abc::def is recognized as three words -- `abc` is recognized as "`" "abc" "`" mywords :: String -> [String]+ mywords ('{':xs) = "{" : mywords xs mywords ('(':xs) = "(" : mywords xs mywords ('`':xs) = "`" : mywords xs mywords ('=':'>':xs) = "=>" : mywords xs@@ -301,12 +346,12 @@ -- and which token they are through that line withline :: FileName -> [String] -> String -> Int -> [Token]-withline filename words fullline i =+withline filename sourceWords fullline i = let countSpaces (' ':xs) = 1 + countSpaces xs countSpaces ('\t':xs) = 8 + countSpaces xs countSpaces _ = 0 in NewLine (countSpaces fullline)- : zipWith (\w t -> Token w (Pos filename i t fullline)) words [1 ..]+ : zipWith (\w t -> Token w (Pos filename i t fullline)) sourceWords [1 ..] -- comments stripping @@ -336,65 +381,77 @@ -- does one string contain another string contains :: Eq a => [a] -> [a] -> Bool-contains sub full = any (isPrefixOf sub) $ tails full+contains sub = any (isPrefixOf sub) . tails -- actually pick up definitions findstuff :: [Token] -> [FoundThing]-findstuff ((Token "module" _):(Token name pos):xs) =- FoundThing FTModule name pos : [] -- nothing will follow this section+findstuff ((Token "module" _):(Token name pos):_) =+ [FoundThing FTModule name pos] -- nothing will follow this section findstuff ((Token "data" _):(Token name pos):xs) | any ( (== "where"). tokenString ) xs -- GADT -- TODO will be found as FTCons (not FTConsGADT), the same for functions - but they are found :) - = FoundThing FTDataGADT name pos : (getcons2 xs) ++ (fromWhereOn xs) -- ++ (findstuff xs)- | otherwise = FoundThing FTData name pos : (getcons FTData (trimNewlines xs))-- ++ (findstuff xs)-findstuff ((Token "newtype" _):ts@((t@(Token name pos)):_)) =- FoundThing FTNewtype name pos : (getcons FTCons (trimNewlines ts))-- ++ (findstuff xs)+ = FoundThing FTDataGADT name pos : getcons2 xs ++ fromWhereOn xs -- ++ (findstuff xs)+ | otherwise = FoundThing FTData name pos : getcons FTData (trimNewlines xs)-- ++ (findstuff xs)+findstuff ((Token "newtype" _):ts@(((Token name pos)):_)) =+ FoundThing FTNewtype name pos : getcons FTCons (trimNewlines ts)-- ++ (findstuff xs) -- FoundThing FTNewtype name pos : findstuff xs findstuff ((Token "type" _):(Token name pos):xs) = FoundThing FTType name pos : findstuff xs findstuff ((Token "class" _):xs) = case break ((== "where").tokenString) xs of- (_,[]) -> []- (t,r) -> case (head . dropWhile isParenOpen . reverse . takeWhile ((/= "=>").tokenString) . reverse) t of- (Token name p) -> FoundThing FTClass name p : fromWhereOn r- _ -> []+ (ys,[]) -> maybeToList $ className ys+ (_,r) -> maybe [] (:fromWhereOn r) $ className xs where isParenOpen (Token "(" _) = True isParenOpen _ = False+ className lst = case (head . dropWhile isParenOpen . reverse . takeWhile ((/= "=>").tokenString) . reverse) lst of+ (Token name p) -> Just $ FoundThing FTClass name p+ _ -> Nothing findstuff xs = findFunc xs ++ findFuncTypeDefs [] xs -findFuncTypeDefs found (t@(Token name p): Token "," _ :xs) =+findFuncTypeDefs :: [Token] -> [Token] -> [FoundThing]+findFuncTypeDefs found (t@(Token _ _): Token "," _ :xs) = findFuncTypeDefs (t : found) xs-findFuncTypeDefs found (t@(Token name p): Token "::" _ :xs) =+findFuncTypeDefs found (t@(Token _ _): Token "::" _ :_) = map (\(Token name p) -> FoundThing FTFuncTypeDef name p) (t:found) findFuncTypeDefs found (Token "(" _ :xs) = case break myBreakF xs of (inner@((Token _ p):_), _:xs') ->- let merged = Token ( ( concat . map (\(Token x _) -> x) ) inner ) p+ let merged = Token ( concatMap (\(Token x _) -> x) inner ) p in findFuncTypeDefs found $ merged : xs' _ -> [] where myBreakF (Token ")" _) = True myBreakF _ = False findFuncTypeDefs _ _ = []-fromWhereOn (w:[]) = []-fromWhereOn (w: xs@((NewLine _):_)) =++fromWhereOn :: [Token] -> [FoundThing]+fromWhereOn [] = []+fromWhereOn [_] = []+fromWhereOn (_: xs@((NewLine _):_)) = concatMap (findstuff . tail') $ splitByNL (Just ( minimum . (10000:) . map (\(NewLine i) -> i) . filter (isNewLine Nothing) $ xs)) xs-fromWhereOn (w:xw) = findstuff xw+fromWhereOn (_:xw) = findstuff xw +findFunc :: [Token] -> [FoundThing] findFunc x = case findInfix x of- x:xs -> x:xs+ a@(_:_) -> a _ -> findF x++findInfix :: [Token] -> [FoundThing] findInfix x = case dropWhile ((/= "`"). tokenString) (takeWhile ( (/= "=") . tokenString) x) of- x:(Token name p):_ -> FoundThing FTFuncImpl name p : []+ _:(Token name p):_ -> [FoundThing FTFuncImpl name p] _ -> []-findF ((Token name p):xs) = if (any (("=" ==).tokenString) xs)- then FoundThing FTFuncImpl name p : [] else []+++findF :: [Token] -> [FoundThing]+findF ((Token name p):xs) =+ [FoundThing FTFuncImpl name p | any (("=" ==) . tokenString) xs] findF _ = [] -tail' (x:xs) = xs+tail' :: [a] -> [a]+tail' (_:xs) = xs tail' [] = [] -- get the constructor definitions, knowing that a datatype has just started@@ -402,16 +459,17 @@ getcons :: FoundThingType -> [Token] -> [FoundThing] getcons ftt ((Token "=" _):(Token name pos):xs) = FoundThing ftt name pos : getcons2 xs-getcons ftt (x:xs) = getcons ftt xs+getcons ftt (_:xs) = getcons ftt xs getcons _ [] = [] +getcons2 :: [Token] -> [FoundThing] getcons2 ((Token name pos):(Token "::" _):xs) = FoundThing FTConsAccessor name pos : getcons2 xs-getcons2 ((Token "=" _):xs) = []+getcons2 ((Token "=" _):_) = [] getcons2 ((Token "|" _):(Token name pos):xs) = FoundThing FTCons name pos : getcons2 xs-getcons2 (x:xs) = getcons2 xs+getcons2 (_:xs) = getcons2 xs getcons2 [] = [] @@ -421,9 +479,10 @@ in (nl : a) : splitByNL maybeIndent b splitByNL _ _ = [] +getTopLevelIndent :: [[Token]] -> Int getTopLevelIndent [] = 0 -- (no import found , assuming indent 0 : this can be -- done better but should suffice for most needs-getTopLevelIndent (x:xs) = if (any ((=="import") . tokenString) x)+getTopLevelIndent (x:xs) = if any ((=="import") . tokenString) x then let ((NewLine i):_) = x in i else getTopLevelIndent xs @@ -432,9 +491,10 @@ fromLiterate file lines = let literate = [ (ls, n) | ('>':ls, n) <- lines ] in if ".lhs" `isSuffixOf` file && (not . null $ literate) then literate -- not . null literate because of Repair.lhs of darcs - else if ".hs" `isSuffixOf` file then lines- else if (null literate || not ( any ( (any ("\\begin" `isPrefixOf`)). words . fst) lines) ) - then lines else literate+ else if (".hs" `isSuffixOf` file)+ || (null literate || not ( any ( any ("\\begin" `isPrefixOf`). words . fst) lines))+ then lines+ else literate {- testcase: