cgrep 6.4.22 → 6.5.0

raw patch · 15 files changed

+108/−69 lines, 15 filesdep +async

Dependencies added: async

Files

• README.md +1/−1
• cgrep.cabal +3/−2
• src/CGrep/CGrep.hs +1/−1
• src/CGrep/Common.hs +10/−9
• src/CGrep/Strategy/BoyerMoore.hs +3/−3
• src/CGrep/Strategy/Cpp/Semantic.hs +3/−3
• src/CGrep/Strategy/Cpp/Tokenizer.hs +4/−3
• src/CGrep/Strategy/Generic/Semantic.hs +4/−3
• src/CGrep/Strategy/Levenshtein.hs +4/−3
• src/CGrep/Strategy/Regex.hs +3/−3
• src/CmdOptions.hs +13/−10
• src/Config.hs +1/−1
• src/Main.hs +42/−26
• src/Options.hs +6/−1
• src/Util.hs +10/−0

@@ -4,7 +4,7 @@ Usage ----- -Cgrep 6.4.22 Usage: cgrep [OPTION] [PATTERN] files...+Cgrep 6.5.0 Usage: cgrep [OPTION] [PATTERN] files...  cgrep [OPTIONS] [ITEM] 

@@ -1,6 +1,6 @@ Name:                cgrep Description:         Cgrep: a context-aware grep for source codes-Version:             6.4.22+Version:             6.5.0 Synopsis:            Command line tool Homepage:            http://awgn.github.io/cgrep/ License:             GPL-2@@ -44,6 +44,7 @@                        regex-posix >=0.90,                        either >= 4.0,                        mtl >= 2.0,-                       unix-compat >= 0.4+                       unix-compat >= 0.4,+                       async >= 2.0   Ghc-options:         -O2 -Wall -threaded -rtsopts -with-rtsopts=-N   Default-language:    Haskell2010

@@ -64,7 +64,7 @@                 } = i || k || d || h || n || s || c || o  -cgrepDispatch :: Options -> FilePath -> CgrepFunction+cgrepDispatch :: Options -> FilePath -> SearchFunction cgrepDispatch opt f     | not (regex opt) && not (hasTokenizerOpt opt) && not (semantic opt) && edit_dist opt   = Levenshtein.search     | not (regex opt) && not (hasTokenizerOpt opt) && not (semantic opt)                    = BoyerMoore.search

