diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + + + Copyright (C) + + 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. + + , 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cgrep.cabal b/cgrep.cabal new file mode 100644 --- /dev/null +++ b/cgrep.cabal @@ -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 +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 diff --git a/src/CGrep/CGrep.hs b/src/CGrep/CGrep.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/CGrep.hs @@ -0,0 +1,87 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + + diff --git a/src/CGrep/Common.hs b/src/CGrep/Common.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Common.hs @@ -0,0 +1,106 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 = "" +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 + + + diff --git a/src/CGrep/Context.hs b/src/CGrep/Context.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Context.hs @@ -0,0 +1,30 @@ +-- +-- Copyright (c) 2012-2013 Bonelli Nicola +-- +-- 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) + diff --git a/src/CGrep/Distance.hs b/src/CGrep/Distance.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Distance.hs @@ -0,0 +1,51 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 diff --git a/src/CGrep/Filter.hs b/src/CGrep/Filter.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Filter.hs @@ -0,0 +1,238 @@ +-- +-- Copyright (c) 2012-2013 Bonelli Nicola +-- +-- 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") ] [("'", "'"), ("\"", "\"")] ) + ] + diff --git a/src/CGrep/Lang.hs b/src/CGrep/Lang.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Lang.hs @@ -0,0 +1,122 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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) + diff --git a/src/CGrep/Output.hs b/src/CGrep/Output.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Output.hs @@ -0,0 +1,226 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 "" >> putStrLn "" + | otherwise -> return () + + +putPrettyFooter :: Options -> IO () +putPrettyFooter opt = + case () of + _ | json opt -> putStrLn "]" + | xml opt -> putStrLn "" + | 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 = + ["" ] ++ + ["" ] ++ + [foldl mkMatch "" outs] ++ + [""] ++ + [""] + where fname | (Output f _ _ _) <- head outs = f + mkToken (n, xs) = "" ++ xs ++ "" + mkMatch xs (Output _ n l ts) = xs ++ "" ++ + unwords (map mkToken ts) ++ + "" + + +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..]) + + diff --git a/src/CGrep/Semantic/Cpp/Token.hs b/src/CGrep/Semantic/Cpp/Token.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Semantic/Cpp/Token.hs @@ -0,0 +1,372 @@ +-- +-- Copyright (c) 2012-2013 Bonelli Nicola +-- +-- 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"] + diff --git a/src/CGrep/Semantic/Generic/Token.hs b/src/CGrep/Semantic/Generic/Token.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Semantic/Generic/Token.hs @@ -0,0 +1,208 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + diff --git a/src/CGrep/Semantic/Token.hs b/src/CGrep/Semantic/Token.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Semantic/Token.hs @@ -0,0 +1,31 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + + diff --git a/src/CGrep/Semantic/WildCard.hs b/src/CGrep/Semantic/WildCard.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Semantic/WildCard.hs @@ -0,0 +1,164 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + diff --git a/src/CGrep/Strategy/BoyerMoore.hs b/src/CGrep/Strategy/BoyerMoore.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Strategy/BoyerMoore.hs @@ -0,0 +1,106 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + + + + + diff --git a/src/CGrep/Strategy/Cpp/Semantic.hs b/src/CGrep/Strategy/Cpp/Semantic.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Strategy/Cpp/Semantic.hs @@ -0,0 +1,147 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 [] = [] + + diff --git a/src/CGrep/Strategy/Cpp/Tokenizer.hs b/src/CGrep/Strategy/Cpp/Tokenizer.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Strategy/Cpp/Tokenizer.hs @@ -0,0 +1,102 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + + diff --git a/src/CGrep/Strategy/Generic/Semantic.hs b/src/CGrep/Strategy/Generic/Semantic.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Strategy/Generic/Semantic.hs @@ -0,0 +1,138 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 [] = [] + + diff --git a/src/CGrep/Strategy/Levenshtein.hs b/src/CGrep/Strategy/Levenshtein.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Strategy/Levenshtein.hs @@ -0,0 +1,61 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + diff --git a/src/CGrep/Strategy/Regex.hs b/src/CGrep/Strategy/Regex.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Strategy/Regex.hs @@ -0,0 +1,62 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + diff --git a/src/CGrep/Token.hs b/src/CGrep/Token.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Token.hs @@ -0,0 +1,135 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 diff --git a/src/CGrep/Types.hs b/src/CGrep/Types.hs new file mode 100644 --- /dev/null +++ b/src/CGrep/Types.hs @@ -0,0 +1,30 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + diff --git a/src/CmdOptions.hs b/src/CmdOptions.hs new file mode 100644 --- /dev/null +++ b/src/CmdOptions.hs @@ -0,0 +1,81 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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" + + diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,58 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + + diff --git a/src/Debug.hs b/src/Debug.hs new file mode 100644 --- /dev/null +++ b/src/Debug.hs @@ -0,0 +1,31 @@ +-- +-- copyright (c) 2013 bonelli nicola +-- +-- 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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,207 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 "" 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 + diff --git a/src/Options.hs b/src/Options.hs new file mode 100644 --- /dev/null +++ b/src/Options.hs @@ -0,0 +1,83 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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) + diff --git a/src/Util.hs b/src/Util.hs new file mode 100644 --- /dev/null +++ b/src/Util.hs @@ -0,0 +1,56 @@ +-- +-- Copyright (c) 2013 Bonelli Nicola +-- +-- 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 + + +