diff --git a/hasktags.cabal b/hasktags.cabal --- a/hasktags.cabal +++ b/hasktags.cabal @@ -1,5 +1,5 @@ Name: hasktags -Version: 0.68.7 +Version: 0.69.0 Copyright: The University Court of the University of Glasgow License: BSD3 License-File: LICENSE @@ -45,23 +45,36 @@ Flag debug Default: False - Description: When set to true tokens will be print at various places. This helps understanding why hasktags does not behave the w ay it should + Description: When set to true tokens will be print at various places. This helps understanding why hasktags does not behave the way it should source-repository head type: git location: http://github.com/MarcWeber/hasktags +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: Hasktags + other-modules: Tags, DebugShow + build-depends: + utf8-string, + base >= 4 && < 5, + bytestring >= 0.9 && < 0.11, + directory >= 1.1 && < 1.3, + filepath, + json >= 0.5 && < 0.8 + + if !os(windows) + build-depends: unix + Executable hasktags - Main-Is: Main.hs + Main-Is: src/Main.hs Build-Depends: - utf8-string, - base >= 4 && < 5, - bytestring >= 0.9 && < 0.11, - directory >= 1.1 && < 1.3, + base, + directory, filepath, - json >= 0.5 && < 0.8 - other-modules: Tags, Hasktags, DebugShow - hs-source-dirs: src + hasktags ghc-options: -Wall default-language: Haskell2010 diff --git a/src/Hasktags.hs b/src/Hasktags.hs --- a/src/Hasktags.hs +++ b/src/Hasktags.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} -- should this be named Data.Hasktags or such? module Hasktags ( FileData, + generate, findWithCache, findThings, findThingsInBS, @@ -9,7 +11,9 @@ Mode(..), -- TODO think about these: Must they be exported ? getMode, - getOutFile + getOutFile, + + dirToFiles ) where import Tags @@ -30,6 +34,11 @@ import DebugShow +#ifdef VERSION_unix +import System.Posix.Files +#endif +import System.FilePath (()) + -- search for definitions of things -- we do this by looking for the following patterns: -- data XXX = ... giving a datatype location @@ -109,6 +118,7 @@ | FollowDirectorySymLinks | Help | HsSuffixes [String] + | AbsolutePath deriving (Ord, Eq, Show) data Token = Token String Pos @@ -131,6 +141,37 @@ trimNewlines :: [Token] -> [Token] trimNewlines = filter (not . isNewLine Nothing) +generate :: [Mode] -> [FileName] -> IO () +generate modes filenames = do + + let mode = getMode (filter ( `elem` [BothTags, CTags, ETags] ) modes) + openFileMode = if Append `elem` modes + then AppendMode + else WriteMode + filedata <- mapM (findWithCache (CacheFiles `elem` modes) + (IgnoreCloseImpl `elem` modes)) + filenames + + when (mode == CTags) + (do ctagsfile <- getOutFile "tags" openFileMode modes + writectagsfile ctagsfile (ExtendedCtag `elem` modes) filedata + hClose ctagsfile) + + when (mode == ETags) + (do etagsfile <- getOutFile "TAGS" openFileMode modes + 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) + -- Find the definitions in a file, or load from cache if the file -- hasn't changed since last time. findWithCache :: Bool -> Bool -> FileName -> IO FileData @@ -264,22 +305,12 @@ in filter f stripblockcomments :: [Token] -> [Token] -stripblockcomments (Token "\\end{code}" pos : xs) = - trace_ "stripblockcomments end{code} found at " (show pos) $ - afterlitend xs stripblockcomments (Token "{-" pos : xs) = trace_ "{- found at " (show pos) $ afterblockcomend xs stripblockcomments (x:xs) = x:stripblockcomments xs stripblockcomments [] = [] -afterlitend :: [Token] -> [Token] -afterlitend (Token "\\begin{code}" pos : xs) = - trace_ "stripblockcomments begin{code} found at " (show pos) $ - stripblockcomments xs -afterlitend (_ : xs) = afterlitend xs -afterlitend [] = [] - afterblockcomend :: [Token] -> [Token] afterblockcomend (t@(Token _ pos):xs) | contains "-}" (tokenString t) = @@ -429,17 +460,49 @@ else getTopLevelIndent isLiterate xs getTopLevelIndent isLiterate (_:xs) = getTopLevelIndent isLiterate xs --- removes literate stuff if any line '> ... ' is found and any word is \begin --- (hglogger has ^> in it's comments) -fromLiterate :: FilePath -> [(String, Int)] +-- According to http://www.haskell.org/onlinereport/literate.html either +-- birdstyle or LaTeX style should be used. However simple experiments show +-- that unlit distributed by GHC has the following behavior +-- * The space after ">" can be omitted +-- * ">" must be first char in line to be read as birdstyle (then its replaced by a space) +-- * \begin{code} gets recognized if its indented, but \end{code} does not (?) +-- +-- Attention: Base.lhs (shipping with GHC) have birdstyle in block comments +fromLiterate :: FilePath -> [(String, Int)] -> (Bool -- is literate , [(String, Int)]) fromLiterate file lns = - let literate = [ (ls, n) | ('>':ls, n) <- lns ] - -- not . null literate because of Repair.lhs of darcs - in if ".lhs" `isSuffixOf` file && (not . null $ literate) then (True, literate) - else if (".hs" `isSuffixOf` file) - || (null literate - || not ( any ( any ("\\begin" `isPrefixOf`). words . fst) lns)) - then (False, lns) - else (True, literate) + if ".lhs" `isSuffixOf` file + then (True, unlit lns) + else (False, lns) + + where unlit, returnCode :: [(String, Int)] -> [(String, Int)] + unlit ((('>':' ':xs),n):ns) = ((' ':xs),n):unlit(ns) -- unlit keeps space, so do we + unlit ((line,_):ns) = if "\\begin{code}" `isPrefixOf` line then returnCode ns else unlit ns + unlit [] = [] + + -- in \begin{code} block + returnCode (t@(line,_):ns) = if "\\end{code}" `isPrefixOf` line then unlit ns else t:(returnCode ns) + returnCode [] = [] -- unexpected - hasktags does tagging, not compiling, thus don't treat missing \end{code} to be an error + +-- suffixes: [".hs",".lhs"], use "" to match all files +dirToFiles :: Bool -> [String] -> FilePath -> IO [ FilePath ] +dirToFiles _ _ "STDIN" = fmap lines $ hGetContents stdin +dirToFiles followSyms suffixes p = do + isD <- doesDirectoryExist p + isSymLink <- +#ifdef VERSION_unix + isSymbolicLink `fmap` getSymbolicLinkStatus p +#else + return False +#endif + case isD of + False -> return $ if matchingSuffix then [p] else [] + True -> + if isSymLink && not followSyms + then return [] + else do + -- filter . .. and hidden files .* + contents <- filter ((/=) '.' . head) `fmap` getDirectoryContents p + concat `fmap` (mapM (dirToFiles followSyms suffixes . () p) contents) + where matchingSuffix = any (`isSuffixOf` p) suffixes diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -2,7 +2,6 @@ {-# LANGUAGE CPP #-} module Main (main) where import Hasktags -import Tags import System.Environment @@ -10,10 +9,6 @@ import System.IO import System.Directory -#ifdef VERSION_unix -import System.Posix.Files -#endif -import System.FilePath (()) import System.Console.GetOpt import System.Exit import Control.Monad @@ -47,6 +42,7 @@ , Option "" ["cache"] (NoArg CacheFiles) "Cache file data." , Option "L" ["follow-symlinks"] (NoArg FollowDirectorySymLinks) "follow symlinks when recursing directories" , Option "S" ["suffixes"] (OptArg suffStr ".hs,.lhs") "list of hs suffixes including \".\"" + , Option "R" ["tags-absolute"] (NoArg AbsolutePath) "make tags paths absolute. Useful when setting tags files in other directories" , Option "h" ["help"] (NoArg Help) "This help" ] where suffStr Nothing = hsSuffixesDefault @@ -72,11 +68,14 @@ ++ "\n" ++ "A special file \"STDIN\" will make hasktags read the line separated file\n" ++ "list to be tagged from STDIN.\n" - let (modes, files_or_dirs, errs) = getOpt Permute options args + let (modes, files_or_dirs_unexpanded, errs) = getOpt Permute options args #if debug print $ "modes: " ++ (show modes) #endif + files_or_dirs <- if AbsolutePath `elem` modes + then sequence $ map canonicalizePath files_or_dirs_unexpanded + else return files_or_dirs_unexpanded let hsSuffixes = head $ [ s | (HsSuffixes s) <- modes ++ [hsSuffixesDefault] ] let followSymLinks = FollowDirectorySymLinks `elem` modes @@ -91,52 +90,4 @@ when (filenames == []) $ putStrLn "warning: no files found!" - let mode = getMode (filter ( `elem` [BothTags, CTags, ETags] ) modes) - openFileMode = if Append `elem` modes - then AppendMode - else WriteMode - filedata <- mapM (findWithCache (CacheFiles `elem` modes) - (IgnoreCloseImpl `elem` modes)) - filenames - - when (mode == CTags) - (do ctagsfile <- getOutFile "tags" openFileMode modes - writectagsfile ctagsfile (ExtendedCtag `elem` modes) filedata - hClose ctagsfile) - - when (mode == ETags) - (do etagsfile <- getOutFile "TAGS" openFileMode modes - 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) - --- suffixes: [".hs",".lhs"], use "" to match all files -dirToFiles :: Bool -> [String] -> FilePath -> IO [ FilePath ] -dirToFiles _ _ "STDIN" = fmap lines $ hGetContents stdin -dirToFiles followSyms suffixes p = do - isD <- doesDirectoryExist p - isSymLink <- -#ifdef VERSION_unix - isSymbolicLink `fmap` getSymbolicLinkStatus p -#else - return False -#endif - case isD of - False -> return $ if matchingSuffix then [p] else [] - True -> - if isSymLink && not followSyms - then return [] - else do - -- filter . .. and hidden files .* - contents <- filter ((/=) '.' . head) `fmap` getDirectoryContents p - concat `fmap` (mapM (dirToFiles followSyms suffixes . () p) contents) - where matchingSuffix = any (`isSuffixOf` p) suffixes + generate modes filenames