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