hasktags 0.68.7 → 0.69.0
raw patch · 3 files changed
+114/−87 lines, 3 filesdep +hasktagsdep ~basedep ~directory
Dependencies added: hasktags
Dependency ranges changed: base, directory
Files
- hasktags.cabal +23/−10
- src/Hasktags.hs +85/−22
- src/Main.hs +6/−55
hasktags.cabal view
@@ -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
src/Hasktags.hs view
@@ -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
src/Main.hs view
@@ -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