cgrep 6.5.3 → 6.5.4
raw patch · 15 files changed
+282/−235 lines, 15 filesdep +transformers
Dependencies added: transformers
Files
- README.md +1/−1
- cgrep.cabal +3/−2
- src/CGrep/CGrep.hs +24/−18
- src/CGrep/Common.hs +13/−4
- src/CGrep/Distance.hs +7/−6
- src/CGrep/Output.hs +52/−44
- src/CGrep/Strategy/BoyerMoore.hs +25/−27
- src/CGrep/Strategy/Cpp/Semantic.hs +29/−30
- src/CGrep/Strategy/Cpp/Tokenizer.hs +36/−35
- src/CGrep/Strategy/Generic/Semantic.hs +26/−25
- src/CGrep/Strategy/Levenshtein.hs +13/−8
- src/CGrep/Strategy/Regex.hs +11/−7
- src/Config.hs +1/−1
- src/Debug.hs +15/−6
- src/Main.hs +26/−21
README.md view
@@ -4,7 +4,7 @@ Usage ----- -Cgrep 6.5.3 Usage: cgrep [OPTION] [PATTERN] files...+Cgrep 6.5.4 Usage: cgrep [OPTION] [PATTERN] files... cgrep [OPTIONS] [ITEM]
cgrep.cabal view
@@ -1,6 +1,6 @@ Name: cgrep Description: Cgrep: a context-aware grep for source codes-Version: 6.5.3+Version: 6.5.4 Synopsis: Command line tool Homepage: http://awgn.github.io/cgrep/ License: GPL-2@@ -45,6 +45,7 @@ either >= 4.0, mtl >= 2.0, unix-compat >= 0.4,- async >= 2.0+ async >= 2.0,+ transformers Ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N Default-language: Haskell2010
src/CGrep/CGrep.hs view
@@ -25,8 +25,11 @@ import qualified CGrep.Strategy.Cpp.Semantic as CppSemantic import qualified CGrep.Strategy.Generic.Semantic as Semantic +import Control.Monad.Trans.Reader+ import CGrep.Lang import CGrep.Common+import CGrep.Output import Data.List import Data.Maybe@@ -53,24 +56,27 @@ hasTokenizerOpt :: Options -> Bool hasTokenizerOpt Options- { identifier = i- , keyword = k- , directive = d- , header = h- , number = n- , string = s- , char = c- , oper = o- } = i || k || d || h || n || s || c || o+ { identifier = i+ , keyword = k+ , directive = d+ , header = h+ , number = n+ , string = s+ , char = c+ , oper = o+ } = i || k || d || h || n || s || c || o -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- | not (regex opt) && semantic opt && hasLanguage f opt [C,Cpp] = CppSemantic.search- | not (regex opt) && semantic opt = Semantic.search- | not (regex opt) = CppTokenizer.search- | regex opt = Regex.search- | otherwise = undefined+cgrepDispatch :: FilePath -> [Text8] -> ReaderT Options IO [Output]+cgrepDispatch filename patterns = do+ opt <- ask+ case () of+ _ | not (regex opt) && not (hasTokenizerOpt opt) && not (semantic opt) && edit_dist opt -> Levenshtein.search filename patterns+ | not (regex opt) && not (hasTokenizerOpt opt) && not (semantic opt) -> BoyerMoore.search filename patterns+ | not (regex opt) && semantic opt && hasLanguage filename opt [C,Cpp] -> CppSemantic.search filename patterns+ | not (regex opt) && semantic opt -> Semantic.search filename patterns+ | not (regex opt) -> CppTokenizer.search filename patterns+ | regex opt -> Regex.search filename patterns+ | otherwise -> undefined+
src/CGrep/Common.hs view
@@ -16,10 +16,11 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -module CGrep.Common (SearchFunction, Text8,+module CGrep.Common (Text8, getTargetName, getTargetContents, quickSearch,+ runSearch, expandMultiline, ignoreCase, trim, trim8) where@@ -28,6 +29,7 @@ import qualified Data.ByteString.Search as SC import Data.Char +import Control.Monad.Trans.Reader import CGrep.Types import CGrep.Output @@ -35,9 +37,6 @@ import Util -type SearchFunction = Options -> [Text8] -> FilePath -> IO [Output]-- trim :: String -> String trim = (dropWhile isSpace . reverse) . dropWhile isSpace . reverse @@ -61,6 +60,16 @@ | no_turbo opt = Nothing | otherwise = Just $ any has_pattern ps || null ps where has_pattern pat = notNull $ pat `SC.nonOverlappingIndices` text+++runSearch :: FilePath+ -> Maybe Bool -- quicksearch+ -> ReaderT Options IO [Output]+ -> ReaderT Options IO [Output]+runSearch filename quick doSearch =+ if maybe False not quick+ then mkOutput filename C.empty C.empty []+ else doSearch expandMultiline :: Options -> Text8 -> Text8
src/CGrep/Distance.hs view
@@ -25,17 +25,18 @@ distance :: Eq a => [a] -> [a] -> Int distance a b = last (if lab == 0 then mainDiag- else if lab > 0 then lowers !! (lab - 1)- else{- < 0 -} uppers !! (-1 - lab))+ else if lab > 0 then lowers !! (lab - 1)+ else {- < 0 -} uppers !! (-1 - lab)) where mainDiag = oneDiag a b (head uppers) (-1 : head lowers) uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals- eachDiag _ [] _ = []- eachDiag a' (_:bs) (lastDiag:diags) = oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags+ eachDiag _a [] _diags = []+ eachDiag a' (_bch:bs) (lastDiag:diags) = oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags where nextDiag = head (tail diags)+ eachDiag _ _ [] = undefined -- the original implementation does not cover this case... oneDiag a' b' diagAbove diagBelow = thisdiag- where doDiag [] _ _ _ _ = []- doDiag _ [] _ _ _ = []+ where doDiag [] _b _nw _n _w = []+ doDiag _a [] _nw _n _w = [] doDiag (ach:as) (bch:bs) nw n w = me : doDiag as bs me (tail n) (tail w) where me = if ach == bch then nw else 1 + min3 (head w) nw (head n) firstelt = 1 + head diagBelow
src/CGrep/Output.hs view
@@ -30,6 +30,9 @@ import Language.Haskell.Interpreter #endif +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+ import Data.Maybe import Data.List import Data.List.Split@@ -57,11 +60,13 @@ _ -> (length prc, off - last prc - 1) -mkOutput :: Options -> FilePath -> Text8 -> Text8 -> [Token] -> [Output]-mkOutput Options { invert_match = invert } f text multi ts- | invert = map (\(n, xs) -> Output f n (ls !! (n-1)) xs) . invertMatchLines (length ls) $ mkMatchLines multi ts- | otherwise = map (\(n, xs) -> Output f n (ls !! (n-1)) xs) $ mkMatchLines multi ts- where ls = C.lines text+mkOutput :: (Monad m) => FilePath -> Text8 -> Text8 -> [Token] -> ReaderT Options m [Output]+mkOutput f text multi ts = do+ invert <- reader invert_match+ case () of+ _ | invert -> return $ map (\(n, xs) -> Output f n (ls !! (n-1)) xs) . invertMatchLines (length ls) $ mkMatchLines multi ts+ | otherwise -> return $ map (\(n, xs) -> Output f n (ls !! (n-1)) xs) $ mkMatchLines multi ts+ where ls = C.lines text mkMatchLines :: Text8 -> [Token] -> [MatchLine]@@ -77,51 +82,52 @@ where idx = map fst xs -putPrettyHeader :: Options -> IO ()-putPrettyHeader opt =+putPrettyHeader :: ReaderT Options IO ()+putPrettyHeader = do+ opt <- ask case () of- _ | json opt -> putStrLn "["- | xml opt -> putStrLn "<?xml version=\"1.0\"?>" >> putStrLn "<cgrep>"+ _ | json opt -> liftIO $ putStrLn "["+ | xml opt -> liftIO $ putStrLn "<?xml version=\"1.0\"?>" >> putStrLn "<cgrep>" | otherwise -> return () -putPrettyFooter :: Options -> IO ()-putPrettyFooter opt =+putPrettyFooter :: ReaderT Options IO ()+putPrettyFooter = do+ opt <- ask case () of- _ | json opt -> putStrLn "]"- | xml opt -> putStrLn "</cgrep>"+ _ | json opt -> liftIO $ putStrLn "]"+ | xml opt -> liftIO $ putStrLn "</cgrep>" | otherwise -> return () -prettyOutput :: Options -> [Output] -> IO [String]-prettyOutput opt out+prettyOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+prettyOutput out = do+ opt <- ask+ case () of+ _ | isJust $ format opt -> mapM formatOutput out+ | json opt -> jsonOutput out+ | xml opt -> xmlOutput out #ifdef ENABLE_HINT- | isJust $ hint opt = hintOputput opt out+ | isJust $ hint opt -> hintOputput out #endif- | isJust $ format opt = return $ map (formatOutput opt) out- | json opt = return $ jsonOutput opt out- | xml opt = return $ xmlOutput opt out- | otherwise = return $ defaultOutput opt out---defaultOutput :: Options -> [Output] -> [String]+ | otherwise -> defaultOutput out -defaultOutput opt@Options{ no_filename = False, no_linenumber = False , count = False } xs =- map (\(Output f n l ts) -> showFile opt f ++ ":" ++ show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l) xs-defaultOutput opt@Options{ no_filename = False, no_linenumber = True , count = False } xs =- map (\(Output f _ l ts) -> showFile opt f ++ ":" ++ showTokens opt ts ++ showLine opt ts l) xs-defaultOutput opt@Options{ no_filename = True , no_linenumber = False , count = False } xs =- map (\(Output _ n l ts) -> show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l) xs-defaultOutput opt@Options{ no_filename = True , no_linenumber = True , count = False } xs =- map (\(Output _ _ l ts) -> showTokens opt ts ++ showLine opt ts l) xs-defaultOutput opt@Options{ count = True } xs =- let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs- in map (\ys@(y:_) -> showFile opt (outputFilename y) ++ ":" ++ show (length ys)) gs- where outputFilename (Output f _ _ _) = f+defaultOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+defaultOutput xs = do+ opt <- ask+ case () of+ _ | Options{ no_filename = False, no_linenumber = False , count = False } <- opt -> return $ map (\(Output f n l ts) -> showFile opt f ++ ":" ++ show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l) xs+ | Options{ no_filename = False, no_linenumber = True , count = False } <- opt -> return $ map (\(Output f _ l ts) -> showFile opt f ++ ":" ++ showTokens opt ts ++ showLine opt ts l) xs+ | Options{ no_filename = True , no_linenumber = False , count = False } <- opt -> return $ map (\(Output _ n l ts) -> show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l) xs+ | Options{ no_filename = True , no_linenumber = True , count = False } <- opt -> return $ map (\(Output _ _ l ts) -> showTokens opt ts ++ showLine opt ts l) xs+ | Options{ count = True } <- opt -> do let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs+ return $ map (\ys@(y:_) -> showFile opt (outputFilename y) ++ ":" ++ show (length ys)) gs+ | otherwise -> undefined+ where outputFilename (Output f _ _ _) = f -jsonOutput :: Options -> [Output] -> [String]-jsonOutput _ outs =+jsonOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+jsonOutput outs = return $ [" { \"file\": " ++ show fname ++ ", \"matches\": ["] ++ [ intercalate "," (foldl mkMatch [] outs) ] ++ ["] }"]@@ -130,8 +136,8 @@ mkMatch xs (Output _ n l ts) = xs ++ [ "{ \"row\": " ++ show n ++ ", \"tokens\": [" ++ intercalate "," (map mkToken ts) ++ "], \"line\":" ++ show l ++ "}" ] -xmlOutput :: Options -> [Output] -> [String]-xmlOutput _ outs =+xmlOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+xmlOutput outs = return $ ["<file name=" ++ show fname ++ ">" ] ++ ["<matches>" ] ++ [foldl mkMatch "" outs] ++@@ -143,9 +149,10 @@ unwords (map mkToken ts) ++ "</match>" -formatOutput :: Options -> Output -> String-formatOutput opt (Output f n l ts) =- foldl trans (fromJust $ format opt)+formatOutput :: (Monad m) => Output -> ReaderT Options m String+formatOutput (Output f n l ts) = do+ opt <- ask+ return $ foldl trans (fromJust $ format opt) [ ("#f", showFile opt f), ("#n", show n),@@ -174,8 +181,9 @@ #ifdef ENABLE_HINT-hintOputput :: Options -> [Output] -> IO [String]-hintOputput opt outs = do+hintOputput :: [Output] -> ReaderT Options IO [String]+hintOputput outs = do+ opt <- ask let cmds = map mkCmd outs out <- runInterpreter $ setImports ["Prelude", "Data.List"] >> mapM (`interpret` (as :: String)) cmds return $ either ((:[]) . show) id out
src/CGrep/Strategy/BoyerMoore.hs view
@@ -22,6 +22,9 @@ import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Search as SC +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+import Control.Arrow as A import Data.List import CGrep.Common@@ -35,54 +38,49 @@ import Options import Debug -import Control.Arrow as A -search :: Options -> [Text8] -> FilePath -> IO [Output]-search opt ps f = do+search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search f ps = do + opt <- ask+ let filename = getTargetName f - text <- getTargetContents f+ text <- liftIO $ getTargetContents f -- transform text let text' = ignoreCase opt text - -- quick search...-- found = quickSearch opt ps text'- -- put banners... - putStrLevel1 (debug opt) $ "strategy : running string search on " ++ filename ++ "..."+ putStrLevel1 $ "strategy : running string search on " ++ filename ++ "..." - if maybe False not found- then return $ mkOutput opt filename text text []- else do+ runSearch filename (quickSearch opt ps text') $ do - -- context filter+ -- context filter - let text'' = contextFilter (getFileLang opt filename) (mkContextFilter opt) text'+ let text'' = contextFilter (getFileLang opt filename) (mkContextFilter opt) text' - -- expand multi-line+ -- expand multi-line - text''' = expandMultiline opt text''+ text''' = expandMultiline opt text'' - -- search for matching tokens+ -- search for matching tokens - tokens = map (A.second C.unpack) $ ps >>= (\p -> map (\i -> (i,p)) (p `SC.nonOverlappingIndices` text'''))+ tokens = map (A.second C.unpack) $ ps >>= (\p -> map (\i -> (i,p)) (p `SC.nonOverlappingIndices` text''')) - -- filter exact/partial matching tokens+ -- filter exact/partial matching tokens - tokens' = if word_match opt || prefix_match opt || suffix_match opt- then filter (checkToken opt text''') tokens- else tokens+ tokens' = if word_match opt || prefix_match opt || suffix_match opt+ then filter (checkToken opt text''') tokens+ else tokens - putStrLevel2 (debug opt) $ "tokens : " ++ show tokens- putStrLevel2 (debug opt) $ "tokens' : " ++ show tokens'- putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text''' ++ "\n---"+ putStrLevel2 $ "tokens : " ++ show tokens+ putStrLevel2 $ "tokens' : " ++ show tokens'+ putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---" - return $ mkOutput opt filename text text''' tokens'+ mkOutput filename text text''' tokens' checkToken :: Options -> Text8 -> (Offset, String) -> Bool@@ -93,7 +91,7 @@ where (text',off') = getLineByOffset off text ts = T.tokenizer text' -checkToken _ _ (_,_) = undefined+checkToken _ _ (_,_) = undefined splitLines :: Text8 -> [(Text8,Offset)]
src/CGrep/Strategy/Cpp/Semantic.hs view
@@ -21,6 +21,12 @@ import qualified Data.ByteString.Char8 as C import qualified CGrep.Semantic.Cpp.Token as Cpp +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+import Data.List+import Data.Function+import Data.Maybe+ import CGrep.Filter import CGrep.Lang import CGrep.Common@@ -28,21 +34,19 @@ import CGrep.Semantic.WildCard -import Data.List-import Data.Function-import Data.Maybe- import Options import Debug import Util -search :: Options -> [Text8] -> FilePath -> IO [Output]-search opt ps f = do+search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search f ps = do + opt <- ask+ let filename = getTargetName f - text <- getTargetContents f+ text <- liftIO $ getTargetContents f -- transform text @@ -66,40 +70,35 @@ _ -> Nothing ) . concat) patterns' - found = quickSearch opt (map C.pack ps') text'- -- put banners... - putStrLevel1 (debug opt) $ "strategy : running C/C++ semantic search on " ++ filename ++ "..."- putStrLevel2 (debug opt) $ "wildcards : " ++ show patterns'- putStrLevel2 (debug opt) $ "multicards: " ++ show patterns''- putStrLevel2 (debug opt) $ "identif : " ++ show ps'-- if maybe False not found- then return $ mkOutput opt filename text text []- else do+ putStrLevel1 $ "strategy : running C/C++ semantic search on " ++ filename ++ "..."+ putStrLevel2 $ "wildcards : " ++ show patterns'+ putStrLevel2 $ "multicards: " ++ show patterns''+ putStrLevel2 $ "identif : " ++ show ps' - -- context filter+ runSearch filename (quickSearch opt (map C.pack ps') text') $ do+ -- context filter - let text'' = contextFilter (getFileLang opt filename) filt text'+ let text'' = contextFilter (getFileLang opt filename) filt text' - -- expand multi-line+ -- expand multi-line - text''' = expandMultiline opt text''+ text''' = expandMultiline opt text'' - -- parse source code, get the Cpp.Token list...+ -- parse source code, get the Cpp.Token list... - tokens = Cpp.tokenizer text'''+ tokens = Cpp.tokenizer text''' - -- get matching tokens ...+ -- get matching tokens ... - tokens' = sortBy (compare `on` Cpp.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''+ tokens' = sortBy (compare `on` Cpp.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns'' - matches = map (\t -> let n = fromIntegral (Cpp.toOffset t) in (n, Cpp.toString t)) tokens' :: [(Int, String)]+ matches = map (\t -> let n = fromIntegral (Cpp.toOffset t) in (n, Cpp.toString t)) tokens' :: [(Int, String)] - putStrLevel2 (debug opt) $ "tokens : " ++ show tokens'- putStrLevel2 (debug opt) $ "matches : " ++ show matches- putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text''' ++ "\n---"+ putStrLevel2 $ "tokens : " ++ show tokens'+ putStrLevel2 $ "matches : " ++ show matches+ putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---" - return $ mkOutput opt filename text text''' matches+ mkOutput filename text text''' matches
src/CGrep/Strategy/Cpp/Tokenizer.hs view
@@ -19,9 +19,11 @@ module CGrep.Strategy.Cpp.Tokenizer (search) where import qualified Data.ByteString.Char8 as C- import qualified CGrep.Semantic.Cpp.Token as Cpp +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+ import CGrep.Filter import CGrep.Lang import CGrep.Common@@ -34,66 +36,64 @@ import Debug -search :: Options -> [Text8] -> FilePath -> IO [Output]-search opt ps f = do+search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search f ps = do + opt <- ask+ let filename = getTargetName f - text <- getTargetContents f+ text <- liftIO $ getTargetContents f -- transform text let text' = ignoreCase opt text filt = (mkContextFilter opt) { getComment = False } - putStrLevel1 (debug opt) $ "strategy : running C/C++ token search on " ++ filename ++ "..."+ putStrLevel1 $ "strategy : running C/C++ token search on " ++ filename ++ "..." --quickSearch ... - let found = quickSearch opt ps text'-- if maybe False not found- then return $ mkOutput opt filename text text []- else do+ runSearch filename (quickSearch opt ps text') $ do - -- context filter+ -- context filter - let text'' = contextFilter (getFileLang opt filename) filt text'+ let text'' = contextFilter (getFileLang opt filename) filt text' - -- expand multi-line+ -- expand multi-line - text''' = expandMultiline opt text''+ text''' = expandMultiline opt text'' - -- parse source code, get the Cpp.Token list...+ -- parse source code, get the Cpp.Token list... - tokens = Cpp.tokenizer text'''+ tokens = Cpp.tokenizer text''' - -- context-filterting...+ -- context-filterting... - tokens'= filter (Cpp.tokenFilter Cpp.TokenFilter { Cpp.filtIdentifier = identifier opt,- Cpp.filtDirective = directive opt,- Cpp.filtKeyword = keyword opt,- Cpp.filtHeader = header opt,- Cpp.filtString = string opt,- Cpp.filtNumber = number opt,- Cpp.filtChar = char opt,- Cpp.filtOper = oper opt}) tokens+ tokens'= filter (Cpp.tokenFilter Cpp.TokenFilter { Cpp.filtIdentifier = identifier opt,+ Cpp.filtDirective = directive opt,+ Cpp.filtKeyword = keyword opt,+ Cpp.filtHeader = header opt,+ Cpp.filtString = string opt,+ Cpp.filtNumber = number opt,+ Cpp.filtChar = char opt,+ Cpp.filtOper = oper opt}) tokens - -- filter tokens...+ -- filter tokens... - tokens'' = cppTokenFilter opt (map C.unpack ps) tokens'+ tokens'' = cppTokenFilter opt (map C.unpack ps) tokens' - -- convert Cpp.Tokens to CGrep.Tokens+ -- convert Cpp.Tokens to CGrep.Tokens - matches = map (\t -> let off = fromIntegral (Cpp.toOffset t) in (off, Cpp.toString t)) tokens'' :: [(Int, String)]+ matches = map (\t -> let off = fromIntegral (Cpp.toOffset t) in (off, Cpp.toString t)) tokens'' :: [(Int, String)] - putStrLevel2 (debug opt) $ "tokens : " ++ show tokens- putStrLevel2 (debug opt) $ "tokens' : " ++ show tokens'- putStrLevel2 (debug opt) $ "tokens'' : " ++ show tokens''- putStrLevel2 (debug opt) $ "matches : " ++ show matches- putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text''' ++ "\n---"+ putStrLevel2 $ "tokens : " ++ show tokens+ putStrLevel2 $ "tokens' : " ++ show tokens'+ putStrLevel2 $ "tokens'' : " ++ show tokens''+ putStrLevel2 $ "matches : " ++ show matches+ putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---" - return $ mkOutput opt filename text text''' matches+ mkOutput filename text text''' matches cppTokenFilter :: Options -> [String] -> [Cpp.Token] -> [Cpp.Token]@@ -103,4 +103,5 @@ | prefix_match opt = filter ((\t -> any (`isPrefixOf`t) patterns) . Cpp.toString) tokens | suffix_match opt = filter ((\t -> any (`isSuffixOf`t) patterns) . Cpp.toString) tokens | otherwise = filter ((\t -> any (`isInfixOf` t) patterns) . Cpp.toString) tokens+
src/CGrep/Strategy/Generic/Semantic.hs view
@@ -29,6 +29,9 @@ import CGrep.Semantic.Token import CGrep.Semantic.WildCard +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+ import Data.List import Data.Function import Data.Maybe@@ -38,12 +41,14 @@ import Util -search :: Options -> [Text8] -> FilePath -> IO [Output]-search opt ps f = do+search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search f ps = do + opt <- ask+ let filename = getTargetName f - text <- getTargetContents f+ text <- liftIO $ getTargetContents f -- transform text @@ -66,41 +71,37 @@ _ -> Nothing ) . concat) patterns' - found = quickSearch opt (map C.pack ps') text'- -- put banners... - putStrLevel1 (debug opt) $ "strategy : running generic semantic search on " ++ filename ++ "..."- putStrLevel2 (debug opt) $ "wildcards : " ++ show patterns'- putStrLevel2 (debug opt) $ "multicards: " ++ show patterns''- putStrLevel2 (debug opt) $ "identif : " ++ show ps'+ putStrLevel1 $ "strategy : running generic semantic search on " ++ filename ++ "..."+ putStrLevel2 $ "wildcards : " ++ show patterns'+ putStrLevel2 $ "multicards: " ++ show patterns''+ putStrLevel2 $ "identif : " ++ show ps' - if maybe False not found- then return $ mkOutput opt filename text text []- else do+ runSearch filename (quickSearch opt (map C.pack ps') text') $ do - -- context filter+ -- context filter - let text'' = contextFilter (getFileLang opt filename) filt text'+ let text'' = contextFilter (getFileLang opt filename) filt text' - -- expand multi-line+ -- expand multi-line - text''' = expandMultiline opt text''+ text''' = expandMultiline opt text'' - -- parse source code, get the Generic.Token list...+ -- parse source code, get the Generic.Token list... - tokens = Generic.tokenizer text'''+ tokens = Generic.tokenizer text''' - -- get matching tokens ...+ -- get matching tokens ... - tokens' = sortBy (compare `on` Generic.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''+ tokens' = sortBy (compare `on` Generic.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns'' - matches = map (\t -> let n = fromIntegral (Generic.toOffset t) in (n, Generic.toString t)) tokens' :: [(Int, String)]+ matches = map (\t -> let n = fromIntegral (Generic.toOffset t) in (n, Generic.toString t)) tokens' :: [(Int, String)] - putStrLevel2 (debug opt) $ "tokens : " ++ show tokens'- putStrLevel2 (debug opt) $ "matches : " ++ show matches- putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text''' ++ "\n---"+ putStrLevel2 $ "tokens : " ++ show tokens'+ putStrLevel2 $ "matches : " ++ show matches+ putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---" - return $ mkOutput opt filename text text''' matches+ mkOutput filename text text''' matches
src/CGrep/Strategy/Levenshtein.hs view
@@ -20,6 +20,9 @@ import qualified Data.ByteString.Char8 as C +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+ import CGrep.Filter import CGrep.Lang import CGrep.Common@@ -31,12 +34,14 @@ import Debug -search :: Options -> [Text8] -> FilePath -> IO [Output]-search opt ps f = do+search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search f ps = do + opt <- ask+ let filename = getTargetName f - text <- getTargetContents f+ text <- liftIO $ getTargetContents f -- transform text @@ -54,10 +59,10 @@ matches = filter (\t -> any (\p -> p ~== snd t) patterns) tokens' - putStrLevel1 (debug opt) $ "strategy : running edit-distance (Levenshtein) search on " ++ filename ++ "..."- putStrLevel2 (debug opt) $ "tokens : " ++ show tokens'- putStrLevel2 (debug opt) $ "matches : " ++ show matches- putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text'' ++ "\n---"+ putStrLevel1 $ "strategy : running edit-distance (Levenshtein) search on " ++ filename ++ "..."+ putStrLevel2 $ "tokens : " ++ show tokens'+ putStrLevel2 $ "matches : " ++ show matches+ putStrLevel3 $ "---\n" ++ C.unpack text'' ++ "\n---" - return $ mkOutput opt filename text text'' matches+ mkOutput filename text text'' matches
src/CGrep/Strategy/Regex.hs view
@@ -22,6 +22,8 @@ import qualified Data.ByteString.Char8 as C +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class import Text.Regex.Posix import Data.Array @@ -34,12 +36,14 @@ import Debug -search :: Options -> [Text8] -> FilePath -> IO [Output]-search opt ps f = do+search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search f ps = do + opt <- ask+ let filename = getTargetName f - text <- getTargetContents f+ text <- liftIO $ getTargetContents f -- transform text @@ -58,9 +62,9 @@ tokens = map (\(str, (off,_)) -> (off, C.unpack str) ) $ concatMap elems $ ps >>= (\p -> elems (getAllTextMatches $ text''' =~ p :: (Array Int) (MatchText Text8))) - putStrLevel1 (debug opt) $ "strategy : running regex search on " ++ filename ++ "..."- putStrLevel2 (debug opt) $ "tokens : " ++ show tokens- putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text''' ++ "\n---"+ putStrLevel1 $ "strategy : running regex search on " ++ filename ++ "..."+ putStrLevel2 $ "tokens : " ++ show tokens+ putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---" - return $ mkOutput opt filename text text''' tokens+ mkOutput filename text text''' tokens
src/Config.hs view
@@ -31,7 +31,7 @@ cgreprc = "cgreprc" version :: String-version = "6.5.3"+version = "6.5.4" data Config = Config
src/Debug.hs view
@@ -19,13 +19,22 @@ module Debug where +import Control.Monad.Trans.Reader+import Control.Monad.IO.Class import Control.Monad+import Options -putStrLevel1 :: Int -> String -> IO ()-putStrLevel1 n xs = when (n > 0) $ putStrLn xs+putStrLevel1 :: String -> ReaderT Options IO ()+putStrLevel1 xs = do+ n <- reader debug+ when (n > 0) $ liftIO $ putStrLn xs -putStrLevel2 :: Int -> String -> IO ()-putStrLevel2 n xs = when (n > 1) $ putStrLn xs+putStrLevel2 :: String -> ReaderT Options IO ()+putStrLevel2 xs = do+ n <- reader debug+ when (n > 1) $ liftIO $ putStrLn xs -putStrLevel3 :: Int -> String -> IO ()-putStrLevel3 n xs = when (n > 2) $ putStrLn xs+putStrLevel3 :: String -> ReaderT Options IO ()+putStrLevel3 xs = do+ n <- reader debug+ when (n > 2) $ liftIO $ putStrLn xs
src/Main.hs view
@@ -35,6 +35,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Either+import Control.Monad.Trans.Reader import Control.Applicative import System.Console.CmdArgs@@ -107,25 +108,27 @@ getFilePaths _ False _ = [ ] -parallelSearch :: Config -> Options -> [FilePath] -> [C.ByteString] -> [Lang] -> (Bool, Bool) -> IO ()-parallelSearch conf opts paths patterns langs (isTermIn, _) = do+parallelSearch :: Config -> [FilePath] -> [C.ByteString] -> [Lang] -> (Bool, Bool) -> ReaderT Options IO ()+parallelSearch conf paths patterns langs (isTermIn, _) = do + opts <- ask+ -- create Transactional Chan and Vars... - in_chan <- newTChanIO- out_chan <- newTChanIO+ in_chan <- liftIO newTChanIO+ out_chan <- liftIO newTChanIO -- launch worker threads... - forM_ [1 .. jobs opts] $ \_ -> forkIO $+ forM_ [1 .. jobs opts] $ \_ -> liftIO . forkIO $ void $ runEitherT $ forever $ do 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)+ out <- fmap (take (max_count opts)) (runReaderT (cgrepDispatch x patterns) (sanitizeOptions x opts))+ unless (null out) $ atomically $ writeTChan out_chan out) ) (\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 ()@@ -133,7 +136,7 @@ -- push the files to grep for... - _ <- forkIO $ do+ _ <- liftIO . 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)@@ -145,25 +148,26 @@ -- dump output until workers are done - putPrettyHeader opts+ putPrettyHeader let stop = jobs opts fix (\action n m -> unless (n == stop) $ do- out <- atomically $ readTChan out_chan+ out <- liftIO $ atomically $ readTChan out_chan case out of [] -> action (n+1) m _ -> do case () of- _ | json opts -> when m $ putStrLn ","+ _ | json opts -> when m $ liftIO $ putStrLn "," | otherwise -> return ()- prettyOutput opts out >>= mapM_ putStrLn+ prettyOutput out >>= mapM_ (liftIO . putStrLn) action n True ) 0 False - putPrettyFooter opts+ putPrettyFooter + main :: IO () main = do @@ -221,17 +225,18 @@ let langs = (if null l0 then configLanguages conf else l0 `union` l1) \\ l2 - putStrLevel1 (debug opts) $ "Cgrep " ++ version ++ "!"- putStrLevel1 (debug opts) $ "options : " ++ show opts- putStrLevel1 (debug opts) $ "languages : " ++ show langs- putStrLevel1 (debug opts) $ "pattern : " ++ show patterns- putStrLevel1 (debug opts) $ "files : " ++ show paths- putStrLevel1 (debug opts) $ "isTermIn : " ++ show isTermIn- putStrLevel1 (debug opts) $ "isTermOut : " ++ show isTermOut+ runReaderT (do putStrLevel1 $ "Cgrep " ++ version ++ "!"+ putStrLevel1 $ "options : " ++ show opts+ putStrLevel1 $ "languages : " ++ show langs+ putStrLevel1 $ "pattern : " ++ show patterns+ putStrLevel1 $ "files : " ++ show paths+ putStrLevel1 $ "isTermIn : " ++ show isTermIn+ putStrLevel1 $ "isTermOut : " ++ show isTermOut+ ) opts -- specify number of cores when (cores opts /= 0) $ setNumCapabilities (cores opts) - parallelSearch conf opts paths patterns' langs (isTermIn, isTermOut)+ runReaderT (parallelSearch conf paths patterns' langs (isTermIn, isTermOut)) opts