cgrep (empty) → 6.4
raw patch · 29 files changed
+3391/−0 lines, 29 filesdep +ansi-terminaldep +arraydep +basesetup-changed
Dependencies added: ansi-terminal, array, base, bytestring, cmdargs, containers, directory, dlist, filepath, ghc-prim, regex-posix, safe, split, stm, stringsearch, unordered-containers
Files
- LICENSE +339/−0
- README.md +72/−0
- Setup.hs +2/−0
- cgrep.cabal +46/−0
- src/CGrep/CGrep.hs +87/−0
- src/CGrep/Common.hs +106/−0
- src/CGrep/Context.hs +30/−0
- src/CGrep/Distance.hs +51/−0
- src/CGrep/Filter.hs +238/−0
- src/CGrep/Lang.hs +122/−0
- src/CGrep/Output.hs +226/−0
- src/CGrep/Semantic/Cpp/Token.hs +372/−0
- src/CGrep/Semantic/Generic/Token.hs +208/−0
- src/CGrep/Semantic/Token.hs +31/−0
- src/CGrep/Semantic/WildCard.hs +164/−0
- src/CGrep/Strategy/BoyerMoore.hs +106/−0
- src/CGrep/Strategy/Cpp/Semantic.hs +147/−0
- src/CGrep/Strategy/Cpp/Tokenizer.hs +102/−0
- src/CGrep/Strategy/Generic/Semantic.hs +138/−0
- src/CGrep/Strategy/Levenshtein.hs +61/−0
- src/CGrep/Strategy/Regex.hs +62/−0
- src/CGrep/Token.hs +135/−0
- src/CGrep/Types.hs +30/−0
- src/CmdOptions.hs +81/−0
- src/Config.hs +58/−0
- src/Debug.hs +31/−0
- src/Main.hs +207/−0
- src/Options.hs +83/−0
- src/Util.hs +56/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ README.md view
@@ -0,0 +1,72 @@+CGrep: a context-aware grep for source codes+============================================++Usage+-----++Cgrep 6.4 Usage: cgrep [OPTION] [PATTERN] files...++cgrep [OPTIONS] [ITEM]++Pattern:++ -f --file=FILE read PATTERNs from file+ -w --word force word matching+ -p --prefix force prefix matching+ -s --suffix force suffix matching+ -e --edit use edit distance+ -i --ignore-case ignore case distinctions+ -G --regex regex matching++Context filters (generic):++ -c --code enable search in source code+ -m --comment enable search in comments+ -l --literal enable search in string literals++Semantic (generic):++ -S --semantic "code" pattern: _, _1, _2... (identifiers), $,+ $1, $2... (optionals), ANY, KEY, STR, CHR, NUM,+ HEX, OCT, OR. -> e.g. "_1(_1 && \$)" search for+ move constructors, "struct OR class _ { OR : OR <"+ search for a class declaration++C/C++ language:++ --identifier identifiers+ --keyword keywords+ --directive preprocessing directives+ --header headers names+ --number literal numbers+ --string literal strings+ --char literal chars+ --oper operators+ +Output control:++ -h --no-filename suppress the file name prefix on output+ -N --no-line-umber suppress the line number on output lines+ --lang=ITEM specify languages. ie: Cpp, +Haskell, -Makefile+ --lang-maps lists the language mappings+ --force-language=ITEM force the language+ -j --jobs=INT number of jobs+ --multiline=INT enable multi-line matching+ -r --recursive enable recursive search+ -v --invert-match select non-matching lines+ --max-count=INT stop search in files after INT matches+ --count print only a count of matching lines per file+ --show-match show list of matching tokens+ --color use colors to highlight the matching strings+ --format=STRING format output. Var: #f #n #l #t ## #, #; #0 #1...+ e.g. "#f:#n #0 #1"+ --json format output as json object+ --xml format output as xml document+ +Miscellaneous:++ -d --debug=INT debug level: 1, 2 or 3+ -n --no-turbo disable turbo mode+ -? --help Display help message+ -V --version Print version information+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cgrep.cabal view
@@ -0,0 +1,46 @@+Name: cgrep+Description: Cgrep: a context-aware grep for source codes+Version: 6.4+Synopsis: Command line tool+Homepage: http://awgn.github.io/cgrep/+License: GPL-2+License-file: LICENSE+Author: Nicola Bonelli+Maintainer: Nicola Bonelli <nicola@pfq.io>+Category: Utils+Build-type: Simple+Stability: Experimental+Build-type: Simple+Extra-source-files: README.md+Cabal-version: >=1.10++Executable cgrep+ Main-Is: Main.hs+ Hs-Source-Dirs: src+ Default-Extensions: CPP+ + Other-Extensions: DeriveDataTypeable, + ViewPatterns, + MagicHash, + BangPatterns, + FlexibleInstances, + FlexibleContexts+ other-modules: Debug Options CmdOptions Util Config CGrep.Lang CGrep.Filter CGrep.Token CGrep.Types CGrep.CGrep CGrep.Output CGrep.Distance CGrep.Common CGrep.Context CGrep.Semantic.WildCard CGrep.Semantic.Generic.Token CGrep.Semantic.Token CGrep.Semantic.Cpp.Token CGrep.Strategy.Generic.Semantic CGrep.Strategy.Levenshtein CGrep.Strategy.BoyerMoore CGrep.Strategy.Cpp.Tokenizer CGrep.Strategy.Cpp.Semantic CGrep.Strategy.Regex+ Build-Depends: base >=4.6 && < 4.7, + cmdargs >=0.10, + bytestring >=0.10, + directory >=1.2, + filepath >=1.3, + stm >=2.1, + containers >=0.5, + array >=0.4, + ghc-prim >=0.3, + dlist >=0.3, + ansi-terminal >=0.5, + split >=0.2, + safe >=0.3, + stringsearch >=0.3, + unordered-containers >=0.1, + regex-posix >=0.90+ Ghc-options: -O2 -Wall -threaded + Default-language: Haskell2010
+ src/CGrep/CGrep.hs view
@@ -0,0 +1,87 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.CGrep (sanitizeOptions, cgrepDispatch) where++import qualified CGrep.Strategy.BoyerMoore as BoyerMoore+import qualified CGrep.Strategy.Levenshtein as Levenshtein+import qualified CGrep.Strategy.Regex as Regex+import qualified CGrep.Strategy.Cpp.Tokenizer as CppTokenizer+import qualified CGrep.Strategy.Cpp.Semantic as CppSemantic+import qualified CGrep.Strategy.Generic.Semantic as Semantic++import CGrep.Lang+import CGrep.Common++import Data.List+import Data.Maybe+import Options+++hasLanguage :: FilePath -> Options -> [Lang] -> Bool+hasLanguage path opt xs = isJust $ getLang opt path >>= (`elemIndex` xs)+++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+++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+++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++
+ src/CGrep/Common.hs view
@@ -0,0 +1,106 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- 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,+ unquotes) 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+++type CgrepFunction = Options -> [Text8] -> Maybe FilePath -> IO [Output]+++getFileName :: Maybe FilePath -> String+getFileName Nothing = "<STDIN>"+getFileName (Just name) = name+++getText :: Maybe FilePath -> IO Text8+getText = maybe C.getContents C.readFile+++quickSearch :: Options -> [Text8] -> Text8 -> Maybe Bool+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+++expandMultiline :: Options -> Text8 -> Text8+expandMultiline Options { multiline = n } xs+ | n == 1 = xs+ | 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)+++dropSpaceTail :: String -> String -> String+dropSpaceTail _ "" = ""+dropSpaceTail maybeStuff (x:xs)+ | isSpace x = dropSpaceTail (x:maybeStuff) xs+ | null maybeStuff = x : dropSpaceTail "" xs+ | otherwise = reverse maybeStuff ++ x : dropSpaceTail "" xs+++trim :: String -> String+trim xs = dropSpaceTail "" $ dropWhile isSpace xs+++unquotes :: String -> String+unquotes [] = []+unquotes (x:[]) = [x]+unquotes y@(x:xs)+ | x == '"' || x == '\'' = if x == last xs then init xs+ else y+ | otherwise = y+++
+ src/CGrep/Context.hs view
@@ -0,0 +1,30 @@+--+-- Copyright (c) 2012-2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Context where+++data Context = Code | Comment | Literal+ deriving (Eq, Show)+++data ContextFilter = ContextFilter { getCode :: Bool,+ getComment :: Bool,+ getLiteral :: Bool+ } deriving (Eq, Show)+
+ src/CGrep/Distance.hs view
@@ -0,0 +1,51 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--+++module CGrep.Distance (distance, (~==)) where++-- from http://www.haskell.org/haskellwiki/Edit_distance+--++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))+ 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+ where nextDiag = head (tail diags)+ oneDiag a' b' diagAbove diagBelow = thisdiag+ where doDiag [] _ _ _ _ = []+ doDiag _ [] _ _ _ = []+ 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+ thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow)+ lab = length a - length b+ min3 x y z = if x < y then x else min y z+++(~==) :: String -> String -> Bool+a ~== b | len < 5 = dist < 3+ | otherwise = dist < (len * 40 `div` 100)+ where len = fromIntegral (length a `min` length b)+ dist = distance a b
+ src/CGrep/Filter.hs view
@@ -0,0 +1,238 @@+--+-- Copyright (c) 2012-2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE ViewPatterns, MagicHash, BangPatterns #-}++module CGrep.Filter (Context(..), ContextFilter(..), contextFilter, mkContextFilter) where++import CGrep.Common (Text8)++import CGrep.Context+import CGrep.Lang+import Options++import Data.Char+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+++type FilterFunction = ContextFilter -> Text8 -> Text8+++type StringBoundary = (String, String)+++data Boundary = Boundary+ {+ _beg :: !Text8 ,+ _end :: !Text8+ }+ deriving (Show)+++data ParConf = ParConf+ {+ commBound :: [Boundary],+ litrBound :: [Boundary],+ bloom :: UArray Char Bool+ }++data ParState = ParState+ {+ cxtState :: !ContextState,+ display :: !Bool,+ skip :: !Int+ }+ deriving (Show)+++data ContextState = CodeState | CommState Int | LitrState Int+ 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 }+++contextFilter :: Maybe Lang -> ContextFilter -> Text8 -> Text8++contextFilter _ (ContextFilter True True True) txt = txt+contextFilter Nothing _ txt = txt+contextFilter (Just language) filt txt+ | Just fun <- parFunc = fun filt txt+ | otherwise = txt+ where parFunc = Map.lookup language filterFunctionMap+++-- contextFilterFun:+--+++contextFilterFun :: ParConf -> ContextFilter -> Text8 -> Text8+contextFilterFun conf filt txt = fst $ C.unfoldrN (C.length txt) (contextFilterImpl conf) (txt, filt, ParState CodeState False 0)+++type ParData = (Text8, ContextFilter, ParState)+++contextFilterImpl :: ParConf -> ParData -> Maybe (Char, ParData)+contextFilterImpl _ (C.uncons -> Nothing, _, _) = Nothing+contextFilterImpl c (C.uncons -> Just (x,xs), f, s) = Just (c', (xs, f, s'))+ where !s' = nextContextState c s (x,xs) f+ !c' = if display s' || isSpace x then x else ' '+contextFilterImpl _ _ = undefined+++{-# INLINE displayContext #-}++displayContext :: ContextState -> ContextFilter -> Bool+displayContext CodeState (ContextFilter b _ _ ) = b+displayContext (CommState _) (ContextFilter _ b _ ) = b+displayContext (LitrState _) (ContextFilter _ _ b ) = b+++nextContextState :: ParConf -> ParState -> (Char,Text8) -> ContextFilter -> ParState+nextContextState c s (x,xs) filt@(ContextFilter codefilt commfilt litrfilt)+ | skip s > 0 = s { skip = skip s - 1 }+ | x == '\'' && C.pack "\"'" `C.isPrefixOf` xs = s { skip = 2 }+ | x == '\\' = s { display = displayContext (cxtState s) filt, skip = 1 }++ | CodeState <- cxtState s = let cindex = findBoundary (x,xs) (commBound c)+ lindex = findBoundary (x,xs) (litrBound c)+ in if bloom c ! x+ then++ if cindex >= 0+ then s{ cxtState = CommState cindex, display = codefilt, skip = C.length ( _beg (commBound c !! cindex) ) - 1 }+ else if lindex >= 0+ then s{ cxtState = LitrState lindex, display = codefilt, skip = C.length ( _beg (litrBound c !! lindex) ) - 1 }+ else s{ display = codefilt, skip = 0 }++ else s{ display = codefilt, skip = 0 }++ | CommState n <- cxtState s = let Boundary _ e = commBound c !! n+ in if C.head e == x && C.tail e `C.isPrefixOf` xs+ then s{ cxtState = CodeState, display = codefilt, skip = C.length e - 1}+ else s{ display = commfilt, skip = 0 }++ | LitrState n <- cxtState s = let Boundary _ e = litrBound c !! n+ in if C.head e == x && C.tail e `C.isPrefixOf` xs+ then s{ cxtState = CodeState, display = codefilt, skip = C.length e - 1}+ else s{ display = litrfilt, skip = 0 }++nextContextState _ _ (_,_) ContextFilter {} = undefined+++{-# INLINE findBoundary #-}++findBoundary :: (Char, Text8) -> [Boundary] -> Int+findBoundary (x,xs) = findIndex' (\(Boundary b _ ) -> C.head b == x && C.tail b `C.isPrefixOf` xs)+++{-# INLINE findIndex' #-}++#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++#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++#endif++-- filter language map:+--++filterFunctionMap :: Map.Map Lang FilterFunction+++mkFilterFunction :: [StringBoundary] -> [StringBoundary] -> FilterFunction+mkFilterFunction cs ls = contextFilterFun (ParConf (map (\(a,b) -> Boundary (C.pack a) (C.pack b)) cs)+ (map (\(a,b) -> Boundary (C.pack a) (C.pack b)) ls)+ (mkBloom (cs ++ ls)))+++mkBloom :: [StringBoundary] -> UArray Char Bool+mkBloom bs = listArray ('\0', '\255') (map (\c -> findIndex' (\(b,_) -> c == head b) bs >= 0 ) ['\0'..'\255'])+++filterFunctionMap = Map.fromList [+ (C, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Cpp, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Csharp, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Chapel, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (D, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Go, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Java, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Javascript, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (ObjectiveC, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Scala, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (Verilog, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] ),+ (VHDL, mkFilterFunction [("--", "\n")] [("\"", "\"")] ),++ (Haskell, mkFilterFunction [("{-", "-}"), ("--", "\n")] [("\"", "\""), ("[r|", "|]"), ("[q|", "|]"), ("[s|", "|]"), ("[here|","|]"), ("[i|", "|]")] ),+ (Fsharp, mkFilterFunction [("(*", "*)"), ("//", "\n")] [("\"", "\"")] ),+ (Perl, mkFilterFunction [("=pod", "=cut"), ("#", "\n")] [("'", "'"), ("\"", "\"")] ),+ (Ruby, mkFilterFunction [("=begin", "=end"), ("#", "\n")] [("'", "'"), ("\"", "\""), ("%|", "|"), ("%q(", ")"), ("%Q(", ")") ]),++ (CMake, mkFilterFunction [("#", "\n")] [("\"", "\"")] ),+ (Awk, mkFilterFunction [("#", "\n")] [("\"", "\"")] ),+ (Tcl, mkFilterFunction [("#", "\n")] [("\"", "\"")] ),+ (Shell, mkFilterFunction [("#", "\n")] [("'", "'"), ("\"", "\"")] ),+ (Make, mkFilterFunction [("#", "\n")] [("'", "'"), ("\"", "\"")] ),++ (Css, mkFilterFunction [("/*", "*/")] [("\"", "\"")] ),+ (OCaml, mkFilterFunction [("(*", "*)")] [("\"", "\"")] ),+ (Python, mkFilterFunction [("#", "\n")] [("\"\"\"", "\"\"\""), ("'''", "'''"), ("'", "'"), ("\"", "\"")] ),++ (Erlang, mkFilterFunction [("%", "\n")] [("\"", "\"")] ),+ (Latex, mkFilterFunction [("%", "\n")] [("\"", "\"")] ),+ (Lua, mkFilterFunction [("--[[","--]]"), ("--", "\n")] [("'", "'"), ("\"", "\""), ("[===[", "]===]"), ("[==[", "]==]"), ("[=[", "]=]"), ("[[", "]]") ] ),++ (Html, mkFilterFunction [("<!--", "-->")] [("\"", "\"")] ),+ (Vim, mkFilterFunction [("\"", "\n")] [("'", "'")] ),++ (PHP, mkFilterFunction [("/*", "*/"), ("//", "\n"), ("#", "\n") ] [("'", "'"), ("\"", "\"")] )+ ]+
+ src/CGrep/Lang.hs view
@@ -0,0 +1,122 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Lang (Lang(..), langMap, getLang, splitLangList,+ dumpLangMap, dumpLangRevMap) where++import qualified Data.Map as Map+import System.FilePath(takeExtension, takeFileName)+import Control.Monad+import Control.Applicative+import Data.Maybe++import Options+import Util++data Lang = Awk | C | Cpp | Csharp | Chapel | 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)+++data FileType = Name String | Ext String+ deriving (Eq, Ord)++instance Show FileType where+ show (Name x) = x+ show (Ext e) = "*." ++ e+++type LangMapType = Map.Map Lang [FileType]+type LangRevMapType = Map.Map FileType Lang+++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"]),+ (Csharp, [Ext "cs", Ext "CS"]),+ (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+langRevMap = Map.fromList $ concatMap (\(l, xs) -> map (\x -> (x,l)) xs ) $ Map.toList langMap++-- utility functions++lookupLang :: FilePath -> Maybe Lang+lookupLang f = Map.lookup (Name $ takeFileName f) langRevMap <|> Map.lookup (Ext (let name = takeExtension f in case name of ('.':xs) -> xs; _ -> name )) langRevMap+++forcedLang :: Options -> Maybe Lang+forcedLang Options{ force_language = l }+ | Nothing <- l = Nothing+ | otherwise = Map.lookup (Ext $ fromJust l) langRevMap <|> Map.lookup (Name $ fromJust l) langRevMap+++getLang :: Options -> FilePath -> Maybe Lang+getLang opts f = forcedLang opts <|> lookupLang f++++dumpLangMap :: LangMapType -> IO ()+dumpLangMap m = forM_ (Map.toList m) $ \(l, ex) ->+ putStrLn $ show l ++ [ ' ' | _ <- [length (show l)..12]] ++ "-> " ++ show ex+++dumpLangRevMap :: LangRevMapType -> IO ()+dumpLangRevMap m = forM_ (Map.toList m) $ \(ext, l) ->+ putStrLn $ show ext ++ [ ' ' | _ <- [length (show ext)..12 ]] ++ "-> " ++ show l+++splitLangList :: [String] -> ([Lang], [Lang], [Lang])+splitLangList = foldl run ([],[],[])+ where run :: ([Lang], [Lang], [Lang]) -> String -> ([Lang], [Lang], [Lang])+ run (l1, l2, l3) l+ | '+':xs <- l = (l1, prettyRead xs "Lang" : l2, l3)+ | '-':xs <- l = (l1, l2, prettyRead xs "Lang" : l3)+ | otherwise = (prettyRead l "Lang" : l1, l2, l3)+
+ src/CGrep/Output.hs view
@@ -0,0 +1,226 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--+++module CGrep.Output (Output(..),+ mkOutput,+ putPrettyHeader,+ putPrettyFooter,+ prettyOutput,+ showFile) where++import qualified Data.ByteString.Char8 as C++import System.Console.ANSI++#ifdef ENABLE_HINT+import Language.Haskell.Interpreter+#endif++import Data.Maybe+import Data.List+import Data.List.Split+import Data.Function++import CGrep.Types+import CGrep.Token++import Safe+import Options+++data Output = Output FilePath Int Text8 [Token]+ deriving (Show)+++getOffsetsLines :: Text8 -> [Int]+getOffsetsLines = C.elemIndices '\n'+++getOffset2d :: [OffsetLine] -> Offset -> Offset2d+getOffset2d idx off = let prc = fst $ partition (< off) idx in+ case prc of+ [] -> (0, off)+ _ -> (length prc, off - last prc - 1)+++mkOutput :: Options -> FilePath -> Text8 -> [Token] -> [Output]+mkOutput Options { invert_match = invert } f text ts+ | invert = map (\(n, xs) -> Output f n (ls !! (n-1)) xs) . invertMatchLines (length ls) $ mkMatchLines text ts+ | otherwise = map (\(n, xs) -> Output f n (ls !! (n-1)) xs) $ mkMatchLines text ts+ where ls = C.lines text+++mkMatchLines :: Text8 -> [Token] -> [MatchLine]+mkMatchLines _ [] = []+mkMatchLines text ts = map mergeGroup $ groupBy ((==) `on` fst) $+ sortBy (compare `on` fst) $ map (\t -> let (r,c) = getOffset2d ols (fst t) in (1 + r, [(c, snd t)])) ts+ where mergeGroup ls = (fst $ head ls, foldl (\l m -> l ++ snd m) [] ls)+ ols = getOffsetsLines text+++invertMatchLines :: Int -> [MatchLine] -> [MatchLine]+invertMatchLines n xs = filter (\(i,_) -> i `notElem` idx ) $ take n [ (i, []) | i <- [1..]]+ where idx = map fst xs+++putPrettyHeader :: Options -> IO ()+putPrettyHeader opt =+ case () of+ _ | json opt -> putStrLn "["+ | xml opt -> putStrLn "<?xml version=\"1.0\"?>" >> putStrLn "<cgrep>"+ | otherwise -> return ()+++putPrettyFooter :: Options -> IO ()+putPrettyFooter opt =+ case () of+ _ | json opt -> putStrLn "]"+ | xml opt -> putStrLn "</cgrep>"+ | otherwise -> return ()+++prettyOutput :: Options -> [Output] -> IO [String]+prettyOutput opt out+#ifdef ENABLE_HINT+ | isJust $ hint opt = hintOputput opt out+#endif+ | isJust $ format opt = return $ map (formatOutput opt) out+ | json opt = return $ jsonOutput opt out+ | xml opt = return $ xmlOutput opt out+ | otherwise = return $ map (defaultOutput opt) out+++defaultOutput :: Options -> Output -> String+defaultOutput opt@ Options { no_filename = False, no_linenumber = False , count = False } (Output f n l ts) =+ showFile opt f ++ ":" ++ show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l+defaultOutput opt@ Options { no_filename = False, no_linenumber = True , count = False } (Output f _ l ts) =+ showFile opt f ++ ":" ++ showTokens opt ts ++ showLine opt ts l+defaultOutput opt@ Options { no_filename = True , no_linenumber = False , count = False } (Output _ n l ts) =+ show n ++ ":" ++ showTokens opt ts ++ showLine opt ts l+defaultOutput opt@ Options { no_filename = True , no_linenumber = True , count = False } (Output _ _ l ts) =+ showTokens opt ts ++ showLine opt ts l+defaultOutput opt@ Options { count = True } (Output f n _ _) =+ showFile opt f ++ ":" ++ show n+++jsonOutput :: Options -> [Output] -> [String]+jsonOutput _ outs =+ [" { \"file\": " ++ show fname ++ ", \"matches\": ["] +++ [ intercalate "," (foldl mkMatch [] outs) ] +++ ["] }"]+ where fname | (Output f _ _ _) <- head outs = f+ mkToken (n, xs) = "{ \"col\": " ++ show n ++ ", \"token\": " ++ show xs ++ " }"+ mkMatch xs (Output _ n l ts) = xs ++ [ "{ \"row\": " ++ show n ++ ", \"tokens\": [" ++ intercalate "," (map mkToken ts) ++ "], \"line\":" ++ show l ++ "}" ]+++xmlOutput :: Options -> [Output] -> [String]+xmlOutput _ outs =+ ["<file name=" ++ show fname ++ ">" ] +++ ["<matches>" ] +++ [foldl mkMatch "" outs] +++ ["</matches>"] +++ ["</file>"]+ where fname | (Output f _ _ _) <- head outs = f+ mkToken (n, xs) = "<token col=\"" ++ show n ++ "\" >" ++ xs ++ "</token>"+ mkMatch xs (Output _ n l ts) = xs ++ "<match line=" ++ show l ++ " row=\"" ++ show n ++ "\">" +++ unwords (map mkToken ts) +++ "</match>"+++formatOutput :: Options -> Output -> String+formatOutput opt (Output f n l ts) =+ foldl trans (fromJust $ format opt)+ [+ ("#f", showFile opt f),+ ("#n", show n),+ ("#l", showLine opt ts l),+ ("#t", show ts'),+ ("##", unwords ts'),+ ("#,", intercalate "," ts'),+ ("#;", intercalate ";" ts'),+ ("#0", atDef "" ts' 0),+ ("#1", atDef "" ts' 1),+ ("#2", atDef "" ts' 2),+ ("#3", atDef "" ts' 3),+ ("#4", atDef "" ts' 4),+ ("#5", atDef "" ts' 5),+ ("#6", atDef "" ts' 6),+ ("#7", atDef "" ts' 7),+ ("#8", atDef "" ts' 8),+ ("#9", atDef "" ts' 9)+ ]+ where trans str (old, new) = replace old new str+ ts' = map snd ts+++replace :: Eq a => [a] -> [a] -> [a] -> [a]+replace old new = intercalate new . splitOn old+++#ifdef ENABLE_HINT+hintOputput :: Options -> [Output] -> IO [String]+hintOputput opt outs = do+ let cmds = map mkCmd outs+ out <- runInterpreter $ setImports ["Prelude", "Data.List"] >> mapM (`interpret` (as :: String)) cmds+ return $ either ((:[]) . show) id out+ where mkCmd (Output f n l ts) = "let a # b = a !! b " +++ "; file = " ++ show (showFile opt f) +++ "; row = " ++ show n +++ "; line = " ++ show (showLine opt ts l) +++ "; tokens = " ++ show (map snd ts) ++ " in " +++ (fromJust $ hint opt)+#endif++blue, bold, resetTerm :: String++blue = setSGRCode [SetColor Foreground Vivid Blue]+bold = setSGRCode [SetConsoleIntensity BoldIntensity]+resetTerm = setSGRCode []+++showTokens :: Options -> [Token] -> String+showTokens Options { show_match = st } xs+ | st = show (map snd xs)+ | otherwise = ""+++showFile :: Options -> String -> String+showFile Options { color = c } f+ | c = bold ++ blue ++ f ++ resetTerm+ | otherwise = f+++showLine :: Options -> [Token] -> Line8 -> String+showLine Options { color = c } ts l+ | c = hilightLine (sortBy (flip compare `on` (length . snd )) ts) (C.unpack l)+ | otherwise = C.unpack l+++hilightLine :: [Token] -> String -> String+hilightLine ts = hilightLine' (hilightIndicies ts, 0)+ where hilightLine' :: ([Int],Int) -> String -> String+ hilightLine' _ [] = []+ hilightLine' (ns,n) (x:xs) = (if n `elem` ns then bold ++ [x] ++ resetTerm+ else [x]) ++ hilightLine' (ns, n+1) xs+++hilightIndicies :: [Token] -> [Int]+hilightIndicies = concatMap (\(o, s) -> take (length s) [o..])++
+ src/CGrep/Semantic/Cpp/Token.hs view
@@ -0,0 +1,372 @@+--+-- Copyright (c) 2012-2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE ViewPatterns #-}++module CGrep.Semantic.Cpp.Token(Token(..), TokenFilter(..),+ Offset, tokenizer, tokenFilter, tokenCompare,+ isIdentifier, isKeyword, isDirective, isLiteralNumber,+ isHeaderName, isString, isChar, isOperOrPunct+ ) where++import Data.Char+import Data.Maybe+import Control.Monad+import Data.Array.Unboxed++import qualified Data.HashSet as HS+import qualified Data.HashMap.Strict as HM+import qualified Data.ByteString.Char8 as C+++type TokenizerState = (Source, Offset, CppState)++type Source = C.ByteString++type Offset = Int+++data Token = TokenIdentifier { toString :: String, offset :: Int } |+ TokenDirective { toString :: String, offset :: Int } |+ TokenKeyword { toString :: String, offset :: Int } |+ TokenNumber { toString :: String, offset :: Int } |+ TokenHeaderName { toString :: String, offset :: Int } |+ TokenString { toString :: String, offset :: Int } |+ TokenChar { toString :: String, offset :: Int } |+ TokenOperOrPunct { toString :: String, offset :: 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)++-- Tokenize the source code in a list of Token+-- Precondition: the C++ source code must be well-formed+--++tokenizer :: Source -> [Token]+tokenizer xs = runGetToken (ys, n, Null)+ where (ys, n) = dropWhite xs+++tokenFilter :: TokenFilter -> Token -> Bool+tokenFilter filt (TokenIdentifier{}) = filtIdentifier filt+tokenFilter filt (TokenDirective{}) = filtDirective filt+tokenFilter filt (TokenKeyword{}) = filtKeyword filt+tokenFilter filt (TokenHeaderName{}) = filtHeader filt+tokenFilter filt (TokenNumber{}) = filtNumber filt+tokenFilter filt (TokenString{}) = filtString filt+tokenFilter filt (TokenChar{}) = filtChar filt+tokenFilter filt (TokenOperOrPunct{}) = filtOper filt+++tokenCompare :: Token -> Token -> Bool+tokenCompare (TokenIdentifier { toString = l }) (TokenIdentifier { toString = r }) = l == r+tokenCompare (TokenDirective { toString = l }) (TokenDirective { toString = r }) = l == r+tokenCompare (TokenKeyword { toString = l }) (TokenKeyword { toString = r }) = l == r+tokenCompare (TokenNumber { toString = l }) (TokenNumber { toString = r }) = l == r+tokenCompare (TokenHeaderName { toString = l }) (TokenHeaderName { toString = r }) = l == r+tokenCompare (TokenString { toString = l }) (TokenString { toString = r }) = l == r+tokenCompare (TokenChar { toString = l }) (TokenChar { toString = r }) = l == r+tokenCompare (TokenOperOrPunct{ toString = l }) (TokenOperOrPunct{ toString = r }) = l == r+tokenCompare _ _ = False+++isIdentifier :: Token -> Bool+isIdentifier (TokenIdentifier {}) = True+isIdentifier _ = False+++isKeyword :: Token -> Bool+isKeyword (TokenKeyword {}) = True+isKeyword _ = False+++isDirective :: Token -> Bool+isDirective (TokenDirective {}) = True+isDirective _ = False+++isLiteralNumber :: Token -> Bool+isLiteralNumber (TokenNumber {}) = True+isLiteralNumber _ = False+++isHeaderName :: Token -> Bool+isHeaderName (TokenHeaderName {}) = True+isHeaderName _ = False+++isString :: Token -> Bool+isString (TokenString {}) = True+isString _ = False+++isChar :: Token -> Bool+isChar (TokenChar {}) = True+isChar _ = False+++isOperOrPunct :: Token -> Bool+isOperOrPunct (TokenOperOrPunct {}) = True+isOperOrPunct _ = False+++isIdentifierChar' :: Char -> Bool+isIdentifierChar' = ((listArray ('\0', '\255') (map (\c -> isAlphaNum c || c == '_' || c == '$') ['\0'..'\255']) :: UArray Char Bool) !) -- GNU allows $ in identifier+++isChar' :: Char -> Bool+isChar'= ((listArray ('\0', '\255') (map (\c -> isSpace c || c == '\\') ['\0'..'\255']) :: UArray Char Bool) !)++-- Drop leading whitespace and count them+--++{-# INLINE dropWhite #-}++dropWhite :: Source -> (Source, Offset)+dropWhite xs = (xs', doff)+ where xs' = C.dropWhile isChar' xs+ doff = fromIntegral $ C.length xs - C.length xs'+++data CppState = Null | Hash | Include | Define | Undef | If | Ifdef | Ifndef | Elif | Else | Endif |+ Line | Error | Pragma+ deriving (Show, Eq)+++directiveKeys :: HM.HashMap String CppState+directiveKeys = HM.fromList [ ("#", Hash),+ ("include", Include),+ ("include_next", Include),+ ("define", Define),+ ("undef", Undef),+ ("if", If),+ ("ifdef", Ifdef),+ ("ifndef", Ifndef),+ ("elif", Elif),+ ("else", Else),+ ("endif", Null),+ ("line", Line),+ ("error", Error),+ ("pragma", Pragma) ]+++nextCppState :: String -> CppState -> CppState+nextCppState str pps+ | Hash <- pps = fromMaybe Null (HM.lookup str directiveKeys)+ | otherwise = if str == "#" then Hash else Null+++runGetToken :: TokenizerState -> [Token]++runGetToken (C.uncons -> Nothing, _, _) = []+runGetToken tstate = token : runGetToken ns+ where (token, ns) = getToken tstate+++getToken :: TokenizerState -> (Token, TokenizerState)++getToken (C.uncons -> Nothing, _, _) = error "getToken: internal error"+getToken (xs, off, state) =+ let token = fromJust $+ getTokenDirective xs state `mplus`+ getTokenHeaderName xs state `mplus`+ getTokenIdOrKeyword xs state `mplus`+ getTokenNumber xs state `mplus`+ getTokenString xs state `mplus`+ getTokenChar xs state `mplus`+ getTokenOpOrPunct xs state+ tstring = toString token+ len = fromIntegral $ length tstring+ (xs', w) = dropWhite $ C.drop (fromIntegral len) xs+ in+ (token { offset = off }, (xs', off + len + w, nextCppState tstring state))+++getTokenIdOrKeyword, getTokenNumber,+ getTokenHeaderName, getTokenString,+ getTokenChar, getTokenOpOrPunct,+ getTokenDirective :: Source -> CppState -> Maybe Token+++getTokenDirective xs state+ | state == Hash = Just (TokenDirective name 0)+ | otherwise = Nothing+ where name = C.unpack $ C.takeWhile isIdentifierChar' xs+++getTokenHeaderName (C.uncons -> Nothing) _ = error "getTokenHeaderName: internal error"+getTokenHeaderName xs@(C.uncons -> Just (x,_)) state+ | state /= Include = Nothing+ | x == '<' = Just $ TokenHeaderName (getLiteral '<' '>' False xs) 0+ | x == '"' = Just $ TokenHeaderName (getLiteral '"' '"' False xs) 0+ | otherwise = Just $ TokenHeaderName (C.unpack $ C.takeWhile isIdentifierChar' xs) 0++getTokenHeaderName _ _ = undefined+++getTokenNumber ys@(C.uncons -> Just (x,_)) _+ | x == '.' || isDigit x = let ts = getNumber ys NumberNothing in+ case ts of+ "" -> Nothing+ "." -> Nothing+ _ -> Just $ TokenNumber ts 0+ | otherwise = Nothing+getTokenNumber (C.uncons -> Nothing) _ = Nothing+getTokenNumber _ _ = undefined+++validHexSet, validOctSet, validDecSet, validFloatSet :: HS.HashSet Char++validHexSet = HS.fromList "0123456789abcdefABCDEFxXuUlL"+validOctSet = HS.fromList "01234567uUlL"+validDecSet = HS.fromList "0123456789uUlL"+validFloatSet = HS.fromList "0123456789"++data NumberState = NumberNothing | NumberOHF | NumberDec | NumberOct | NumberHex | NumberMayBeFloat | NumberFloat | NumberExp+ deriving (Show,Eq,Enum)++getNumber :: C.ByteString -> NumberState -> String+-- getNumber xs s | trace ("state = " ++ show s) False = undefined++getNumber (C.uncons -> Nothing) _ = ""+getNumber (C.uncons -> Just (x,xs)) state+ | state == NumberNothing = case () of _+ | x == '0' -> x : getNumber xs NumberOHF+ | x == '.' -> x : getNumber xs NumberMayBeFloat+ | isDigit x -> x : getNumber xs NumberDec+ | otherwise -> ""+ | state == NumberOHF = case () of _+ | x `HS.member` validHexSet -> x : getNumber xs NumberHex+ | x == '.' -> x : getNumber xs NumberMayBeFloat+ | isDigit x -> x : getNumber xs NumberOct+ | otherwise -> ""++ | state == NumberDec = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberDec+ | x == '.' -> x : getNumber xs NumberMayBeFloat+ | x == 'e' || x == 'E' -> x : getNumber xs NumberExp+ | otherwise -> ""++ | state == NumberOct = case () of _+ | x `HS.member` validOctSet -> x : getNumber xs NumberOct+ | otherwise -> ""++ | state == NumberHex = case () of _+ | x `HS.member` validHexSet -> x : getNumber xs NumberHex+ | otherwise -> ""++ | state == NumberMayBeFloat = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberFloat+ | otherwise -> ""++ | state == NumberFloat = case () of _+ | x `HS.member` validFloatSet -> x : getNumber xs NumberFloat+ | x == 'e' || x == 'E' -> x : getNumber xs NumberExp+ | otherwise -> ""++ | state == NumberExp = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberExp+ | x == '+' || x == '-' -> x : getNumber xs NumberExp+ | otherwise -> ""++getNumber _ _ = undefined+++getTokenString xs@(C.uncons -> Just (x,_)) _+ | x == '"' = Just $ TokenString (getLiteral '"' '"' False xs) 0+ | otherwise = Nothing+getTokenString (C.uncons -> Nothing) _ = Nothing+getTokenString _ _ = Nothing+++getTokenChar xs@(C.uncons -> Just (x,_)) _+ | x == '\'' = Just $ TokenChar (getLiteral '\'' '\'' False xs) 0+ | otherwise = Nothing+getTokenChar (C.uncons -> Nothing) _ = Nothing+getTokenChar _ _ = Nothing+++getTokenIdOrKeyword xs@(C.uncons -> Just (x,_)) _+ | not $ isIdentifierChar' x = Nothing+ | name `HS.member` keywords = Just $ TokenKeyword name 0+ | otherwise = Just $ TokenIdentifier name 0+ where name = C.unpack $ C.takeWhile isIdentifierChar' xs+getTokenIdOrKeyword (C.uncons -> Nothing) _ = Nothing+getTokenIdOrKeyword _ _ = Nothing+++getTokenOpOrPunct source _ = go source (min 4 (C.length source))+ where go _ 0+ | C.length source > 0 = error $ "operator or punct: error " ++ show source+ | otherwise = Nothing+ go src len+ | sub `HS.member` operOrPunct = Just $ TokenOperOrPunct sub 0+ | otherwise = go src (len-1)+ where sub = C.unpack (C.take len src)+++getLiteral :: Char -> Char -> Bool -> C.ByteString -> String+getLiteral _ _ _ (C.uncons -> Nothing) = []+getLiteral b e False ys@(C.uncons -> Just (x,xs))+ | x == b = b : getLiteral b e True xs+ | otherwise = error $ "literal: error " ++ C.unpack ys+getLiteral b e True (C.uncons -> Just (x,xs))+ | x == e = [e]+ | x == '\\' = '\\' : x' : getLiteral b e True xs'+ | otherwise = x : getLiteral b e True xs+ where+ (C.uncons -> Just(x',xs')) = xs+getLiteral _ _ _ _ = []++++operOrPunct :: HS.HashSet String+operOrPunct = HS.fromList [ "{","}","[","]","#","(",")",";",":","?",".","+","-","*",+ "/","%","^","&","|","~","!","=","<",">","," ,+ "##", "<:", ":>", "<%", "%>", "%:", "::", ".*", "+=", "-=",+ "*=", "/=", "%=", "^=", "&=", "|=", "<<", ">>", ">=", "<=",+ "&&", "||", "==", "!=", "++", "--", "->", "//", "/*", "*/",+ "...", "<<=", ">>=", "->*",+ "%:%:" ]++keywords :: HS.HashSet String+keywords = HS.fromList ["alignas", "continue", "friend", "alignof", "decltype", "goto", "asm",+ "default", "if", "auto", "delete", "inline", "bool", "do", "int", "break",+ "double", "long", "case", "dynamic_cast", "mutable", "catch", "else",+ "namespace", "char", "enum", "new", "char16_t", "explicit", "noexcept",+ "char32_t", "export", "nullptr", "class", "extern", "operator", "const",+ "false", "private", "constexpr", "float", "protected", "const_cast", "for",+ "public", "register", "true", "reinterpret_cast", "try", "return", "typedef",+ "short", "typeid", "signed", "typename", "sizeof", "union", "static", "unsigned",+ "static_assert", "using", "static_cast", "virtual", "struct", "void", "switch",+ "volatile", "template", "wchar_t", "this", "while", "thread_local", "throw",+ "and", "and_eq", "bitand", "bitor", "compl", "not", "not_eq", "or", "or_eq",+ "xor", "xor_eq"]+
+ src/CGrep/Semantic/Generic/Token.hs view
@@ -0,0 +1,208 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE FlexibleInstances #-}+++module CGrep.Semantic.Generic.Token (tokenizer, Token(..)) where++import qualified Data.ByteString.Char8 as C+import qualified Data.DList as DL++import Data.Char+import Data.Array.Unboxed++import CGrep.Semantic.Token+import CGrep.Types++type DString = DL.DList Char+++data TokenState = StateSpace |+ StateAlpha |+ StateDigit |+ StateBracket |+ StateLit1 |+ StateLit2 |+ StateOther+ deriving (Eq, Enum, Show)+++data Token = TokenAlpha { toString :: String, offset :: Offset } |+ TokenDigit { toString :: String, offset :: Offset } |+ TokenBracket { toString :: String, offset :: Offset } |+ TokenLiteral { toString :: String, offset :: Offset } |+ TokenOther { toString :: String, offset :: Offset }+ deriving (Show, Eq, Ord)++_isTokenAlpha, _isTokenDigit, _isTokenBracket, _isTokenOther, _isTokenLiteral :: Token -> Bool++_isTokenAlpha (TokenAlpha _ _) = True+_isTokenAlpha _ = False++_isTokenDigit (TokenDigit _ _) = True+_isTokenDigit _ = False++_isTokenBracket (TokenBracket _ _) = True+_isTokenBracket _ = False++_isTokenLiteral (TokenLiteral _ _) = True+_isTokenLiteral _ = False++_isTokenOther (TokenOther _ _) = True+_isTokenOther _ = False++++tokenCompare :: Token -> Token -> Bool+tokenCompare (TokenAlpha { toString = l }) (TokenAlpha { toString = r }) = l == r+tokenCompare (TokenDigit { toString = l }) (TokenDigit { toString = r }) = l == r+tokenCompare (TokenLiteral { toString = l }) (TokenLiteral { toString = r }) = l == r+tokenCompare (TokenBracket { toString = l }) (TokenBracket { toString = r }) = l == r+tokenCompare (TokenOther { toString = l }) (TokenOther { toString = r }) = l == r+tokenCompare _ _ = False+++data TokenAccum = TokenAccum !TokenState !Offset !Int DString (DL.DList Token)+++isCharNumberLT :: UArray Char Bool+isCharNumberLT =+ listArray ('\0', '\255')+ (map (\c -> isHexDigit c || c `elem` ".xX") ['\0'..'\255'])+++isSpaceLT :: UArray Char Bool+isSpaceLT =+ listArray ('\0', '\255')+ (map isSpace ['\0'..'\255'])++isAlphaLT :: UArray Char Bool+isAlphaLT =+ listArray ('\0', '\255')+ (map (\c -> isAlpha c || c == '_') ['\0'..'\255'])++isAlphaNumLT :: UArray Char Bool+isAlphaNumLT =+ listArray ('\0', '\255')+ (map (\c -> isAlphaNum c || c == '_' || c == '\'') ['\0'..'\255'])++isDigitLT :: UArray Char Bool+isDigitLT =+ listArray ('\0', '\255')+ (map isDigit ['\0'..'\255'])++isBracketLT :: UArray Char Bool+isBracketLT =+ listArray ('\0', '\255')+ (map (`elem` "{[()]}") ['\0'..'\255'])+++{-# INLINE mkToken #-}+++mkToken :: (String -> Offset -> Token) -> Offset -> DString -> Token+mkToken ctor off ds = ctor str (off - length str)+ where str = DL.toList ds+++mkTokenCtor :: TokenState -> String -> Offset -> Token+mkTokenCtor StateSpace = TokenOther+mkTokenCtor StateAlpha = TokenAlpha+mkTokenCtor StateDigit = TokenDigit+mkTokenCtor StateBracket = TokenBracket+mkTokenCtor StateLit1 = TokenLiteral+mkTokenCtor StateLit2 = TokenLiteral+mkTokenCtor StateOther = TokenOther+++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+ where tokens' :: TokenAccum -> Char -> TokenAccum+ tokens' (TokenAccum StateSpace off _ _ out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty out+ | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) out+ | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) out+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) out+ | isDigitLT ! x -> TokenAccum StateDigit (off+1) 0 (DL.singleton x) out+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) out+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) out++ tokens' (TokenAccum StateAlpha off _ acc out) x =+ case () of+ _ | isAlphaNumLT ! x -> TokenAccum StateAlpha (off+1) 0 (acc `DL.snoc` x) out+ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenAlpha off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenAlpha off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenAlpha off acc)++ tokens' (TokenAccum StateDigit off _ acc out) x =+ case () of+ _ | isCharNumberLT ! x -> TokenAccum StateDigit (off+1) 0 (acc `DL.snoc` x) out+ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenDigit off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)++ tokens' (TokenAccum StateLit1 off skip acc out) x =+ case () of+ _ | skip > 0 -> TokenAccum StateLit1 (off+1) (skip-1) (acc `DL.snoc` x) out+ | x == '\\' -> TokenAccum StateLit1 (off+1) 1 (acc `DL.snoc` x) out+ | x == '\'' -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenLiteral (off+1) (acc `DL.snoc` '\''))+ | otherwise -> TokenAccum StateLit1 (off+1) 0 (acc `DL.snoc` x) out++ tokens' (TokenAccum StateLit2 off skip acc out) x =+ case () of+ _ | skip > 0 -> TokenAccum StateLit2 (off+1) (skip-1) (acc `DL.snoc` x) out+ | x == '\\' -> TokenAccum StateLit2 (off+1) 1 (acc `DL.snoc` x) out+ | x == '"' -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenLiteral (off+1) (acc `DL.snoc` '"'))+ | otherwise -> TokenAccum StateLit2 (off+1) 0 (acc `DL.snoc` x) out++ tokens' (TokenAccum StateBracket off _ acc out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenBracket off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | isDigitLT ! x -> TokenAccum StateDigit (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)++ tokens' (TokenAccum StateOther off _ acc out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenOther off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)+ | isDigitLT ! x -> if DL.toList acc == "."+ then TokenAccum StateDigit (off+1) 0 (acc `DL.snoc` x) out+ else TokenAccum StateDigit (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)+ | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (acc `DL.snoc` x) out+++instance SemanticToken Token where+ tkIsIdentifier = _isTokenAlpha+ tkIsString = _isTokenLiteral+ tkIsChar = _isTokenLiteral+ tkIsNumber = _isTokenDigit+ tkIsKeyword = const False+ tkToString = toString+ tkEquivalent = tokenCompare+
+ src/CGrep/Semantic/Token.hs view
@@ -0,0 +1,31 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Semantic.Token (SemanticToken(..)) where+++class (Show t, Ord t) => SemanticToken t where+ tkIsIdentifier :: t -> Bool+ tkIsString :: t -> Bool+ tkIsChar :: t -> Bool+ tkIsNumber :: t -> Bool+ tkIsKeyword :: t -> Bool+ tkToString :: t -> String+ tkEquivalent :: t -> t -> Bool++
+ src/CGrep/Semantic/WildCard.hs view
@@ -0,0 +1,164 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Semantic.WildCard (WildCard(..), MultiCard,+ filterTokensWithMultiCards,+ wildCardMatch,+ multiCardMatch) where++import qualified Data.Map as M++import CGrep.Common+import CGrep.Distance+import CGrep.Semantic.Token++import Data.Char+import Data.List+import Options+++data WildCard a = TokenCard a |+ AnyCard |+ KeyWordCard |+ NumberCard |+ OctCard |+ HexCard |+ StringCard |+ LiteralCard |+ CharCard |+ IdentifCard String+ deriving (Show, Eq, Ord)++type MultiCard a = [WildCard a]+++filterTokensWithMultiCards :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [a]+filterTokensWithMultiCards opt ws = filterTokensWithMultiCards' opt (spanOptionalCards ws)+++filterTokensWithMultiCards' :: (SemanticToken a) => Options -> [[MultiCard a]] -> [a] -> [a]+filterTokensWithMultiCards' _ [] _ = []+filterTokensWithMultiCards' opt (g:gs) ts =+ concatMap (take grpLen . (`drop` ts)) (findIndices (multiCardCompare opt g) grp) +++ filterTokensWithMultiCards' opt gs ts+ where grp = spanGroup grpLen ts+ grpLen = length g+++spanOptionalCards :: [MultiCard a] -> [[MultiCard a]]+spanOptionalCards wc = map (`filterCardIndicies` wc') idx+ where wc' = zip [0..] wc+ idx = subsequences $+ findIndices (\w -> case w of+ [IdentifCard ('$':_)] -> True+ _ -> False) wc+++filterCardIndicies :: [Int] -> [(Int, MultiCard a)] -> [MultiCard a]+filterCardIndicies ns ps = map snd $ filter (\(n, _) -> n `notElem` ns) ps+++multiCardCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> Bool+multiCardCompare opt l r =+ multiCardCompareAll ts && multiCardCheckOccurences ts+ where ts = multiCardGroupCompare opt l r+++{-# INLINE multiCardCompareAll #-}++multiCardCompareAll :: [(Bool, (MultiCard a, [String]))] -> Bool+multiCardCompareAll = all fst+++{-# INLINE multiCardCheckOccurences #-}++-- Note: pattern $ and _ match any token, whereas $1 $2 (_1 _2 etc.) match tokens+-- that must compare equal in the relative occurrences+--++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)+++multiCardGroupCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [(Bool, (MultiCard a, [String]))]+multiCardGroupCompare opt ls rs+ | length rs >= length ls = zipWith (tokensZip opt) ls rs+ | otherwise = [ (False, ([AnyCard], [])) ]+++tokensZip :: (SemanticToken a) => Options -> MultiCard a -> a -> (Bool, (MultiCard a, [String]))+tokensZip opt l r+ | multiCardMatch opt l r = (True, (l, [tkToString r]))+ | otherwise = (False, ([AnyCard],[] ))+++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+wildCardMatch _ KeyWordCard t = tkIsKeyword t+wildCardMatch _ StringCard t = tkIsString t+wildCardMatch _ CharCard t = tkIsChar t+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 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)+ | otherwise = l `tkEquivalent` r+
+ src/CGrep/Strategy/BoyerMoore.hs view
@@ -0,0 +1,106 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--+++module CGrep.Strategy.BoyerMoore (search) where++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Search as SC++import Data.List++import CGrep.Common+import CGrep.Output+import CGrep.Filter+import CGrep.Lang+import CGrep.Types++import qualified CGrep.Token as T++import Options+import Debug++import Control.Arrow as A++search :: CgrepFunction+search opt ps f = do++ let filename = getFileName f++ text <- getText f++ -- transform text++ let text' = expandMultiline opt . ignoreCase opt $ text++ -- quick search...++ let found = quickSearch opt ps text'++ -- put banners...++ putStrLevel1 (debug opt) $ "strategy : running string search on " ++ filename ++ "..."++ if maybe False not found+ then return $ mkOutput opt filename text []+ else do++ let text'' = contextFilter (getLang opt filename) (mkContextFilter opt) text++ -- search for matching tokens++ let tokens = map (A.second C.unpack) $ ps >>= (\p -> map (\i -> (i,p)) (p `SC.nonOverlappingIndices` text''))++ -- filter exact matching tokens++ let 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---"++ return $ mkOutput opt filename text tokens'+++checkToken :: Options -> Text8 -> (Offset, String) -> Bool+checkToken opt text (off, str)+ | word_match opt = (off - off', str) `elem` ts+ | prefix_match opt = any (\(o,s) -> str `isPrefixOf` s && o + off' == off) ts+ | suffix_match opt = any (\(o,s) -> str `isSuffixOf` s && o + off' + (length s - length str) == off) ts+ where (text',off') = getLineByOffset off text+ ts = T.tokenizer text'++checkToken _ _ (_,_) = undefined+++splitLines :: Text8 -> [(Text8,Offset)]+splitLines xs = zip ls off+ where ls = C.lines xs+ off = scanl (\o l -> 1 + o + C.length l) 0 ls+++getLineByOffset :: Offset -> Text8 -> (Text8, Offset)+getLineByOffset off xs = last $ takeWhile (\(_,o) -> o <= off) sl+ where sl = splitLines xs+++++
+ src/CGrep/Strategy/Cpp/Semantic.hs view
@@ -0,0 +1,147 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Strategy.Cpp.Semantic (search) where++import qualified Data.ByteString.Char8 as C++import qualified CGrep.Semantic.Cpp.Token as Cpp++import CGrep.Filter+import CGrep.Lang+import CGrep.Common+import CGrep.Output++import CGrep.Semantic.Token+import CGrep.Semantic.WildCard++import qualified Data.Map as M++import Data.List+import Data.Function+import Data.Maybe++import Options+import Debug++search :: CgrepFunction+search opt ps f = do++ let filename = getFileName f++ text <- getText f++ -- transform text++ let text' = expandMultiline opt . ignoreCase opt $ text++ let filt = (mkContextFilter opt) { getComment = False }++ -- pre-process patterns++ let patterns = map (Cpp.tokenizer . contextFilter (Just Cpp) filt) ps -- [ [t1,t2,..], [t1,t2...] ]++ let patterns' = map (map mkWildCard) patterns -- [ [w1,w2,..], [w1,w2,..] ]++ let patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [ [ [w1], [w2],..], [[w1],[w2],..]]++ -- quick Search...++ let ps' = map (C.pack . (\l -> if null l then ""+ else maximumBy (compare `on` length) l) . mapMaybe (\x -> case x of+ TokenCard (Cpp.TokenChar xs _) -> Just $ unquotes $ trim xs+ TokenCard (Cpp.TokenString xs _) -> Just $ unquotes $ trim xs+ TokenCard t -> Just $ Cpp.toString t+ _ -> Nothing)) patterns'++ let found = quickSearch opt 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 []+ else do++ let text'' = contextFilter (getLang opt filename) filt text'++ -- parse source code, get the Cpp.Token list...++ let tokens = Cpp.tokenizer text''++ -- get matching tokens ...++ let tokens' = sortBy (compare `on` Cpp.offset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''++ let matches = map (\t -> let n = fromIntegral (Cpp.offset 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---"++ return $ mkOutput opt filename text matches+++instance SemanticToken Cpp.Token where+ tkIsIdentifier = Cpp.isIdentifier+ tkIsString = Cpp.isString+ tkIsChar = Cpp.isChar+ tkIsNumber = Cpp.isLiteralNumber+ tkIsKeyword = Cpp.isKeyword+ tkToString = Cpp.toString+ tkEquivalent = Cpp.tokenCompare+++wildCardMap :: M.Map String (WildCard a)+wildCardMap = M.fromList+ [+ ("ANY", AnyCard ),+ ("KEY", KeyWordCard ),+ ("OCT", OctCard ),+ ("HEX", HexCard ),+ ("NUM", NumberCard ),+ ("CHR", CharCard ),+ ("STR", StringCard ),+ ("LIT", LiteralCard )+ ]+++mkWildCard :: Cpp.Token -> WildCard Cpp.Token+mkWildCard t@(Cpp.TokenIdentifier s _) =+ case () of+ _ | Just wc <- M.lookup str wildCardMap -> wc+ | ('$':_) <- s -> IdentifCard str+ | ('_':_) <- s -> IdentifCard str+ | otherwise -> TokenCard t+ where str = tkToString t+mkWildCard t = TokenCard t+++combineMultiCard :: [MultiCard Cpp.Token] -> [MultiCard Cpp.Token]+combineMultiCard (m1:r@(m2:m3:ms))+ | [TokenCard (Cpp.TokenIdentifier {Cpp.toString = "OR"})] <- m2 = combineMultiCard $ (m1++m3):ms+ | otherwise = m1 : combineMultiCard r+combineMultiCard [m1,m2] = [m1,m2]+combineMultiCard [m1] = [m1]+combineMultiCard [] = []++
+ src/CGrep/Strategy/Cpp/Tokenizer.hs view
@@ -0,0 +1,102 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Strategy.Cpp.Tokenizer (search) where++import qualified Data.ByteString.Char8 as C++import qualified CGrep.Semantic.Cpp.Token as Cpp++import CGrep.Filter+import CGrep.Lang+import CGrep.Common+import CGrep.Output+import CGrep.Distance++import Data.List++import Options+import Debug++search :: CgrepFunction+search opt ps f = do++ let filename = getFileName f++ text <- getText f++ -- transform text++ let text' = expandMultiline opt . ignoreCase opt $ text++ let filt = (mkContextFilter opt) { getComment = False }++ putStrLevel1 (debug opt) $ "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 []+ else do++ let text'' = contextFilter (getLang opt filename) filt text'++ -- parse source code, get the Cpp.Token list...++ let tokens = Cpp.tokenizer text''++ -- context-filterting...++ let 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...++ let tokens'' = cppTokenFilter opt (map C.unpack ps) tokens'++ -- convert Cpp.Tokens to CGrep.Tokens++ let matches = map (\t -> let off = fromIntegral (Cpp.offset 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---"++ return $ mkOutput opt filename text matches+++cppTokenFilter :: Options -> [String] -> [Cpp.Token] -> [Cpp.Token]+cppTokenFilter opt patterns tokens+ | edit_dist opt = filter (\t -> any (\p -> p ~== Cpp.toString t) patterns) tokens+ | word_match opt = filter ((`elem` patterns) . Cpp.toString) tokens+ | 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
@@ -0,0 +1,138 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Strategy.Generic.Semantic (search) where++import qualified Data.ByteString.Char8 as C++import CGrep.Filter+import CGrep.Lang+import CGrep.Common+import CGrep.Output++import CGrep.Semantic.Token+import CGrep.Semantic.WildCard++import qualified Data.Map as M++import Data.List+import Data.Function+import Data.Maybe++import Options+import Debug++import qualified CGrep.Semantic.Generic.Token as Generic++search :: CgrepFunction+search opt ps f = do++ let filename = getFileName f++ text <- getText f++ -- transform text++ let text' = expandMultiline opt . ignoreCase opt $ text++ let filt = (mkContextFilter opt) { getComment = False }++ -- pre-process patterns++ let patterns = map (Generic.tokenizer . contextFilter (getLang opt filename) filt) ps -- [ [t1,t2,..], [t1,t2...] ]++ let patterns' = map (map mkWildCard) patterns -- [ [w1,w2,..], [w1,w2,..] ]++ let patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [ [ [w1], [w2],..], [[w1],[w2],..]]++ -- quickSearch ...++ let ps' = map ( C.pack . (\l -> if null l then ""+ else maximumBy (compare `on` length) l) . mapMaybe (\x -> case x of+ TokenCard (Generic.TokenLiteral xs _) -> Just (unquotes $ trim xs)+ TokenCard t -> Just (tkToString t)+ _ -> Nothing)) patterns'++ -- 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'++ let found = quickSearch opt ps' text'++ if maybe False not found+ then return $ mkOutput opt filename text []+ else do++ let text'' = contextFilter (getLang opt filename) filt text'++ -- parse source code, get the Generic.Token list...++ let tokens = Generic.tokenizer text''++ -- get matching tokens ...++ let tokens' = sortBy (compare `on` Generic.offset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''++ let matches = map (\t -> let n = fromIntegral (Generic.offset t) in (n, Generic.toString t)) tokens' :: [(Int, String)]++ 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---"++ return $ mkOutput opt filename text matches+++wildCardMap :: M.Map String (WildCard a)+wildCardMap = M.fromList+ [+ ("ANY", AnyCard ),+ ("KEY", KeyWordCard ),+ ("OCT", OctCard ),+ ("HEX", HexCard ),+ ("NUM", NumberCard ),+ ("CHR", CharCard ),+ ("STR", StringCard ),+ ("LIT", StringCard )+ ]+++mkWildCard :: Generic.Token -> WildCard Generic.Token+mkWildCard t@(Generic.TokenAlpha s _) =+ case () of+ _ | Just wc <- M.lookup str wildCardMap -> wc+ | ('$':_) <- s -> IdentifCard str+ | ('_':_) <- s -> IdentifCard str+ | otherwise -> TokenCard t+ where str = tkToString t+mkWildCard t = TokenCard t+++combineMultiCard :: [MultiCard Generic.Token] -> [MultiCard Generic.Token]+combineMultiCard (m1:r@(m2:m3:ms))+ | [TokenCard (Generic.TokenAlpha {Generic.toString = "OR"})] <- m2 = combineMultiCard $ (m1++m3):ms+ | otherwise = m1 : combineMultiCard r+combineMultiCard [m1,m2] = [m1,m2]+combineMultiCard [m1] = [m1]+combineMultiCard [] = []++
+ src/CGrep/Strategy/Levenshtein.hs view
@@ -0,0 +1,61 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Strategy.Levenshtein (search) where++import qualified Data.ByteString.Char8 as C++import CGrep.Filter+import CGrep.Lang+import CGrep.Common+import CGrep.Output+import CGrep.Distance+import CGrep.Token++import Options+import Debug++search :: CgrepFunction+search opt ps f = do++ let filename = getFileName f++ text <- getText f++ -- transform text++ let text' = ignoreCase opt . expandMultiline opt . contextFilter (getLang opt filename) (mkContextFilter opt) $ text++ -- parse source code, get the Cpp.Token list...++ let tokens' = tokenizer text'++ -- filter tokens...++ let patterns = map C.unpack ps++ let 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---"++ return $ mkOutput opt filename text matches+
+ src/CGrep/Strategy/Regex.hs view
@@ -0,0 +1,62 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE FlexibleContexts #-}++module CGrep.Strategy.Regex (search) where++import qualified Data.ByteString.Char8 as C++import Text.Regex.Posix+import Data.Array++import CGrep.Common+import CGrep.Output+import CGrep.Filter+import CGrep.Lang++import Options+import Debug+++search :: CgrepFunction+search opt ps f = do++ let filename = getFileName f++ text <- getText f++ -- transform text++ let text' = expandMultiline opt . ignoreCase opt $ text++ -- put banners...++ putStrLevel1 (debug opt) $ "strategy : running regex search on " ++ filename ++ "..."++ let text'' = contextFilter (getLang opt filename) (mkContextFilter opt) text'++ -- search for matching tokens++ let tokens = map (\(str, (off,_)) -> (off, C.unpack str) ) $ concatMap elems $ ps >>= (\p -> elems (getAllTextMatches $ text'' =~ p :: (Array Int) (MatchText Text8)) )++ putStrLevel2 (debug opt) $ "tokens : " ++ show tokens+ putStrLevel3 (debug opt) $ "---\n" ++ C.unpack text'' ++ "\n---"++ return $ mkOutput opt filename text tokens+
+ src/CGrep/Token.hs view
@@ -0,0 +1,135 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE FlexibleInstances #-}+++module CGrep.Token (Token, MatchLine, tokens, tokenizer) where++import qualified Data.ByteString.Char8 as C+import qualified Data.DList as DL++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 TokenAccum = TokenAccum !TokenState !Offset DString (DL.DList Token)+++isCharNumberLT :: UArray Char Bool+isCharNumberLT =+ listArray ('\0', '\255')+ (map (\c -> isHexDigit c || c `elem` ".xX") ['\0'..'\255'])+++isSpaceLT :: UArray Char Bool+isSpaceLT =+ listArray ('\0', '\255')+ (map isSpace ['\0'..'\255'])++isAlphaLT :: UArray Char Bool+isAlphaLT =+ listArray ('\0', '\255')+ (map (\c -> isAlpha c || c == '_') ['\0'..'\255'])++isAlphaNumLT :: UArray Char Bool+isAlphaNumLT =+ listArray ('\0', '\255')+ (map (\c -> isAlphaNum c || c == '_' || c == '\'') ['\0'..'\255'])++isDigitLT :: UArray Char Bool+isDigitLT =+ listArray ('\0', '\255')+ (map isDigit ['\0'..'\255'])++isBracketLT :: UArray Char Bool+isBracketLT =+ listArray ('\0', '\255')+ (map (`elem` "{[()]}") ['\0'..'\255'])+++{-# INLINE mkToken #-}++mkToken :: Offset -> DString -> Token+mkToken off ds = (off - length str, str)+ where str = DL.toList ds+++tokens :: Text8 -> [String]+tokens = map snd . tokenizer+++tokenizer :: Text8 -> [Token]+tokenizer xs = (\(TokenAccum _ off acc out) -> DL.toList (if null (DL.toList acc) then out+ else out `DL.snoc` mkToken off acc)) $ C.foldl' tokens' (TokenAccum StateSpace 0 DL.empty DL.empty) xs+ where tokens' :: TokenAccum -> Char -> TokenAccum+ tokens' (TokenAccum StateSpace off _ out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty out+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) out+ | isDigitLT ! x -> TokenAccum StateDigit (off+1) (DL.singleton x) out+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) out+ | otherwise -> TokenAccum StateOther (off+1) (DL.singleton x) out++ tokens' (TokenAccum StateAlpha off acc out) x =+ case () of+ _ | isAlphaNumLT ! x -> TokenAccum StateAlpha (off+1) (acc `DL.snoc` x) out+ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (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) (DL.singleton x) (out `DL.snoc` mkToken off acc)++ tokens' (TokenAccum StateDigit off acc out) x =+ case () of+ _ | isCharNumberLT ! x -> TokenAccum StateDigit (off+1) (acc `DL.snoc` x) out+ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (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) (DL.singleton x) (out `DL.snoc` mkToken off acc)++ tokens' (TokenAccum StateBracket off acc out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)+ | isDigitLT ! x -> 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) (DL.singleton x) (out `DL.snoc` mkToken off acc)++ tokens' (TokenAccum StateOther off acc out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)+ | isDigitLT ! x -> if DL.toList acc == "."+ then TokenAccum StateDigit (off+1) (acc `DL.snoc` x) out+ 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/CGrep/Types.hs view
@@ -0,0 +1,30 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--+++module CGrep.Types where++import Data.ByteString.Char8 as C++type Offset = Int+type Offset2d = (Int, Int)+type OffsetLine = Int++type Text8 = C.ByteString+type Line8 = C.ByteString+
+ src/CmdOptions.hs view
@@ -0,0 +1,81 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CmdOptions where++import System.Console.CmdArgs++import Options+import Config++options :: Mode (CmdArgs Options)+options = cmdArgsMode $ Options+ {+ file = "" &= typ "FILE" &= help "Read PATTERNs from file" &= 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",+ 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",+#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++ } &= summary ("Cgrep " ++ version ++ ". Usage: cgrep [OPTION] [PATTERN] files...") &= program "cgrep"++
+ src/Config.hs view
@@ -0,0 +1,58 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module Config where++import Data.Maybe+import Control.Monad+import System.Directory+import System.FilePath ((</>))++import Util+import CGrep.Lang+++cgreprc :: FilePath+cgreprc = "cgreprc"++version :: String+version = "6.4"+++data Config = Config+ {+ languages :: [Lang],+ pruneDirs :: [String]++ } deriving (Show, Read)+++getConfig :: IO Config+getConfig = do+ home <- getHomeDirectory+ conf <- liftM msum $ forM [ home </> "." ++ cgreprc, "/etc" </> cgreprc ] $ \f ->+ doesFileExist f >>= \b -> return $ guard b >> Just f++ if isJust conf then readFile (fromJust conf) >>= \xs ->+ return (prettyRead (dropComments xs) "Config error" :: Config)+ else return $ Config [] []++ where dropComments :: String -> String+ dropComments = unlines . map (takeWhile $ not .(== '#')) . lines++
+ src/Debug.hs view
@@ -0,0 +1,31 @@+--+-- copyright (c) 2013 bonelli nicola <bonelli@antifork.org>+--+-- this program is free software; you can redistribute it and/or modify+-- it under the terms of the gnu general public license as published by+-- the free software foundation; either version 2 of the license, or+-- (at your option) any later version.+--+-- this program is distributed in the hope that it will be useful,+-- but without any warranty; without even the implied warranty of+-- merchantability or fitness for a particular purpose. see the+-- gnu general public license for more details.+--+-- you should have received a copy of the gnu general public license+-- along with this program; if not, write to the free software+-- foundation, inc., 59 temple place - suite 330, boston, ma 02111-1307, usa.+--+++module Debug where++import Control.Monad++putStrLevel1 :: Int -> String -> IO ()+putStrLevel1 n xs = when (n > 0) $ putStrLn xs++putStrLevel2 :: Int -> String -> IO ()+putStrLevel2 n xs = when (n > 1) $ putStrLn xs++putStrLevel3 :: Int -> String -> IO ()+putStrLevel3 n xs = when (n > 2) $ putStrLn xs
+ src/Main.hs view
@@ -0,0 +1,207 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module Main where++import Data.List+import Data.Maybe+import Data.Char+import Data.Data()+import Data.Function++import Control.Exception as E+import Control.Concurrent+import Control.Monad.STM+import Control.Concurrent.STM.TChan++import Control.Monad+import Control.Applicative++import System.Console.CmdArgs+import System.Directory+import System.FilePath ((</>), takeFileName)+import System.Environment+import System.IO+import System.Exit++import CGrep.CGrep+import CGrep.Lang+import CGrep.Output++import CmdOptions+import Options+import Util+import Debug+import Config++import qualified Data.ByteString.Char8 as C++-- push file names in TChan...++putRecursiveContents :: Options -> TChan (Maybe FilePath) -> FilePath -> [Lang] -> [String] -> IO ()+putRecursiveContents opts inchan topdir langs prunedir = do+ dir <- doesDirectoryExist topdir+ if dir then do+ names <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents topdir+ forM_ names $ \n -> do+ let path = topdir </> n+ let filename = takeFileName path+ isDirectory <- doesDirectoryExist path+ if isDirectory+ then unless (filename `elem` prunedir) $+ putRecursiveContents opts inchan path langs prunedir+ else case getLang opts filename >>= (\f -> f `elemIndex` langs <|> toMaybe 0 (null langs) ) of+ Nothing -> return ()+ _ -> atomically $ writeTChan inchan (Just path)+ else atomically $ writeTChan inchan (Just topdir)+++-- read patterns from file++readPatternsFromFile :: FilePath -> IO [C.ByteString]+readPatternsFromFile f =+ if null f then return []+ else liftM C.words $ C.readFile f++++main :: IO ()+main = do++ -- read command-line options++ opts <- cmdArgsRun options++ putStrLevel1 (debug opts) $ "Cgrep " ++ version ++ "!"+ putStrLevel1 (debug opts) $ "options : " ++ show opts++ -- check for multiple backends...++ when (length (catMaybes [+#ifdef ENABLE_HINT+ hint opts,+#endif+ format opts,+ if xml opts then Just "" else Nothing,+ if json opts then Just "" else Nothing+ ]) > 1) $ error "you can use one back-end at time!"++ -- display lang-map...++ when (lang_maps opts) $ dumpLangMap langMap >> exitSuccess++ -- check whether patterns list is empty, display help message if it's the case++ when (null $ others opts) $ withArgs ["--help"] $ void (cmdArgsRun options)++ -- read Cgrep config options++ conf <- getConfig++ -- load patterns:++ patterns <- (if null $ file opts then return [C.pack $ head $ others opts]+ else readPatternsFromFile $ file opts ) >>= \ps ->+ return $ if ignore_case opts+ then map (C.map toLower) ps+ else ps+++ -- check whether is a terminal device++ isTerm <- hIsTerminalDevice stdin++ -- retrieve files to parse++ let tailOpts = tail $ others opts++ let paths = if null $ file opts then if null tailOpts && isTerm then ["."] else tailOpts+ else others opts++ -- parse cmd line language list:++ let (l0, l1, l2) = splitLangList (lang opts)++ -- language enabled:++ let lang_enabled = (if null l0 then languages conf else l0 `union` l1) \\ l2++ putStrLevel1 (debug opts) $ "languages : " ++ show lang_enabled+ putStrLevel1 (debug opts) $ "pattern : " ++ show patterns+ putStrLevel1 (debug opts) $ "files : " ++ show paths+ putStrLevel1 (debug opts) $ "isTerm : " ++ show isTerm++ -- create Transactional Chan and Vars...++ in_chan <- newTChanIO+ out_chan <- newTChanIO++ -- launch worker threads...++ forM_ [1 .. jobs opts] $ \_ -> forkIO $+ fix (\action -> do+ f <- atomically $ readTChan in_chan+ E.catch+ (case f of+ Nothing -> atomically $ writeTChan out_chan []+ Just f' -> do+ out <- let op = sanitizeOptions f' opts in+ liftM (take (max_count opts)) $+ cgrepDispatch op f' op patterns $ guard (f' /= "") >> Just f'+ unless (null out) $ atomically $ writeTChan out_chan out+ action )+ (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFile opts (fromMaybe "<STDIN>" f) ++ " -> " ++ if length msg > 80 then take 80 msg ++ "..." else msg) >> action )+ )+++ -- push the files to grep for...++ _ <- forkIO $ do++ if recursive opts+ then forM_ paths $ \p -> putRecursiveContents opts in_chan p lang_enabled (pruneDirs conf)+ else do+ files <- liftM (\l -> if null l && not isTerm then [""] else l) $ filterM doesFileExist paths+ forM_ files (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 ()+ xs <- prettyOutput opts out+ mapM_ putStrLn xs+ action n True+ ) 0 False++ putPrettyFooter opts+
+ src/Options.hs view
@@ -0,0 +1,83 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE DeriveDataTypeable #-}++module Options where++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,+ invert_match :: Bool,+ max_count :: Int,+ count :: Bool,+ show_match :: Bool,+ color :: Bool,+#ifdef ENABLE_HINT+ hint :: Maybe String,+#endif+ format :: Maybe String,+ json :: Bool,+ xml :: Bool,++ debug :: Int,+ no_turbo :: Bool,+ others :: [String]++ } deriving (Data, Typeable, Show)+
+ src/Util.hs view
@@ -0,0 +1,56 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module Util where++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as LC++import Data.Maybe+++toStrict :: LC.ByteString -> C.ByteString+toStrict = C.concat . LC.toChunks+++toMaybe :: a -> Bool -> Maybe a+toMaybe a True = Just a+toMaybe _ False = Nothing+++notNull :: [a] -> Bool+notNull = not . null+++xor :: Bool -> Bool -> Bool+a `xor` b = a && not b || not a && b+++prettyRead :: Read a => String -> String -> a+prettyRead xs err =+ case value of+ Just v -> v+ _ -> error $ err ++ ": parse error near " ++ show(take 40 xs)+ where value = readMaybe xs+++readMaybe :: Read a => String -> Maybe a+readMaybe = fmap fst . listToMaybe . reads+++