cgrep 6.6.9 → 6.6.10
raw patch · 14 files changed
+111/−85 lines, 14 files
Files
- README.md +1/−1
- cgrep.cabal +1/−1
- src/CGrep/CGrep.hs +3/−3
- src/CGrep/Common.hs +3/−3
- src/CGrep/Output.hs +52/−46
- src/CGrep/Strategy/BoyerMoore.hs +3/−2
- src/CGrep/Strategy/Cpp/Semantic.hs +3/−3
- src/CGrep/Strategy/Cpp/Tokenizer.hs +3/−2
- src/CGrep/Strategy/Generic/Semantic.hs +3/−3
- src/CGrep/Strategy/Levenshtein.hs +3/−3
- src/CGrep/Strategy/Regex.hs +3/−2
- src/Config.hs +14/−1
- src/Debug.hs +8/−6
- src/Main.hs +11/−9
README.md view
@@ -7,7 +7,7 @@ Usage ----- -Cgrep 6.6.8. Usage: cgrep [OPTION] [PATTERN] files...+Cgrep 6.6.10. 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.6.9+Version: 6.6.10 Synopsis: Command line tool Homepage: http://awgn.github.io/cgrep/ License: GPL-2
src/CGrep/CGrep.hs view
@@ -34,7 +34,7 @@ import Data.List import Data.Maybe import Options-+import Reader hasLanguage :: FilePath -> Options -> [Lang] -> Bool hasLanguage path opt xs = isJust $ getFileLang opt path >>= (`elemIndex` xs)@@ -70,9 +70,9 @@ isRegexp :: Options -> Bool isRegexp opt = regex_posix opt || regex_pcre opt -runCgrep :: FilePath -> [Text8] -> ReaderT Options IO [Output]+runCgrep :: FilePath -> [Text8] -> OptionT IO [Output] runCgrep filename patterns = do- opt <- ask+ opt <- reader snd case () of _ | (not . isRegexp) opt && not (hasTokenizerOpt opt) && not (semantic opt) && edit_dist opt -> Levenshtein.search filename patterns | (not . isRegexp) opt && not (hasTokenizerOpt opt) && not (semantic opt) -> BoyerMoore.search filename patterns
src/CGrep/Common.hs view
@@ -30,11 +30,11 @@ import Data.Char -import Control.Monad.Trans.Reader import CGrep.Types import CGrep.Output import Options+import Reader import Util @@ -65,8 +65,8 @@ runQuickSearch :: FilePath -> Maybe Bool -- quicksearch- -> ReaderT Options IO [Output]- -> ReaderT Options IO [Output]+ -> OptionT IO [Output]+ -> OptionT IO [Output] runQuickSearch filename quick doSearch = if maybe False not quick then mkOutput filename C.empty C.empty []
src/CGrep/Output.hs view
@@ -31,7 +31,6 @@ import Language.Haskell.Interpreter #endif -import Control.Monad import Control.Monad.Trans.Reader import Control.Monad.IO.Class @@ -42,8 +41,10 @@ import CGrep.Types import CGrep.Token -import Safe import Options+import Config+import Reader+import Safe data Output = Output@@ -66,9 +67,9 @@ _ -> (length prc, off - last prc - 1) -mkOutput :: (Monad m) => FilePath -> Text8 -> Text8 -> [Token] -> ReaderT Options m [Output]+mkOutput :: (Monad m) => FilePath -> Text8 -> Text8 -> [Token] -> OptionT m [Output] mkOutput f text multi ts = do- invert <- reader invert_match+ invert <- reader (invert_match . snd) return $ if invert then map (\(n, xs) -> Output f n (ls !! (n-1)) xs) . invertMatchLines (length ls) $ mkMatchLines multi ts else map (\(n, xs) -> Output f n (ls !! (n-1)) xs) $ mkMatchLines multi ts where ls = C.lines text@@ -87,27 +88,27 @@ where idx = map fst xs -putPrettyHeader :: ReaderT Options IO ()+putPrettyHeader :: OptionT IO () putPrettyHeader = do- opt <- ask+ (_,opt) <- ask case () of _ | json opt -> liftIO $ putStrLn "[" | xml opt -> liftIO $ putStrLn "<?xml version=\"1.0\"?>" >> putStrLn "<cgrep>" | otherwise -> return () -putPrettyFooter :: ReaderT Options IO ()+putPrettyFooter :: OptionT IO () putPrettyFooter = do- opt <- ask+ (_,opt) <- ask case () of _ | json opt -> liftIO $ putStrLn "]" | xml opt -> liftIO $ putStrLn "</cgrep>" | otherwise -> return () -prettyOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+prettyOutput :: (Monad m) => [Output] -> OptionT m [String] prettyOutput out = do- opt <- ask+ (_,opt) <- ask case () of _ | isJust $ format opt -> mapM formatOutput out | filename_only opt -> filenameOutput out@@ -118,20 +119,24 @@ #endif | otherwise -> defaultOutput out -defaultOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+defaultOutput :: (Monad m) => [Output] -> OptionT m [String] defaultOutput xs = do- opt <- ask+ (conf,opt) <- ask case () of- _ | Options{ no_filename = False, no_numbers = False , count = False } <- opt -> return $ map (\out -> concat $ [showFile, showSep ":", showLineCol, showSep ":", showTokens, showLine ] `ap` [opt] `ap` [out]) xs- | Options{ no_filename = False, no_numbers = True , count = False } <- opt -> return $ map (\out -> concat $ [showFile, showSep ":", showTokens, showLine] `ap` [opt] `ap` [out] ) xs- | Options{ no_filename = True , no_numbers = False , count = False } <- opt -> return $ map (\out -> concat $ [showLineCol, showSep ":", showTokens, showLine] `ap` [opt] `ap` [out] ) xs- | Options{ no_filename = True , no_numbers = True , count = False } <- opt -> return $ map (\out -> concat $ [showTokens, showLine] `ap` [opt] `ap` [out]) xs+ _ | Options{ no_filename = False, no_numbers = False , count = False } <- opt+ -> return $ map (\out -> concat $ [showFile conf, showSep ":", showLineCol, showSep ":", showTokens, showLine conf] <*> [opt] <*> [out]) xs+ | Options{ no_filename = False, no_numbers = True , count = False } <- opt+ -> return $ map (\out -> concat $ [showFile conf, showSep ":", showTokens, showLine conf] <*> [opt] <*> [out] ) xs+ | Options{ no_filename = True , no_numbers = False , count = False } <- opt+ -> return $ map (\out -> concat $ [showLineCol, showSep ":", showTokens, showLine conf] <*> [opt] <*> [out] ) xs+ | Options{ no_filename = True , no_numbers = True , count = False } <- opt+ -> return $ map (\out -> concat $ [showTokens, showLine conf] <*> [opt] <*> [out]) xs | Options{ count = True } <- opt -> do let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs- return $ map (\ys@(y:_) -> showFile opt y ++ ":" ++ show (length ys)) gs+ return $ map (\ys@(y:_) -> showFile conf opt y ++ ":" ++ show (length ys)) gs | otherwise -> undefined -jsonOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+jsonOutput :: (Monad m) => [Output] -> OptionT m [String] jsonOutput outs = return $ [" { \"file\": " ++ show fname ++ ", \"matches\": ["] ++ [ intercalate "," (foldl mkMatch [] outs) ] ++@@ -141,11 +146,11 @@ mkMatch xs (Output _ n l ts) = xs ++ [ "{ \"row\": " ++ show n ++ ", \"tokens\": [" ++ intercalate "," (map mkToken ts) ++ "], \"line\":" ++ show l ++ "}" ] -filenameOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+filenameOutput :: (Monad m) => [Output] -> OptionT m [String] filenameOutput outs = return $ nub $ map (\(Output fname _ _ _) -> fname) outs -xmlOutput :: (Monad m) => [Output] -> ReaderT Options m [String]+xmlOutput :: (Monad m) => [Output] -> OptionT m [String] xmlOutput outs = return $ ["<file name=" ++ show fname ++ ">" ] ++ ["<matches>" ] ++@@ -159,14 +164,14 @@ "</match>" -formatOutput :: (Monad m) => Output -> ReaderT Options m String+formatOutput :: (Monad m) => Output -> OptionT m String formatOutput out = do- opt <- ask+ (conf,opt) <- ask return $ replace (fromJust $ format opt) [- ("#f", showFile opt out),+ ("#f", showFile conf opt out), ("#n", showLineCol opt out),- ("#l", showLine opt out),+ ("#l", showLine conf opt out), ("#t", show ts'), ("##", unwords ts'), ("#,", intercalate "," ts'),@@ -194,23 +199,21 @@ #ifdef ENABLE_HINT-hintOputput :: [Output] -> ReaderT Options IO [String]+hintOputput :: [Output] -> OptionT IO [String] hintOputput outs = do- opt <- ask+ (_,opt) <- ask let cmds = map mkCmd outs out <- runInterpreter $ setImports ["Prelude", "Data.List"] >> mapM (`interpret` (as :: String)) cmds return $ either ((:[]) . show) id out where mkCmd out@(Output f n l ts) = "let a # b = a !! b " ++ "; file = " ++ show (showFile opt out) ++ "; row = " ++ show n ++- "; line = " ++ show (showLine opt ts l) +++ "; line = " ++ show (showLine conf opt ts l) ++ "; tokens = " ++ show (map snd ts) ++ " in " ++ (fromJust $ hint opt) #endif -blue, bold, resetTerm :: String--blue = setSGRCode [SetColor Foreground Vivid Blue]+bold, resetTerm :: String bold = setSGRCode [SetConsoleIntensity BoldIntensity] resetTerm = setSGRCode [] @@ -222,8 +225,8 @@ showSep xs _ _ = xs -showFile :: Options -> Output -> String-showFile opt = showFileName opt . outFilePath+showFile :: Config -> Options -> Output -> String+showFile conf opt = showFileName conf opt . outFilePath showLineCol :: Options -> Output -> String@@ -237,38 +240,40 @@ | st = show (map snd (outTokens out)) | otherwise = "" -showLine :: Options -> Output -> String-showLine Options { color = c, no_color = c' } out- | c && not c'= hilightLine (sortBy (flip compare `on` (length . snd )) (outTokens out)) (C.unpack (outLine out))++showLine :: Config -> Options -> Output -> String+showLine conf Options { color = c, no_color = c' } out+ | c && not c'= hilightLine conf (sortBy (flip compare `on` (length . snd )) (outTokens out)) (C.unpack (outLine out)) | otherwise = C.unpack (outLine out) -showFileName :: Options -> String -> String-showFileName opt = showColor opt (bold ++ blue)+showFileName :: Config -> Options -> String -> String+showFileName conf opt = showColoredAs opt $ setSGRCode (configColorFile conf) showBold :: Options -> String -> String-showBold opt = showColor opt bold+showBold opt = showColoredAs opt bold -showColor :: Options -> ColorString -> String -> String-showColor Options { color = c, no_color = c'} colorCode f- | c && not c'= colorCode ++ f ++ resetTerm- | otherwise = f+showColoredAs :: Options -> ColorString -> String -> String+showColoredAs Options { color = c, no_color = c'} colorCode str+ | c && not c'= colorCode ++ str ++ resetTerm+ | otherwise = str -hilightLine :: [Token] -> String -> String-hilightLine ts = hilightLine' (hilightIndicies ts, 0, 0)+hilightLine :: Config -> [Token] -> String -> String+hilightLine conf ts = hilightLine' (hilightIndicies ts, 0, 0) where hilightLine' :: ([(Int, Int)], Int, Int) -> String -> String hilightLine' _ [] = [] hilightLine' (ns, n, bs) s@(x:_) = (case () of- _ | check && bs' == 0 -> if fst stack > 0 then bold ++ [x] ++ resetTerm+ _ | check && bs' == 0 -> if fst stack > 0 then colorMatch ++ [x] ++ resetTerm else x : resetTerm- | check && bs' > 0 -> bold ++ [x]+ | check && bs' > 0 -> colorMatch ++ [x] | otherwise -> next ) ++ hilightLine' (ns, n + nn, bs') rest where stack = foldr (\(a, b) (c, d) -> (c + fromEnum (a == n), d + fromEnum (b == n))) (0, 0) ns check = fst stack > 0 || snd stack > 0+ colorMatch = setSGRCode (configColorMatch conf) bs' = bs + fst stack - snd stack plain = nub . sort $ foldr (\(a, b) acc -> a : b : acc) [] ns nn | check = 1@@ -276,6 +281,7 @@ | otherwise = head plain' - n where plain' = dropWhile (<=n) plain (next, rest) = splitAt nn s+ hilightIndicies :: [Token] -> [(Int, Int)] hilightIndicies = foldr (\t a -> let b = fst t in (b, b + length (snd t) - 1) : a) [] . filter (not . null . snd)
src/CGrep/Strategy/BoyerMoore.hs view
@@ -35,14 +35,15 @@ import qualified CGrep.Token as T +import Reader import Options import Debug -search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search :: FilePath -> [Text8] -> OptionT IO [Output] search f patterns = do - opt <- ask+ opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f
src/CGrep/Strategy/Cpp/Semantic.hs view
@@ -34,15 +34,15 @@ import CGrep.Parser.WildCard -import Options+import Reader import Debug import Util -search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search :: FilePath -> [Text8] -> OptionT IO [Output] search f patterns = do - opt <- ask+ opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f
src/CGrep/Strategy/Cpp/Tokenizer.hs view
@@ -32,14 +32,15 @@ import Data.List +import Reader import Options import Debug -search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search :: FilePath -> [Text8] -> OptionT IO [Output] search f ps = do - opt <- ask+ opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f
src/CGrep/Strategy/Generic/Semantic.hs view
@@ -36,15 +36,15 @@ import Data.Function import Data.Maybe -import Options+import Reader import Debug import Util -search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search :: FilePath -> [Text8] -> OptionT IO [Output] search f ps = do - opt <- ask+ opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f
src/CGrep/Strategy/Levenshtein.hs view
@@ -30,14 +30,14 @@ import CGrep.Distance import CGrep.Token -import Options+import Reader import Debug -search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search :: FilePath -> [Text8] -> OptionT IO [Output] search f patterns = do - opt <- ask+ opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f
src/CGrep/Strategy/Regex.hs view
@@ -36,15 +36,16 @@ import CGrep.Filter import CGrep.Lang +import Reader import Options import Debug -search :: FilePath -> [Text8] -> ReaderT Options IO [Output]+search :: FilePath -> [Text8] -> OptionT IO [Output] search f patterns = do - opt <- ask+ opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f
src/Config.hs view
@@ -24,6 +24,7 @@ import Control.Monad import System.Directory import System.FilePath ((</>))+import System.Console.ANSI import Util import CGrep.Lang@@ -37,10 +38,22 @@ { configLanguages :: [Lang] , configPruneDirs :: [String] , configAutoColor :: Bool+ , configColorFile :: [SGR]+ , configColorMatch :: [SGR] } deriving (Show, Read) +defaultConfig :: Config +defaultConfig = Config+ { configLanguages = []+ , configPruneDirs = []+ , configAutoColor = False+ , configColorFile = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Blue]+ , configColorMatch = [SetConsoleIntensity BoldIntensity]+ }++ dropComments :: String -> String dropComments = unlines . filter notComment . lines where notComment = (not . ("#" `isPrefixOf`)) . dropWhile isSpace@@ -53,6 +66,6 @@ if notNull confs then liftM dropComments (readFile (head confs)) >>= \xs -> return (prettyRead xs "Config error" :: Config, Just (head confs))- else return (Config [] [] False, Nothing)+ else return (defaultConfig, Nothing)
src/Debug.hs view
@@ -22,20 +22,22 @@ import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Control.Monad+ import Options+import Reader -putStrLevel1 :: String -> ReaderT Options IO ()+putStrLevel1 :: String -> OptionT IO () putStrLevel1 xs = do- n <- reader debug+ n <- reader $ debug . snd when (n > 0) $ liftIO $ putStrLn xs -putStrLevel2 :: String -> ReaderT Options IO ()+putStrLevel2 :: String -> OptionT IO () putStrLevel2 xs = do- n <- reader debug+ n <- reader $ debug . snd when (n > 1) $ liftIO $ putStrLn xs -putStrLevel3 :: String -> ReaderT Options IO ()+putStrLevel3 :: String -> OptionT IO () putStrLevel3 xs = do- n <- reader debug+ n <- reader $ debug . snd when (n > 2) $ liftIO $ putStrLn xs
src/Main.hs view
@@ -63,6 +63,7 @@ import Util import Debug import Config+import Reader import qualified Data.ByteString.Char8 as C @@ -128,10 +129,10 @@ getFilePaths _ False _ = [ ] -parallelSearch :: Config -> [FilePath] -> [C.ByteString] -> [Lang] -> (Bool, Bool) -> ReaderT Options IO ()-parallelSearch conf paths patterns langs (isTermIn, _) = do+parallelSearch :: [FilePath] -> [C.ByteString] -> [Lang] -> (Bool, Bool) -> OptionT IO ()+parallelSearch paths patterns langs (isTermIn, _) = do - opts <- ask+ (conf,opts) <- ask -- create Transactional Chan and Vars... @@ -147,10 +148,10 @@ [] -> atomically $ writeTChan out_chan [] xs -> void ((if asynch opts then flip mapConcurrently else forM) xs $ \x -> do- out <- fmap (take (max_count opts)) (runReaderT (runCgrep x patterns) (sanitizeOptions x opts))+ out <- fmap (take (max_count opts)) (runReaderT (runCgrep x patterns) (conf,sanitizeOptions x opts)) unless (null out) $ atomically $ writeTChan out_chan out) )- (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFileName opts (getTargetName (head fs)) ++ ": exception: " ++ if length msg > 80 then take 80 msg ++ "..." else msg))+ (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFileName conf opts (getTargetName (head fs)) ++ ": exception: " ++ if length msg > 80 then take 80 msg ++ "..." else msg)) when (null fs) $ left () @@ -214,8 +215,9 @@ -- read command-line options - opts <- (if isTermOut then (\o@Options{color = c} -> o { color = c || configAutoColor conf})- else id) <$> cmdArgsRun options+ opts <- (if isTermOut+ then \o -> o { color = (color o || configAutoColor conf) }+ else id) <$> cmdArgsRun options -- check for multiple backends... @@ -272,7 +274,7 @@ putStrLevel1 $ "files : " ++ show paths putStrLevel1 $ "isTermIn : " ++ show isTermIn putStrLevel1 $ "isTermOut : " ++ show isTermOut- ) opts+ ) (conf, opts) -- specify number of cores @@ -280,6 +282,6 @@ -- run search - runReaderT (parallelSearch conf paths patterns' langs (isTermIn, isTermOut)) opts+ runReaderT (parallelSearch paths patterns' langs (isTermIn, isTermOut)) (conf, opts)