cgrep 6.4.20 → 6.4.21
raw patch · 21 files changed
+411/−455 lines, 21 files
Files
- README.md +1/−1
- cgrep.cabal +3/−3
- src/CGrep/CGrep.hs +28/−39
- src/CGrep/Common.hs +15/−41
- src/CGrep/Context.hs +6/−5
- src/CGrep/Distance.hs +1/−0
- src/CGrep/Filter.hs +27/−34
- src/CGrep/Lang.hs +40/−40
- src/CGrep/Output.hs +1/−4
- src/CGrep/Semantic/Cpp/Token.hs +21/−25
- src/CGrep/Semantic/Generic/Token.hs +19/−17
- src/CGrep/Semantic/WildCard.hs +56/−54
- src/CGrep/Strategy/Cpp/Semantic.hs +3/−2
- src/CGrep/Strategy/Cpp/Tokenizer.hs +0/−1
- src/CGrep/Strategy/Generic/Semantic.hs +2/−2
- src/CGrep/Token.hs +9/−8
- src/CmdOptions.hs +40/−51
- src/Config.hs +5/−9
- src/Main.hs +63/−59
- src/Options.hs +47/−56
- src/Util.hs +24/−4
README.md view
@@ -4,7 +4,7 @@ Usage ----- -Cgrep 6.4.20 Usage: cgrep [OPTION] [PATTERN] files...+Cgrep 6.4.21 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.4.20+Version: 6.4.21 Synopsis: Command line tool Homepage: http://awgn.github.io/cgrep/ License: GPL-2@@ -19,7 +19,7 @@ Hs-Source-Dirs: src Default-Extensions: CPP - Other-Extensions: DeriveDataTypeable, + Other-Extensions: DeriveDataTypeable, ViewPatterns, MagicHash, BangPatterns, @@ -45,5 +45,5 @@ either >= 4.0, mtl >= 2.0, unix-compat >= 0.4- Ghc-options: -O2 -Wall -threaded + Ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N Default-language: Haskell2010
src/CGrep/CGrep.hs view
@@ -38,50 +38,39 @@ sanitizeOptions :: FilePath -> Options -> Options-sanitizeOptions path opt = if hasLanguage path opt [C, Cpp]- then opt- else opt {- identifier = False,- keyword = False,- directive = False,- header = False,- string = False,- char = False,- oper = False- }--hasEditDistOpt :: Options -> Bool-hasEditDistOpt Options { edit_dist = x } = x---hasRegexOpt :: Options -> Bool-hasRegexOpt Options{ regex = x } = x+sanitizeOptions path opt =+ if hasLanguage path opt [C, Cpp]+ then opt+ else opt { identifier = False+ , keyword = False+ , directive = False+ , header = False+ , string = False+ , char = False+ , oper = False+ } 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---hasSemanticOpt :: Options -> Bool-hasSemanticOpt Options{ semantic = s } = s+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 cgrepDispatch :: Options -> FilePath -> CgrepFunction- cgrepDispatch opt f- | not (hasRegexOpt opt) && not (hasTokenizerOpt opt) && not (hasSemanticOpt opt) && hasEditDistOpt opt = Levenshtein.search- | not (hasRegexOpt opt) && not (hasTokenizerOpt opt) && not (hasSemanticOpt opt) = BoyerMoore.search- | not (hasRegexOpt opt) && hasSemanticOpt opt && hasLanguage f opt [C,Cpp] = CppSemantic.search- | not (hasRegexOpt opt) && hasSemanticOpt opt = Semantic.search- | not (hasRegexOpt opt) = CppTokenizer.search- | hasRegexOpt opt = Regex.search- | otherwise = undefined-+ | 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
src/CGrep/Common.hs view
@@ -16,34 +16,36 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -{-# LANGUAGE FlexibleContexts #-}- module CGrep.Common (CgrepFunction, Text8, getFileName, getText, quickSearch, expandMultiline, ignoreCase,- spanGroup,- trim,- trim8,- unquotes) where+ trim, trim8) where import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Search as SC- import Data.Char-import Data.Array.Unboxed import CGrep.Types import CGrep.Output import Options+import Util type CgrepFunction = Options -> [Text8] -> Maybe FilePath -> IO [Output] +trim :: String -> String+trim = (dropWhile isSpace . reverse) . dropWhile isSpace . reverse+++trim8 :: Text8 -> Text8+trim8 = (C.dropWhile isSpace . C.reverse) . C.dropWhile isSpace . C.reverse++ getFileName :: Maybe FilePath -> String getFileName Nothing = "<STDIN>" getFileName (Just name) = name@@ -57,18 +59,7 @@ quickSearch opt ps text | no_turbo opt = Nothing | otherwise = Just $ any has_pattern ps- where has_pattern pat = not . null $ pat `SC.nonOverlappingIndices` text---toLowercase :: Char -> Char-toLowercase x = ctypeLowercase ! x- where ctypeLowercase = listArray ('\0','\255') (map toLower ['\0'..'\255']) :: UArray Char Char---ignoreCase :: Options -> Text8 -> Text8-ignoreCase Options { ignore_case = icase }- | icase = C.map toLowercase- | otherwise = id+ where has_pattern pat = notNull $ pat `SC.nonOverlappingIndices` text expandMultiline :: Options -> Text8 -> Text8@@ -77,25 +68,8 @@ | otherwise = C.unlines $ map C.unwords $ spanGroup n (C.lines xs) -spanGroup :: Int -> [a] -> [[a]]-spanGroup _ [] = []-spanGroup 1 xs = map (: []) xs-spanGroup n xs = take n xs : spanGroup n (tail xs)---trim :: String -> String-trim = (dropWhile isSpace . reverse) . dropWhile isSpace . reverse---trim8 :: Text8 -> Text8-trim8 = (C.dropWhile isSpace . C.reverse) . C.dropWhile isSpace . C.reverse---unquotes :: String -> String-unquotes [] = []-unquotes [x] = [x]-unquotes y@(x:xs)- | x == '"' || x == '\'' = if x == last xs then init xs- else y- | otherwise = y+ignoreCase :: Options -> Text8 -> Text8+ignoreCase Options { ignore_case = icase }+ | icase = C.map toLowercase+ | otherwise = id
src/CGrep/Context.hs view
@@ -20,11 +20,12 @@ data Context = Code | Comment | Literal- deriving (Eq, Show)+ deriving (Eq, Show) -data ContextFilter = ContextFilter { getCode :: Bool,- getComment :: Bool,- getLiteral :: Bool- } deriving (Eq, Show)+data ContextFilter = ContextFilter+ { getCode :: Bool+ , getComment :: Bool+ , getLiteral :: Bool+ } deriving (Eq, Show)
src/CGrep/Distance.hs view
@@ -49,3 +49,4 @@ | otherwise = dist < (len * 40 `div` 100) where len = fromIntegral (length a `min` length b) dist = distance a b+
src/CGrep/Filter.hs view
@@ -30,14 +30,11 @@ import Data.Array.Unboxed import qualified Data.ByteString.Char8 as C- import qualified Data.Map as Map #ifdef __GLASGOW_HASKELL__- import GHC.Prim import GHC.Exts- #endif @@ -48,40 +45,37 @@ data Boundary = Boundary- {- _beg :: !Text8 ,- _end :: !Text8- }- deriving (Show)+ { _beg :: !Text8+ , _end :: !Text8+ } deriving (Show) data ParConf = ParConf- {- commBound :: [Boundary],- litrBound :: [Boundary],- bloom :: UArray Char Bool- }+ { commBound :: [Boundary]+ , litrBound :: [Boundary]+ , bloom :: UArray Char Bool+ } deriving (Show) + data ParState = ParState- {- cxtState :: !ContextState,- display :: !Bool,- skip :: !Int- }- deriving (Show)+ { cxtState :: !ContextState+ , display :: !Bool+ , skip :: !Int+ } deriving (Show) data ContextState = CodeState | CommState Int | LitrState Int- deriving (Show, Eq, Ord)+ deriving (Show, Eq, Ord) -- filter Context: -- mkContextFilter :: Options -> ContextFilter-mkContextFilter opt = if not (code opt || comment opt || literal opt)- then ContextFilter { getCode = True, getComment = True, getLiteral = True }- else ContextFilter { getCode = code opt, getComment = comment opt, getLiteral = literal opt }+mkContextFilter opt =+ if not (code opt || comment opt || literal opt)+ then ContextFilter { getCode = True, getComment = True, getLiteral = True }+ else ContextFilter { getCode = code opt, getComment = comment opt, getLiteral = literal opt } contextFilter :: Maybe Lang -> ContextFilter -> Text8 -> Text8@@ -97,7 +91,6 @@ -- contextFilterFun: -- - contextFilterFun :: ParConf -> ContextFilter -> Text8 -> Text8 contextFilterFun conf filt txt = fst $ C.unfoldrN (C.length txt) (contextFilterImpl conf) (txt, filt, ParState CodeState False 0) @@ -161,20 +154,20 @@ #ifdef __GLASGOW_HASKELL__ findIndex' :: (a -> Bool) -> [a] -> Int-findIndex' p ls = loop 0# ls- where- loop _ [] = -1- loop n (x:xs) | p x = I# n- | otherwise = loop (n +# 1#) xs+findIndex' p ls =+ loop 0# ls+ where loop _ [] = -1+ loop n (x:xs) | p x = I# n+ | otherwise = loop (n +# 1#) xs #else findIndex' :: (a -> Bool) -> [a] -> Int-findIndex' p = loop 0- where- loop n [] = -1- loop n (x:xs) | p x = n- | otherwise = loop (n + 1) xs+findIndex' p =+ loop 0+ where loop n [] = -1+ loop n (x:xs) | p x = n+ | otherwise = loop (n + 1) xs #endif
src/CGrep/Lang.hs view
@@ -29,14 +29,15 @@ import Util data Lang = Awk | C | Cpp | Cabal | Csharp | Chapel | Coffee | Conf | Css | CMake | D | Erlang | Fsharp | Go | Haskell |- Html | Java | Javascript | Latex | Lua | Make | OCaml | ObjectiveC |- Perl | PHP | Python | Ruby | Scala | Tcl | Text | Shell | Verilog | VHDL | Vim- deriving (Read, Show, Eq, Ord, Bounded)+ Html | Java | Javascript | Latex | Lua | Make | OCaml | ObjectiveC |+ Perl | PHP | Python | Ruby | Scala | Tcl | Text | Shell | Verilog | VHDL | Vim+ deriving (Read, Show, Eq, Ord, Bounded) data FileType = Name String | Ext String- deriving (Eq, Ord)+ deriving (Eq, Ord) + instance Show FileType where show (Name x) = x show (Ext e) = "*." ++ e@@ -48,41 +49,41 @@ langMap :: LangMapType langMap = Map.fromList [- (Awk, [Ext "awk", Ext "mawk", Ext "gawk"]),- (C, [Ext "c", Ext "C"]),- (Cpp, [Ext "cpp", Ext "CPP", Ext "cxx", Ext "cc", Ext "cp", Ext "tcc", Ext "h", Ext "H", Ext "hpp", Ext "ipp", Ext "HPP", Ext "hxx", Ext "hh", Ext "hp"]),- (Cabal, [Ext "cabal"]),- (Csharp, [Ext "cs", Ext "CS"]),- (Coffee, [Ext "coffee"]),- (Conf, [Ext "conf", Ext "cfg", Ext "doxy"]),- (Chapel, [Ext "chpl"]),- (Css, [Ext "css"]),- (CMake, [Name "CMakeLists.txt", Ext "cmake"]),- (D, [Ext "d", Ext "D"]),- (Erlang, [Ext "erl", Ext "ERL",Ext "hrl", Ext "HRL"]),- (Fsharp, [Ext "fs", Ext "fsx", Ext "fsi"]),- (Go, [Ext "go"]),- (Haskell, [Ext "hs", Ext "lhs", Ext "hsc"]),- (Html, [Ext "htm", Ext "html"]),- (Java, [Ext "java"]),- (Javascript,[Ext "js"]),- (Latex, [Ext "latex", Ext "tex"]),- (Lua, [Ext "lua"]),- (Make, [Name "Makefile", Name "makefile", Name "GNUmakefile", Ext "mk", Ext "mak"]),- (OCaml , [Ext "ml", Ext "mli"]),- (ObjectiveC,[Ext "m", Ext "mi"]),- (Perl, [Ext "pl", Ext "pm", Ext "pm6", Ext "plx", Ext "perl"]),- (PHP, [Ext "php", Ext "php3", Ext "php4", Ext "php5",Ext "phtml"]),- (Python, [Ext "py", Ext "pyx", Ext "pxd", Ext "pxi", Ext "scons"]),- (Ruby, [Ext "rb", Ext "ruby"]),- (Scala, [Ext "scala"]),- (Tcl, [Ext "tcl", Ext "tk"]),- (Text, [Ext "txt", Ext "md", Name "README", Name "INSTALL"]),- (Shell, [Ext "sh", Ext "bash", Ext "csh", Ext "tcsh", Ext "ksh", Ext "zsh"]),- (Verilog, [Ext "v", Ext "vh", Ext "sv"]),- (VHDL, [Ext "vhd", Ext "vhdl"]),- (Vim, [Ext "vim"])- ]+ (Awk, [Ext "awk", Ext "mawk", Ext "gawk"]),+ (C, [Ext "c", Ext "C"]),+ (Cpp, [Ext "cpp", Ext "CPP", Ext "cxx", Ext "cc", Ext "cp", Ext "tcc", Ext "h", Ext "H", Ext "hpp", Ext "ipp", Ext "HPP", Ext "hxx", Ext "hh", Ext "hp"]),+ (Cabal, [Ext "cabal"]),+ (Csharp, [Ext "cs", Ext "CS"]),+ (Coffee, [Ext "coffee"]),+ (Conf, [Ext "conf", Ext "cfg", Ext "doxy"]),+ (Chapel, [Ext "chpl"]),+ (Css, [Ext "css"]),+ (CMake, [Name "CMakeLists.txt", Ext "cmake"]),+ (D, [Ext "d", Ext "D"]),+ (Erlang, [Ext "erl", Ext "ERL",Ext "hrl", Ext "HRL"]),+ (Fsharp, [Ext "fs", Ext "fsx", Ext "fsi"]),+ (Go, [Ext "go"]),+ (Haskell, [Ext "hs", Ext "lhs", Ext "hsc"]),+ (Html, [Ext "htm", Ext "html"]),+ (Java, [Ext "java"]),+ (Javascript,[Ext "js"]),+ (Latex, [Ext "latex", Ext "tex"]),+ (Lua, [Ext "lua"]),+ (Make, [Name "Makefile", Name "makefile", Name "GNUmakefile", Ext "mk", Ext "mak"]),+ (OCaml , [Ext "ml", Ext "mli"]),+ (ObjectiveC,[Ext "m", Ext "mi"]),+ (Perl, [Ext "pl", Ext "pm", Ext "pm6", Ext "plx", Ext "perl"]),+ (PHP, [Ext "php", Ext "php3", Ext "php4", Ext "php5",Ext "phtml"]),+ (Python, [Ext "py", Ext "pyx", Ext "pxd", Ext "pxi", Ext "scons"]),+ (Ruby, [Ext "rb", Ext "ruby"]),+ (Scala, [Ext "scala"]),+ (Tcl, [Ext "tcl", Ext "tk"]),+ (Text, [Ext "txt", Ext "md", Name "README", Name "INSTALL"]),+ (Shell, [Ext "sh", Ext "bash", Ext "csh", Ext "tcsh", Ext "ksh", Ext "zsh"]),+ (Verilog, [Ext "v", Ext "vh", Ext "sv"]),+ (VHDL, [Ext "vhd", Ext "vhdl"]),+ (Vim, [Ext "vim"])+ ] langRevMap :: LangRevMapType@@ -102,7 +103,6 @@ getLang :: Options -> FilePath -> Maybe Lang getLang opts f = forcedLang opts <|> lookupLang f- dumpLangMap :: LangMapType -> IO ()
src/CGrep/Output.hs view
@@ -16,7 +16,6 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- - module CGrep.Output (Output(), mkOutput, putPrettyHeader,@@ -25,7 +24,6 @@ showFile) where import qualified Data.ByteString.Char8 as C- import System.Console.ANSI #ifdef ENABLE_HINT@@ -45,7 +43,7 @@ data Output = Output FilePath Int Text8 [Token]- deriving (Show)+ deriving (Show) getOffsetsLines :: Text8 -> [Int]@@ -224,5 +222,4 @@ hilightIndicies :: [Token] -> [Int] hilightIndicies = concatMap (\(o, s) -> take (length s) [o..])-
src/CGrep/Semantic/Cpp/Token.hs view
@@ -36,35 +36,32 @@ import CGrep.Semantic.Token type TokenizerState = (Source, Offset, CppState)--type Source = C.ByteString--type Offset = Int+type Source = C.ByteString+type Offset = Int -data Token = TokenIdentifier { toString :: String, toOffset :: Int } |- TokenDirective { toString :: String, toOffset :: Int } |- TokenKeyword { toString :: String, toOffset :: Int } |- TokenNumber { toString :: String, toOffset :: Int } |- TokenHeaderName { toString :: String, toOffset :: Int } |- TokenString { toString :: String, toOffset :: Int } |- TokenChar { toString :: String, toOffset :: Int } |- TokenOperOrPunct { toString :: String, toOffset :: Int }- deriving (Show, Eq, Ord)+data Token =+ TokenIdentifier { toString :: String, toOffset :: Int } |+ TokenDirective { toString :: String, toOffset :: Int } |+ TokenKeyword { toString :: String, toOffset :: Int } |+ TokenNumber { toString :: String, toOffset :: Int } |+ TokenHeaderName { toString :: String, toOffset :: Int } |+ TokenString { toString :: String, toOffset :: Int } |+ TokenChar { toString :: String, toOffset :: Int } |+ TokenOperOrPunct { toString :: String, toOffset :: Int }+ deriving (Show, Eq, Ord) data TokenFilter = TokenFilter- {- filtIdentifier :: Bool,- filtDirective :: Bool,- filtKeyword :: Bool,- filtHeader :: Bool,- filtString :: Bool,- filtNumber :: Bool,- filtChar :: Bool,- filtOper :: Bool-- } deriving (Show,Read,Eq)+ { filtIdentifier :: Bool+ , filtDirective :: Bool+ , filtKeyword :: Bool+ , filtHeader :: Bool+ , filtString :: Bool+ , filtNumber :: Bool+ , filtChar :: Bool+ , filtOper :: Bool+ } deriving (Show,Read,Eq) instance SemanticToken Token where@@ -357,7 +354,6 @@ where (C.uncons -> Just(x',xs')) = xs getLiteral _ _ _ _ = []- operOrPunct :: HS.HashSet String
src/CGrep/Semantic/Generic/Token.hs view
@@ -33,22 +33,24 @@ type DString = DL.DList Char -data TokenState = StateSpace |- StateAlpha |- StateDigit |- StateBracket |- StateLit1 |- StateLit2 |- StateOther- deriving (Eq, Enum, Show)+data TokenState =+ StateSpace |+ StateAlpha |+ StateDigit |+ StateBracket |+ StateLit1 |+ StateLit2 |+ StateOther+ deriving (Eq, Enum, Show) -data Token = TokenAlpha { toString :: String, toOffset :: Offset } |- TokenDigit { toString :: String, toOffset :: Offset } |- TokenBracket { toString :: String, toOffset :: Offset } |- TokenLiteral { toString :: String, toOffset :: Offset } |- TokenOther { toString :: String, toOffset :: Offset }- deriving (Show, Eq, Ord)+data Token =+ TokenAlpha { toString :: String, toOffset :: Offset } |+ TokenDigit { toString :: String, toOffset :: Offset } |+ TokenBracket { toString :: String, toOffset :: Offset } |+ TokenLiteral { toString :: String, toOffset :: Offset } |+ TokenOther { toString :: String, toOffset :: Offset }+ deriving (Show, Eq, Ord) instance SemanticToken Token where@@ -81,7 +83,6 @@ _isTokenOther _ = False - tokenCompare :: Token -> Token -> Bool tokenCompare (TokenAlpha { toString = l }) (TokenAlpha { toString = r }) = l == r tokenCompare (TokenDigit { toString = l }) (TokenDigit { toString = r }) = l == r@@ -145,8 +146,9 @@ tokenizer :: Text8 -> [Token]-tokenizer xs = (\(TokenAccum ss off _ acc out) -> DL.toList (if null (DL.toList acc) then out- else out `DL.snoc` mkToken (mkTokenCtor ss) off acc)) $ C.foldl' tokens' (TokenAccum StateSpace 0 0 DL.empty DL.empty) xs+tokenizer xs = (\(TokenAccum ss off _ acc out) ->+ DL.toList (if null (DL.toList acc) then out+ else out `DL.snoc` mkToken (mkTokenCtor ss) off acc)) $ C.foldl' tokens' (TokenAccum StateSpace 0 0 DL.empty DL.empty) xs where tokens' :: TokenAccum -> Char -> TokenAccum tokens' (TokenAccum StateSpace off _ _ out) x = case () of
src/CGrep/Semantic/WildCard.hs view
@@ -34,19 +34,20 @@ import Data.Char import Data.List import Options-+import Util -data WildCard a = TokenCard a |- AnyCard |- KeyWordCard |- NumberCard |- OctCard |- HexCard |- StringCard |- LiteralCard |- CharCard |- IdentifCard String- deriving (Show, Eq, Ord)+data WildCard a =+ TokenCard a |+ AnyCard |+ KeyWordCard |+ NumberCard |+ OctCard |+ HexCard |+ StringCard |+ LiteralCard |+ CharCard |+ IdentifCard String+ deriving (Show, Eq, Ord) type MultiCard a = [WildCard a]@@ -70,8 +71,8 @@ mkWildCardFromToken t | tkIsIdentifier t = case () of _ | Just wc <- M.lookup str wildCardMap -> wc- | isWildCardPattern str -> IdentifCard str- | otherwise -> TokenCard $ tkToIdentif (rmWildCardEscape str) (tkToOffset t)+ | isWildCardPattern str -> IdentifCard str+ | otherwise -> TokenCard $ tkToIdentif (rmWildCardEscape str) (tkToOffset t) where str = tkToString t | otherwise = TokenCard t @@ -147,29 +148,30 @@ multiCardCheckOccurences :: (SemanticToken a) => [(Bool, (MultiCard a, [String]))] -> Bool multiCardCheckOccurences ts = M.foldr (\xs r -> r && all (== head xs) xs) True m- where m = M.mapWithKey (\k xs -> case k of- [IdentifCard "_0"] -> xs- [IdentifCard "_1"] -> xs- [IdentifCard "_2"] -> xs- [IdentifCard "_3"] -> xs- [IdentifCard "_4"] -> xs- [IdentifCard "_5"] -> xs- [IdentifCard "_6"] -> xs- [IdentifCard "_7"] -> xs- [IdentifCard "_8"] -> xs- [IdentifCard "_9"] -> xs- [IdentifCard "$0"] -> xs- [IdentifCard "$1"] -> xs- [IdentifCard "$2"] -> xs- [IdentifCard "$3"] -> xs- [IdentifCard "$4"] -> xs- [IdentifCard "$5"] -> xs- [IdentifCard "$6"] -> xs- [IdentifCard "$7"] -> xs- [IdentifCard "$8"] -> xs- [IdentifCard "$9"] -> xs- _ -> []- ) $ M.fromListWith (++) (map snd ts)+ where m = M.mapWithKey (\k xs ->+ case k of+ [IdentifCard "_0"] -> xs+ [IdentifCard "_1"] -> xs+ [IdentifCard "_2"] -> xs+ [IdentifCard "_3"] -> xs+ [IdentifCard "_4"] -> xs+ [IdentifCard "_5"] -> xs+ [IdentifCard "_6"] -> xs+ [IdentifCard "_7"] -> xs+ [IdentifCard "_8"] -> xs+ [IdentifCard "_9"] -> xs+ [IdentifCard "$0"] -> xs+ [IdentifCard "$1"] -> xs+ [IdentifCard "$2"] -> xs+ [IdentifCard "$3"] -> xs+ [IdentifCard "$4"] -> xs+ [IdentifCard "$5"] -> xs+ [IdentifCard "$6"] -> xs+ [IdentifCard "$7"] -> xs+ [IdentifCard "$8"] -> xs+ [IdentifCard "$9"] -> xs+ _ -> []+ ) $ M.fromListWith (++) (map snd ts) multiCardGroupCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [(Bool, (MultiCard a, [String]))]@@ -187,7 +189,6 @@ multiCardMatch :: (SemanticToken t) => Options -> MultiCard t -> t -> Bool multiCardMatch opt m t = any (\w -> wildCardMatch opt w t) m - wildCardMatch :: (SemanticToken t) => Options -> WildCard t -> t -> Bool wildCardMatch _ AnyCard _ = True wildCardMatch _ (IdentifCard _) t = tkIsIdentifier t@@ -197,22 +198,23 @@ wildCardMatch _ LiteralCard t = tkIsString t || tkIsChar t wildCardMatch _ NumberCard t = tkIsNumber t wildCardMatch _ OctCard t = tkIsNumber t && case tkToString t of ('0':d: _) -> isDigit d; _ -> False-wildCardMatch _ HexCard t = tkIsNumber t && case tkToString t of ('0':'x':_) -> True; _ -> False-+wildCardMatch _ HexCard t = tkIsNumber t && case tkToString t of ('0':'x':_) -> True; _ -> False wildCardMatch opt (TokenCard l) r- | tkIsIdentifier l && tkIsIdentifier r = case () of- _ | edit_dist opt -> tkToString l ~== tkToString r- | word_match opt -> tkToString l == tkToString r- | prefix_match opt -> tkToString l `isPrefixOf` tkToString r- | suffix_match opt -> tkToString l `isSuffixOf` tkToString r- | otherwise -> tkToString l `isInfixOf` tkToString r- | tkIsString l && tkIsString r = case () of- _ | edit_dist opt -> ls ~== rs- | word_match opt -> ls == rs- | prefix_match opt -> ls `isPrefixOf` rs- | suffix_match opt -> ls `isSuffixOf` rs- | otherwise -> ls `isInfixOf` rs- where ls = unquotes $ trim (tkToString l)- rs = unquotes $ trim (tkToString r)+ | tkIsIdentifier l && tkIsIdentifier r =+ case () of+ _ | edit_dist opt -> tkToString l ~== tkToString r+ | word_match opt -> tkToString l == tkToString r+ | prefix_match opt -> tkToString l `isPrefixOf` tkToString r+ | suffix_match opt -> tkToString l `isSuffixOf` tkToString r+ | otherwise -> tkToString l `isInfixOf` tkToString r+ | tkIsString l && tkIsString r =+ case () of+ _ | edit_dist opt -> ls ~== rs+ | word_match opt -> ls == rs+ | prefix_match opt -> ls `isPrefixOf` rs+ | suffix_match opt -> ls `isSuffixOf` rs+ | otherwise -> ls `isInfixOf` rs+ where ls = rmQuote $ trim (tkToString l)+ rs = rmQuote $ trim (tkToString r) | otherwise = l `tkEquivalent` r
src/CGrep/Strategy/Cpp/Semantic.hs view
@@ -34,6 +34,7 @@ import Options import Debug+import Util search :: CgrepFunction@@ -58,8 +59,8 @@ -- quick Search... ps' = filter (/= "OR") $ (mapMaybe (\x -> case x of- TokenCard (Cpp.TokenChar xs _) -> Just (unquotes $ trim xs)- TokenCard (Cpp.TokenString xs _) -> Just (unquotes $ trim xs)+ TokenCard (Cpp.TokenChar xs _) -> Just (rmQuote $ trim xs)+ TokenCard (Cpp.TokenString xs _) -> Just (rmQuote $ trim xs) TokenCard t -> Just (Cpp.toString t) _ -> Nothing ) . concat) patterns'
src/CGrep/Strategy/Cpp/Tokenizer.hs view
@@ -103,4 +103,3 @@ | 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
@@ -35,7 +35,7 @@ import Options import Debug-+import Util search :: CgrepFunction search opt ps f = do@@ -59,7 +59,7 @@ -- quickSearch ... ps' = filter (/= "OR") $ (mapMaybe (\x -> case x of- TokenCard (Generic.TokenLiteral xs _) -> Just (unquotes $ trim xs)+ TokenCard (Generic.TokenLiteral xs _) -> Just (rmQuote $ trim xs) TokenCard t -> Just (tkToString t) _ -> Nothing ) . concat) patterns'
src/CGrep/Token.hs view
@@ -26,23 +26,23 @@ import Data.Char import Data.Array.Unboxed- import CGrep.Types type Token = (Offset, String) type MatchLine = (OffsetLine, [Token])- type DString = DL.DList Char -data TokenState = StateSpace |- StateAlpha |- StateDigit |- StateBracket |- StateOther- deriving (Eq, Enum, Show)+data TokenState =+ StateSpace |+ StateAlpha |+ StateDigit |+ StateBracket |+ StateOther+ deriving (Eq, Enum, Show) + data TokenAccum = TokenAccum !TokenState !Offset DString (DL.DList Token) @@ -133,3 +133,4 @@ else TokenAccum StateDigit (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc) | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc) | otherwise -> TokenAccum StateOther (off+1) (acc `DL.snoc` x) out+
src/CmdOptions.hs view
@@ -25,58 +25,47 @@ options :: Mode (CmdArgs Options) options = cmdArgsMode $ Options- {- file = "" &= typ "FILE" &= help "Read PATTERNs from file (one per line)" &= groupname "Pattern",- 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)",- 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",- keyword = False &= help "Keywords" &= explicit &= name "keyword",- directive = False &= help "Preprocessing directives" &= explicit &= name "directive",- header = False &= help "Headers names" &= explicit &= name "header",- number = False &= help "Literal numbers" &= explicit &= name "number",- string = False &= help "Literal strings" &= explicit &= name "string",- 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_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",- invert_match = False &= help "Select non-matching lines" &= explicit &= name "invert-match" &= name "v",- show_match = False &= help "Show list of matching tokens" &= explicit &= name "show-match",- color = False &= help "Use colors to highlight the matching strings" &= explicit &= name "color",-- format = Nothing &= typ "STRING" &= help "Format output. Var: #f #n #l #t ## #, #; #0 #1...\ne.g. \"#f:#n #0 #1\"" &= explicit &= name "format",+ { file = "" &= typ "FILE" &= help "Read PATTERNs from file (one per line)" &= groupname "Pattern"+ , 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)"+ , 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"+ , keyword = False &= help "Keywords" &= explicit &= name "keyword"+ , directive = False &= help "Preprocessing directives" &= explicit &= name "directive"+ , header = False &= help "Headers names" &= explicit &= name "header"+ , number = False &= help "Literal numbers" &= explicit &= name "number"+ , string = False &= help "Literal strings" &= explicit &= name "string"+ , 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_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"+ , invert_match = False &= help "Select non-matching lines" &= explicit &= name "invert-match" &= name "v"+ , show_match = False &= help "Show list of matching tokens" &= explicit &= name "show-match"+ , color = False &= help "Use colors to highlight the matching strings" &= explicit &= name "color"+ , format = Nothing &= typ "STRING" &= help "Format output. Var: #f #n #l #t ## #, #; #0 #1...\ne.g. \"#f:#n #0 #1\"" &= explicit &= name "format" #ifdef ENABLE_HINT- hint = Nothing &= typ "STRING" &= help "Haskell interpreter output. Var: file, row, line, tokens.\ne.g. \"file ++ show (tokens)\"" &= explicit &= name "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"+ , debug = 0 &= help "Debug level: 1, 2 or 3" &= groupname "\nMiscellaneous"+ , no_turbo = False &= help "Disable turbo mode"+ , others = [] &= args } &= summary ("Cgrep " ++ version ++ ". Usage: cgrep [OPTION] [PATTERN] files...") &= program "cgrep"-
src/Config.hs view
@@ -31,17 +31,14 @@ cgreprc = "cgreprc" version :: String-version = "6.4.20"+version = "6.4.21" data Config = Config- {- configLanguages :: [Lang],- configPruneDirs :: [String],- configAutoColor :: Bool-- } deriving (Show, Read)-+ { configLanguages :: [Lang]+ , configPruneDirs :: [String]+ , configAutoColor :: Bool+ } deriving (Show, Read) getConfig :: IO Config@@ -56,5 +53,4 @@ where dropComments :: String -> String dropComments = unlines . map (takeWhile $ not .(== '#')) . lines-
src/Main.hs view
@@ -56,7 +56,7 @@ import qualified Data.ByteString.Char8 as C --- push file names in TChan...+-- push file names in Chan... putRecursiveContents :: Options -> TChan (Maybe FilePath) -> FilePath -> [Lang] -> [String] -> Set.Set FilePath -> IO () putRecursiveContents opts inchan topdir langs prunedir visited = do@@ -98,6 +98,65 @@ getFilePaths _ False _ = [ ] +parallelSearch :: Config -> Options -> [FilePath] -> [C.ByteString] -> [Lang] -> (Bool, Bool) -> IO ()+parallelSearch conf opts paths patterns langs (isTermIn, _) = do++ -- create Transactional Chan and Vars...++ in_chan <- newTChanIO+ out_chan <- newTChanIO++ -- launch worker threads...++ 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+ )+ (\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 ()+++ -- push the files to grep for...++ _ <- forkIO $ do++ if recursive opts || deference_recursive opts+ then+ forM_ (if null paths then ["."] else paths) $ \p -> putRecursiveContents opts in_chan p langs (configPruneDirs conf) (Set.singleton p)+ else+ forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . Just)++ -- enqueue EOF messages:++ replicateM_ (jobs opts) ((atomically . writeTChan in_chan) Nothing)++ -- dump output until workers are done++ putPrettyHeader opts++ let stop = jobs opts++ fix (\action n m ->+ unless (n == stop) $ do+ out <- atomically $ readTChan out_chan+ case out of+ [] -> action (n+1) m+ _ -> do+ case () of+ _ | json opts -> when m $ putStrLn ","+ | otherwise -> return ()+ prettyOutput opts out >>= mapM_ putStrLn+ action n True+ ) 0 False++ putPrettyFooter opts+ main :: IO () main = do @@ -153,70 +212,15 @@ -- language enabled: - let lang_enabled = (if null l0 then configLanguages conf else l0 `union` l1) \\ l2+ 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 lang_enabled+ 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 - -- create Transactional Chan and Vars...-- in_chan <- newTChanIO- out_chan <- newTChanIO-- -- launch worker threads...-- forM_ [1 .. jobs opts] $ \_ -> forkIO $ do- _ <- 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- )- (\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 ()- return ()--- -- push the files to grep for...-- _ <- forkIO $ do-- if recursive opts || deference_recursive opts- then- forM_ (if null paths then ["."] else paths) $ \p -> putRecursiveContents opts in_chan p lang_enabled (configPruneDirs conf) (Set.singleton p)- else- forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . Just)-- -- enqueue EOF messages:-- replicateM_ (jobs opts) ((atomically . writeTChan in_chan) Nothing)-- -- dump output until workers are done-- putPrettyHeader opts-- let stop = jobs opts-- fix (\action n m ->- unless (n == stop) $ do- out <- atomically $ readTChan out_chan- case out of- [] -> action (n+1) m- _ -> do- case () of- _ | json opts -> when m $ putStrLn ","- | otherwise -> return ()- prettyOutput opts out >>= mapM_ putStrLn- action n True- ) 0 False-- putPrettyFooter opts+ parallelSearch conf opts paths patterns' langs (isTermIn, isTermOut)
src/Options.hs view
@@ -23,62 +23,53 @@ import Data.Data data Options = Options- {- -- Pattern:- file :: String,- word_match :: Bool,- prefix_match:: Bool,- suffix_match:: Bool,- edit_dist :: Bool,- ignore_case :: Bool,- regex :: Bool,-- -- Context:- code :: Bool,- comment :: Bool,- literal :: Bool,-- -- Semantic:-- semantic :: Bool,-- -- C/C++ Token:- identifier :: Bool,- keyword :: Bool,- directive :: Bool,- header :: Bool,- number :: Bool,- string :: Bool,- char :: Bool,- oper :: Bool,-- -- Output:- no_filename :: Bool,- no_linenumber :: Bool,- lang :: [String],- lang_maps :: Bool,- force_language :: Maybe String,-- -- General:- jobs :: Int,- multiline :: Int,- recursive :: Bool,- deference_recursive :: Bool,- invert_match :: Bool,- max_count :: Int,- count :: Bool,- show_match :: Bool,- color :: Bool,+ -- Pattern:+ { file :: String+ , word_match :: Bool+ , prefix_match :: Bool+ , suffix_match :: Bool+ , edit_dist :: Bool+ , ignore_case :: Bool+ , regex :: Bool+ -- Context:+ , code :: Bool+ , comment :: Bool+ , literal :: Bool+ -- Semantic:+ , semantic :: Bool+ -- C/C++ Token:+ , identifier :: Bool+ , keyword :: Bool+ , directive :: Bool+ , header :: Bool+ , number :: Bool+ , string :: Bool+ , char :: Bool+ , oper :: Bool+ -- Output:+ , no_filename :: Bool+ , no_linenumber :: Bool+ , lang :: [String]+ , lang_maps :: Bool+ , force_language :: Maybe String+ -- General:+ , jobs :: Int+ , multiline :: Int+ , recursive :: Bool+ , deference_recursive :: Bool+ , invert_match :: Bool+ , max_count :: Int+ , count :: Bool+ , show_match :: Bool+ , color :: Bool #ifdef ENABLE_HINT- hint :: Maybe String,+ , hint :: Maybe String #endif- format :: Maybe String,- json :: Bool,- xml :: Bool,-- debug :: Int,- no_turbo :: Bool,- others :: [String]-- } deriving (Data, Typeable, Show)+ , format :: Maybe String+ , json :: Bool+ , xml :: Bool+ , debug :: Int+ , no_turbo :: Bool+ , others :: [String]+ } deriving (Data, Typeable, Show)
src/Util.hs view
@@ -21,11 +21,10 @@ import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy.Char8 as LC -import Data.Maybe-+import Data.Array.Unboxed -toStrict :: LC.ByteString -> C.ByteString-toStrict = C.concat . LC.toChunks+import Data.Maybe+import Data.Char toMaybe :: a -> Bool -> Maybe a@@ -53,4 +52,25 @@ readMaybe = fmap fst . listToMaybe . reads +spanGroup :: Int -> [a] -> [[a]]+spanGroup _ [] = []+spanGroup 1 xs = map (: []) xs+spanGroup n xs = take n xs : spanGroup n (tail xs)+++toStrict :: LC.ByteString -> C.ByteString+toStrict = C.concat . LC.toChunks++toLowercase :: Char -> Char+toLowercase x = ctypeLowercase ! x+ where ctypeLowercase = listArray ('\0','\255') (map toLower ['\0'..'\255']) :: UArray Char Char+++rmQuote :: String -> String+rmQuote [] = []+rmQuote [x] = [x]+rmQuote y@(x:xs)+ | x == '"' || x == '\'' = if x == last xs then init xs+ else y+ | otherwise = y