diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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] diff --git a/cgrep.cabal b/cgrep.cabal --- a/cgrep.cabal +++ b/cgrep.cabal @@ -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 diff --git a/src/CGrep/CGrep.hs b/src/CGrep/CGrep.hs --- a/src/CGrep/CGrep.hs +++ b/src/CGrep/CGrep.hs @@ -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 + diff --git a/src/CGrep/Common.hs b/src/CGrep/Common.hs --- a/src/CGrep/Common.hs +++ b/src/CGrep/Common.hs @@ -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 diff --git a/src/CGrep/Distance.hs b/src/CGrep/Distance.hs --- a/src/CGrep/Distance.hs +++ b/src/CGrep/Distance.hs @@ -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 diff --git a/src/CGrep/Output.hs b/src/CGrep/Output.hs --- a/src/CGrep/Output.hs +++ b/src/CGrep/Output.hs @@ -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 "" >> putStrLn "" + _ | json opt -> liftIO $ putStrLn "[" + | xml opt -> liftIO $ putStrLn "" >> putStrLn "" | otherwise -> return () -putPrettyFooter :: Options -> IO () -putPrettyFooter opt = +putPrettyFooter :: ReaderT Options IO () +putPrettyFooter = do + opt <- ask case () of - _ | json opt -> putStrLn "]" - | xml opt -> putStrLn "" + _ | json opt -> liftIO $ putStrLn "]" + | xml opt -> liftIO $ putStrLn "" | 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 $ ["" ] ++ ["" ] ++ [foldl mkMatch "" outs] ++ @@ -143,9 +149,10 @@ unwords (map mkToken ts) ++ "" -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 diff --git a/src/CGrep/Strategy/BoyerMoore.hs b/src/CGrep/Strategy/BoyerMoore.hs --- a/src/CGrep/Strategy/BoyerMoore.hs +++ b/src/CGrep/Strategy/BoyerMoore.hs @@ -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)] diff --git a/src/CGrep/Strategy/Cpp/Semantic.hs b/src/CGrep/Strategy/Cpp/Semantic.hs --- a/src/CGrep/Strategy/Cpp/Semantic.hs +++ b/src/CGrep/Strategy/Cpp/Semantic.hs @@ -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 diff --git a/src/CGrep/Strategy/Cpp/Tokenizer.hs b/src/CGrep/Strategy/Cpp/Tokenizer.hs --- a/src/CGrep/Strategy/Cpp/Tokenizer.hs +++ b/src/CGrep/Strategy/Cpp/Tokenizer.hs @@ -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 + diff --git a/src/CGrep/Strategy/Generic/Semantic.hs b/src/CGrep/Strategy/Generic/Semantic.hs --- a/src/CGrep/Strategy/Generic/Semantic.hs +++ b/src/CGrep/Strategy/Generic/Semantic.hs @@ -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 diff --git a/src/CGrep/Strategy/Levenshtein.hs b/src/CGrep/Strategy/Levenshtein.hs --- a/src/CGrep/Strategy/Levenshtein.hs +++ b/src/CGrep/Strategy/Levenshtein.hs @@ -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 diff --git a/src/CGrep/Strategy/Regex.hs b/src/CGrep/Strategy/Regex.hs --- a/src/CGrep/Strategy/Regex.hs +++ b/src/CGrep/Strategy/Regex.hs @@ -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 diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -31,7 +31,7 @@ cgreprc = "cgreprc" version :: String -version = "6.5.3" +version = "6.5.4" data Config = Config diff --git a/src/Debug.hs b/src/Debug.hs --- a/src/Debug.hs +++ b/src/Debug.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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