fast-tags 1.0.1 → 1.1.0
raw patch · 4 files changed
+49/−45 lines, 4 filesdep +bytestring
Dependencies added: bytestring
Files
- changelog.md +5/−0
- fast-tags.cabal +11/−5
- src/FastTags.hs +31/−34
- src/Main.hs +2/−6
changelog.md view
@@ -1,3 +1,8 @@+1.1:++* Decode UTF8 leniently, so non-UTF8 will no longer cause a crash. Removed+the --ignore-encoding-errors flag, since that's the default behaviour now.+ 1.0: * Merged a whole bunch of patches from Sergey Vinokurov. Copy paste from
fast-tags.cabal view
@@ -1,5 +1,5 @@ name: fast-tags-version: 1.0.1+version: 1.1.0 cabal-version: >= 1.8 build-type: Simple synopsis: Fast incremental vi and emacs tags.@@ -42,20 +42,23 @@ flag fast description: Spend more time optimizing a program (may yield up to 25% speedup)- default: False+ default: False library build-depends: base >= 3 && < 5, containers, cpphs >1.18, filepath, directory, -- text 0.11.1.12 has a bug.- text (> 0.11.1.12 || < 0.11.1.12), deepseq+ text (> 0.11.1.12 || < 0.11.1.12),+ bytestring,+ deepseq exposed-modules: FastTags hs-source-dirs: src ghc-options: -Wall -fno-warn-name-shadowing ghc-prof-options: -Wall -fno-warn-name-shadowing -auto-all if flag(fast) ghc-options:- -funfolding-creation-threshold=10000 -funfolding-use-threshold=2500+ -funfolding-creation-threshold=10000+ -funfolding-use-threshold=2500 executable fast-tags main-is: src/Main.hs@@ -63,12 +66,14 @@ base >= 3 && < 5, containers, filepath, directory, -- text 0.11.1.12 has a bug. text (> 0.11.1.12 || < 0.11.1.12),+ bytestring, fast-tags ghc-options: -Wall -fno-warn-name-shadowing ghc-prof-options: -Wall -fno-warn-name-shadowing -auto-all if flag(fast) ghc-options:- -funfolding-creation-threshold=10000 -funfolding-use-threshold=2500+ -funfolding-creation-threshold=10000+ -funfolding-use-threshold=2500 test-suite test-fast-tags type: exitcode-stdio-1.0@@ -80,5 +85,6 @@ base >= 3 && < 5, containers, filepath, directory, -- text 0.11.1.12 has a bug. text (> 0.11.1.12 || < 0.11.1.12),+ bytestring, tasty, tasty-hunit, fast-tags
src/FastTags.hs view
@@ -32,29 +32,27 @@ , split ) where- import Control.Arrow ((***), (&&&))-import Control.Monad import Control.DeepSeq (NFData, rnf)+import Control.Monad++import qualified Data.ByteString as ByteString+import qualified Data.Char as Char import Data.Function (on) import Data.Functor ((<$>))+import qualified Data.IntSet as IntSet+import qualified Data.List as List+import qualified Data.Map as Map import Data.Monoid (Monoid, (<>), mconcat)+import qualified Data.Text as T import Data.Text (Text)-import qualified System.Exit as Exit+import qualified Data.Text.Encoding as Encoding+import qualified Data.Text.Encoding.Error as Encoding.Error import qualified Language.Preprocessor.Unlit as Unlit import Text.Printf (printf) -import qualified Control.Exception as Exception-import qualified Data.Char as Char-import qualified Data.IntSet as IntSet-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified System.IO as IO - -- * types data TagVal = TagVal@@ -94,7 +92,7 @@ tokenName :: TokenVal -> Text tokenName (Token _ name) = name-tokenName _ = error "cannot extract name from non-Token TokenVal"+tokenName _ = error "cannot extract name from non-Token TokenVal" data Tag = Tag !(Pos TagVal)@@ -193,7 +191,7 @@ -- Mostly this is so that given a type with the same name as its module, -- the type will come first. sortDups :: [Pos TagVal] -> [Pos TagVal]-sortDups = concatMap (sortOn tagType) . M.elems . M.fromAscListWith (++)+sortDups = concatMap (sortOn tagType) . Map.elems . Map.fromAscListWith (++) . map (fst . tagSortingKey &&& (:[])) tagText :: Pos TagVal -> Text@@ -206,18 +204,16 @@ tagLine (Pos (SrcPos _ line) _) = line -- | Read tags from one file.-processFile :: Bool -> FilePath -> Bool -> IO ([Pos TagVal], [String])-processFile ignoreEncodingErrors fn trackPrefixes =- fmap (process fn trackPrefixes) (T.readFile fn)- `Exception.catch` \(exc :: Exception.SomeException) -> do- -- readFile will crash on files that are not UTF8. Unfortunately not- -- all haskell source file are.- IO.hPutStrLn IO.stderr $- "exception reading " ++ show fn ++ ": " ++ show exc- unless ignoreEncodingErrors $- void $ Exit.exitFailure- return ([], [])+processFile :: FilePath -> Bool -> IO ([Pos TagVal], [String])+processFile fn trackPrefixes =+ process fn trackPrefixes <$> readFileLenient fn +-- | Read a UTF8 file, but don't crash on encoding errors.+readFileLenient :: FilePath -> IO Text+readFileLenient fname = do+ bytes <- ByteString.readFile fname+ return $ Encoding.decodeUtf8With Encoding.Error.lenientDecode bytes+ tagSortingKey :: Pos TagVal -> (Text, Type) tagSortingKey (Pos _ (TagVal _ name t)) = (name, t) @@ -235,7 +231,7 @@ where (newTags, repeatableTags, warnings) = partitionTags tags earliestRepeats :: [Pos TagVal]- earliestRepeats = M.elems $ M.fromListWith minLine $+ earliestRepeats = Map.elems $ Map.fromListWith minLine $ map (tagSortingKey &&& id) repeatableTags minLine x y | tagLine x < tagLine y = x@@ -246,7 +242,8 @@ | otherwise = s where s' :: Text- s' | "\\begin{code}" `T.isInfixOf` s && "\\end{code}" `T.isInfixOf` s =+ s' | "\\begin{code}" `T.isInfixOf` s+ && "\\end{code}" `T.isInfixOf` s = T.unlines $ filter (not . birdLiterateLine) $ T.lines s | otherwise = s birdLiterateLine :: Text -> Bool@@ -268,7 +265,7 @@ tokenize :: Bool -> Line -> UnstrippedTokens tokenize trackPrefixes (Pos pos line) =- UnstrippedTokens $ map (Pos pos) (tokenizeLine trackPrefixes line)+ UnstrippedTokens $ map (Pos pos) (tokenizeLine trackPrefixes line) spanToken :: Text -> (Text, Text) spanToken text@@ -318,8 +315,8 @@ startIdentChar c = Char.isAlpha c || c == '_' identChar :: Bool -> Char -> Bool-identChar considerDot c = Char.isAlphaNum c || c == '\'' || c == '_' || c == '#'- || considerDot && c == '.'+identChar considerDot c = Char.isAlphaNum c || c == '\'' || c == '_'+ || c == '#' || considerDot && c == '.' -- unicode operators are not supported yet haskellOpChar :: Char -> Bool@@ -893,7 +890,7 @@ dropUntil token = drop 1 . dropWhile (not . (`hasName` token) . valOf) sortOn :: (Ord k) => (a -> k) -> [a] -> [a]-sortOn key = L.sortBy (compare `on` key)+sortOn key = List.sortBy (compare `on` key) -- | Split list into chunks delimited by specified element. split :: (Eq a) => a -> [a] -> [[a]]@@ -903,11 +900,11 @@ -- | Crude predicate for Haskell files isHsFile :: FilePath -> Bool-isHsFile fn =- ".hs" `L.isSuffixOf` fn || ".hsc" `L.isSuffixOf` fn || isLiterateFile fn+isHsFile fn = ".hs" `List.isSuffixOf` fn || ".hsc" `List.isSuffixOf` fn+ || isLiterateFile fn isLiterateFile :: FilePath -> Bool-isLiterateFile fn = ".lhs" `L.isSuffixOf` fn+isLiterateFile fn = ".lhs" `List.isSuffixOf` fn merge :: Ord a => [a] -> [a] -> [a] merge = mergeBy compare
src/Main.hs view
@@ -52,7 +52,6 @@ output = last $ defaultOutput : [fn | Output fn <- flags] noMerge = NoMerge `elem` flags useZeroSep = ZeroSep `elem` flags- ignoreEncErrs = IgnoreEncodingErrors `elem` flags sep = if useZeroSep then '\0' else '\n' defaultOutput = if vim then "tags" else "TAGS" inputsM = if null inputs@@ -84,7 +83,7 @@ -- TODO try it and see if it really hurts performance that much. newTags <- fmap processAll $ forM (zip [0..] inputs) $ \(i :: Int, fn) -> do- (newTags, warnings) <- processFile ignoreEncErrs fn trackPrefixes+ (newTags, warnings) <- processFile fn trackPrefixes forM_ warnings printErr when verbose $ do let line = take 78 $ show i ++ ": " ++ fn@@ -174,7 +173,6 @@ | Recurse | NoMerge | ZeroSep- | IgnoreEncodingErrors deriving (Eq, Show) help :: String@@ -195,11 +193,9 @@ , Option ['R'] [] (NoArg Recurse) "read all files under any specified directories recursively" , Option ['0'] [] (NoArg ZeroSep)- "expect list of file names in stdin to be 0-separated."+ "expect list of file names on stdin to be 0-separated." , Option [] ["nomerge"] (NoArg NoMerge) "do not merge tag files"- , Option [] ["ignore-encoding-errors"] (NoArg IgnoreEncodingErrors)- "do exit on utf8 encoding error and continue processing other files" ] -- | Documented in vim :h tags-file-format.