@@ -16,9 +16,9 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -module CGrep.Common (CgrepFunction, Text8,-                     getFileName,-                     getText,+module CGrep.Common (SearchFunction, Text8,+                     getTargetName,+                     getTargetContents,                      quickSearch,                      expandMultiline,                      ignoreCase,@@ -35,7 +35,7 @@ import Util  -type CgrepFunction = Options -> [Text8] -> Maybe FilePath -> IO [Output]+type SearchFunction = Options -> [Text8] -> FilePath -> IO [Output]   trim :: String -> String@@ -46,13 +46,14 @@ trim8 = (C.dropWhile isSpace . C.reverse) . C.dropWhile isSpace . C.reverse  -getFileName :: Maybe FilePath -> String-getFileName Nothing = "<STDIN>"-getFileName (Just name) = name+getTargetName :: FilePath -> String+getTargetName [] = "<STDIN>"+getTargetName name = name  -getText :: Maybe FilePath -> IO Text8-getText  = maybe C.getContents C.readFile+getTargetContents :: FilePath -> IO Text8+getTargetContents [] = C.getContents+getTargetContents xs = C.readFile xs   quickSearch :: Options -> [Text8] -> Text8 -> Maybe Bool

@@ -37,12 +37,12 @@  import Control.Arrow as A -search :: CgrepFunction+search :: Options -> [Text8] -> FilePath -> IO [Output] search opt ps f = do -    let filename = getFileName f+    let filename = getTargetName f -    text <- getText f+    text <- getTargetContents f      -- transform text 

@@ -37,12 +37,12 @@ import Util  -search :: CgrepFunction+search :: Options -> [Text8] -> FilePath -> IO [Output] search opt ps f = do -    let filename = getFileName f+    let filename = getTargetName f -    text <- getText f+    text <- getTargetContents f      -- transform text 

@@ -33,12 +33,13 @@ import Options import Debug -search :: CgrepFunction++search :: Options -> [Text8] -> FilePath -> IO [Output] search opt ps f = do -    let filename = getFileName f+    let filename = getTargetName f -    text <- getText f+    text <- getTargetContents f      -- transform text 

@@ -37,12 +37,13 @@ import Debug import Util -search :: CgrepFunction++search :: Options -> [Text8] -> FilePath -> IO [Output] search opt ps f = do -    let filename = getFileName f+    let filename = getTargetName f -    text <- getText f+    text <- getTargetContents f      -- transform text 

@@ -30,12 +30,13 @@ import Options import Debug -search :: CgrepFunction++search :: Options -> [Text8] -> FilePath -> IO [Output] search opt ps f = do -    let filename = getFileName f+    let filename = getTargetName f -    text <- getText f+    text <- getTargetContents f      -- transform text 

@@ -34,12 +34,12 @@ import Debug  -search :: CgrepFunction+search :: Options -> [Text8] -> FilePath -> IO [Output] search opt ps f = do -    let filename = getFileName f+    let filename = getTargetName f -    text <- getText f+    text <- getTargetContents f      -- transform text 

@@ -25,17 +25,17 @@  options :: Mode (CmdArgs Options) options = cmdArgsMode $ Options-          {     file  = ""  &= typ "FILE"   &= help "Read PATTERNs from file (one per line)" &= groupname "Pattern"+          {     file  = ""  &= typ "FILE"   &= groupname "Pattern" &= help "Read PATTERNs from file (one per line)"           ,     word_match  = False         &= help "Force word matching" &=explicit &= name "word" &= name "w"           ,     prefix_match  = False       &= help "Force prefix matching" &=explicit &= name "prefix" &= name "p"           ,     suffix_match  = False       &= help "Force suffix matching" &=explicit &= name "suffix" &= name "s"           ,     edit_dist   = False         &= help "Use edit distance" &=explicit &= name "edit" &= name "e"           ,     regex = False               &= help "Use regex matching" &= explicit &= name "G" &=name "regex"           ,     ignore_case = False         &= help "Ignore case distinctions"-          ,     code = False                &= help "Enable search in source code"     &= explicit &= name "c" &= name "code" &= groupname "\nContext filters (generic)"+          ,     code = False                &= groupname "\nContext filters (generic)" &= help "Enable search in source code"     &= explicit &= name "c" &= name "code"           ,     comment = False             &= help "Enable search in comments"        &= explicit &= name "m" &= name "comment"           ,     literal = False             &= help "Enable search in string literals" &= explicit &= name "l" &= name "literal"-          ,     identifier = False          &= help "Identifiers" &= explicit &= name "identifier" &= groupname "\nC/C++ language"+          ,     identifier = False          &= groupname "\nC/C++ language" &= help "Identifiers" &= explicit &= name "identifier"           ,     keyword = False             &= help "Keywords" &= explicit &= name "keyword"           ,     directive = False           &= help "Preprocessing directives" &= explicit &= name "directive"           ,     header = False              &= help "Headers names" &= explicit &= name "header"@@ -44,14 +44,13 @@           ,     char = False                &= help "Literal chars" &= explicit &= name "char"           ,     oper = False                &= help "Operators" &= explicit &= name "oper"           ,     semantic = False            &= groupname "\nSemantic (generic)" &= help "\"code\" pattern: _, _1, _2... (identifiers), $, $1, $2... (optionals), ANY, KEY, STR, CHR, LIT, NUM, HEX, OCT, OR. -> e.g. \"_1(_1 && \\$)\" search for move constructors, \"struct OR class _ { OR : OR <\" search for a class declaration" &= explicit &= name "S" &= name "semantic"-          ,     no_filename = False         &= help "Suppress the file name prefix on output"  &= explicit &= name "h" &= name "no-filename" &= groupname "\nOutput control"+          ,     no_filename = False         &= groupname "\nOutput control"&= help "Suppress the file name prefix on output"  &= explicit &= name "h" &= name "no-filename"           ,     no_linenumber= False        &= help "Suppress the line number on output lines" &= explicit &= name "N" &= name "no-line-umber"           ,     lang = []                   &= help "Specify languages. ie: Cpp, +Haskell, -Makefile"           ,     lang_maps = False           &= help "Lists the language mappings"           ,     force_language = Nothing    &= help "Force the language" &= explicit &= name "force-language"           ,     max_count = maxBound        &= help "Stop search in files after INT matches" &= explicit &= name "max-count"           ,     count = False               &= help "Print only a count of matching lines per file" &= explicit &= name "count"-          ,     jobs   = 1                  &= help "Number of jobs"           ,     multiline = 1               &= help "Enable multi-line matching"           ,     recursive = False           &= help "Enable recursive search (don't follow symlinks)" &= explicit &= name "recursive" &= name "r"           ,     deference_recursive = False &= help "Recursive, follow symlinks" &= explicit &= name "deference-recursive" &= name "R"@@ -62,10 +61,14 @@ #ifdef ENABLE_HINT           ,     hint = Nothing  &= typ "STRING" &= help "Haskell interpreter output. Var: file, row, line, tokens.\ne.g. \"file ++ show (tokens)\"" &= explicit &= name "hint" #endif-          ,     json = False               &= help "Format output as json object" &= explicit &= name "json"-          ,     xml = False                &= help "Format output as xml document" &= explicit &= name "xml"-          ,     debug = 0                  &= help "Debug level: 1, 2 or 3" &= groupname "\nMiscellaneous"-          ,     no_turbo = False           &= help "Disable turbo mode"-          ,     others = []                &= args+          ,     json = False                &= help "Format output as json object" &= explicit &= name "json"+          ,     xml = False                 &= help "Format output as xml document" &= explicit &= name "xml"+          ,     jobs   = 1                  &= groupname "\nParallel" &= help "Number of jobs"+          ,     cores  = 0                  &= help "Set number of physical processor used"+          ,     chunk  = 16                 &= help "Set per-job chunk length"+          ,     asynch = False              &= help "Process chunk of files asynchronously"+          ,     debug = 0                   &= groupname "\nMiscellaneous" &= help "Debug level: 1, 2 or 3"+          ,     no_turbo = False            &= help "Disable turbo mode"+          ,     others = []                 &= args           } &= summary ("Cgrep " ++ version ++ ". Usage: cgrep [OPTION] [PATTERN] files...") &= program "cgrep" 

@@ -31,7 +31,7 @@ cgreprc = "cgreprc"  version :: String-version = "6.4.22"+version = "6.5.0"   data Config = Config

@@ -19,14 +19,16 @@ module Main where  import Data.List-import qualified Data.Set as Set+import Data.List.Split import Data.Maybe import Data.Char import Data.Data() import Data.Function+import qualified Data.Set as Set  import Control.Exception as E import Control.Concurrent+import Control.Concurrent.Async import Control.Monad.STM import Control.Concurrent.STM.TChan @@ -59,23 +61,33 @@  -- push file names in Chan... -withRecursiveContents :: Options -> FilePath -> [Lang] -> [String] -> Set.Set FilePath -> (FilePath -> IO ()) -> IO ()+withRecursiveContents :: Options -> FilePath -> [Lang] -> [String] -> Set.Set FilePath -> ([FilePath] -> IO ()) -> IO () withRecursiveContents opts dir langs prunedir visited action = do     isDir <-  doesDirectoryExist dir     if isDir then do-               names <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents dir-               forM_ names $ \n -> E.catch (do-                    let path = dir </> n-                        filename = takeFileName path-                    fstatus <- getFileStatus path+               xs <- getDirectoryContents dir+               (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, x `notElem` [".", ".."]]+               -- process files+               let files' = flip mapMaybe files+                                (\n -> let filename = takeFileName n+                                       in if isNothing $ getFileLang opts filename >>= (\f -> f `elemIndex` langs <|> toMaybe 0 (null langs))+                                            then Nothing+                                            else Just n)++               unless (null files') $+                    let chunks = chunksOf (Options.chunk opts) files' in+                    forM_ chunks $ \b -> action b++               -- process dirs+               --+               forM_ dirs $ \path -> do+                    let filename = takeFileName path                     lstatus <- getSymbolicLinkStatus path-                    if isDirectory fstatus && (deference_recursive opts || not (isSymbolicLink lstatus))-                        then unless (filename `elem` prunedir) $ do -- this is a good directory (unless already visited)!-                                cpath <- canonicalizePath path-                                unless (cpath `Set.member` visited) $ withRecursiveContents opts path langs prunedir (Set.insert cpath visited) action-                        else unless (isNothing $ getFileLang opts filename >>= (\f -> f `elemIndex` langs <|> toMaybe 0 (null langs))) $ action path-                ) (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr ("Cgrep: " ++ msg))-             else action dir+                    when ( deference_recursive opts || not (isSymbolicLink lstatus)) $+                        unless (filename `elem` prunedir) $ do -- this is a good directory (unless already visited)!+                            cpath <- canonicalizePath path+                            unless (cpath `Set.member` visited) $ withRecursiveContents opts path langs prunedir (Set.insert cpath visited) action+             else action [dir]   -- read patterns from file@@ -107,16 +119,16 @@      forM_ [1 .. jobs opts] $ \_ -> forkIO $         void $ runEitherT $ forever $ do-            f <- lift $ atomically $ readTChan in_chan-            lift $ E.catch (case f of-                    Nothing -> atomically $ writeTChan out_chan []-                    Just x  -> do-                        out <- let op = sanitizeOptions x opts in-                            liftM (take (max_count opts)) $ cgrepDispatch op x op patterns $ guard (x /= "") >> f-                        unless (null out) $ atomically $ writeTChan out_chan out+            fs <- lift $ atomically $ readTChan in_chan+            lift $ E.catch (case fs of+                    [] -> atomically $ writeTChan out_chan []+                    xs -> void ((if asynch opts then flip mapConcurrently+                                                else forM) xs $ \x -> do+                            out <- let op = sanitizeOptions x opts in (liftM (take (max_count opts)) $ cgrepDispatch op x op patterns x)+                            unless (null out) $ atomically $ writeTChan out_chan out)                    )-                   (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFile opts (fromMaybe "<STDIN>" f) ++ ": exception: " ++ if length msg > 80 then take 80 msg ++ "..." else msg))-            when (isNothing f) $ left ()+                   (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFile opts (getTargetName (head fs)) ++ ": exception: " ++ if length msg > 80 then take 80 msg ++ "..." else msg))+            when (null fs) $ left ()       -- push the files to grep for...@@ -124,12 +136,12 @@     _ <- forkIO $ do          if recursive opts || deference_recursive opts-            then forM_ (if null paths then ["."] else paths) $ \p -> withRecursiveContents opts p langs (configPruneDirs conf) (Set.singleton p) (atomically . writeTChan in_chan . Just)-            else forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . Just)+            then forM_ (if null paths then ["."] else paths) $ \p -> withRecursiveContents opts p langs (configPruneDirs conf) (Set.singleton p) (atomically . writeTChan in_chan)+            else forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . (:[]))          -- enqueue EOF messages: -        replicateM_ (jobs opts) ((atomically . writeTChan in_chan) Nothing)+        replicateM_ (jobs opts) ((atomically . writeTChan in_chan) [])      -- dump output until workers are done @@ -216,6 +228,10 @@     putStrLevel1 (debug opts) $ "files     : " ++ show paths     putStrLevel1 (debug opts) $ "isTermIn  : " ++ show isTermIn     putStrLevel1 (debug opts) $ "isTermOut : " ++ show isTermOut++    -- specify number of cores++    when (cores opts /= 0) $ setNumCapabilities (cores opts)      parallelSearch conf opts paths patterns' langs (isTermIn, isTermOut) 

@@ -53,7 +53,6 @@     ,   lang_maps           :: Bool     ,   force_language      :: Maybe String     -- General:-    ,   jobs                :: Int     ,   multiline           :: Int     ,   recursive           :: Bool     ,   deference_recursive :: Bool@@ -68,6 +67,12 @@     ,   format              :: Maybe String     ,   json                :: Bool     ,   xml                 :: Bool+    -- Parallel:+    ,   jobs                :: Int+    ,   cores               :: Int+    ,   chunk               :: Int+    ,   asynch              :: Bool+    -- Misc:     ,   debug               :: Int     ,   no_turbo            :: Bool     ,   others              :: [String]

@@ -25,6 +25,16 @@  import Data.Maybe import Data.Char+import Control.Monad++-- from hlint :-)++partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])+partitionM f [] = return ([], [])+partitionM f (x:xs) = do+    res <- f x+    (as,bs) <- partitionM f xs+    return ([x | res]++as, [x | not res]++bs)   toMaybe :: a -> Bool -> Maybe a