cgrep 6.6.32 → 8.0.0
raw patch · 42 files changed
+7955/−2686 lines, 42 filesdep +bitarraydep +bitwisedep +bytestring-strict-builder
Dependencies added: bitarray, bitwise, bytestring-strict-builder, deepseq, mmap, monad-loops, mono-traversable, posix-paths, rawfilepath, text, unagi-chan, vector
Files
- README.md +62/−80
- cgrep.cabal +108/−52
- src/CGrep/Boundary.hs +46/−0
- src/CGrep/CGrep.hs +0/−99
- src/CGrep/Common.hs +40/−34
- src/CGrep/Context.hs +0/−31
- src/CGrep/ContextFilter.hs +309/−0
- src/CGrep/Distance.hs +2/−3
- src/CGrep/FileKind.hs +43/−0
- src/CGrep/FileType.hs +64/−0
- src/CGrep/FileTypeMap.hs +4906/−0
- src/CGrep/Filter.hs +0/−237
- src/CGrep/Lang.hs +0/−147
- src/CGrep/Output.hs +178/−212
- src/CGrep/Parser/Atom.hs +221/−0
- src/CGrep/Parser/Char.hs +130/−0
- src/CGrep/Parser/Chunk.hs +223/−0
- src/CGrep/Parser/Cpp/Token.hs +0/−381
- src/CGrep/Parser/Generic/Token.hs +0/−213
- src/CGrep/Parser/Line.hs +91/−0
- src/CGrep/Parser/Token.hs +402/−12
- src/CGrep/Parser/WildCard.hs +0/−221
- src/CGrep/Search.hs +78/−0
- src/CGrep/Strategy/BoyerMoore.hs +58/−54
- src/CGrep/Strategy/Cpp/Semantic.hs +0/−103
- src/CGrep/Strategy/Cpp/Tokenizer.hs +0/−106
- src/CGrep/Strategy/Generic/Semantic.hs +0/−102
- src/CGrep/Strategy/Levenshtein.hs +36/−21
- src/CGrep/Strategy/Regex.hs +36/−23
- src/CGrep/Strategy/Semantic.hs +135/−0
- src/CGrep/Strategy/Tokenizer.hs +130/−0
- src/CGrep/Token.hs +0/−139
- src/CGrep/Types.hs +11/−10
- src/CmdOptions.hs +35/−30
- src/Config.hs +65/−23
- src/Debug.hs +0/−43
- src/Main.hs +78/−252
- src/Options.hs +17/−26
- src/Reader.hs +10/−5
- src/Search.hs +331/−0
- src/Util.hs +44/−27
- src/Verbose.hs +66/−0
README.md view
@@ -1,102 +1,84 @@-CGrep: a context-aware grep for source codes +CGrep: a context-aware grep for source codes ============================================ -[](https://hackage.haskell.org/package/cgrep) +[](https://hackage.haskell.org/package/cgrep) [](https://gitter.im/awgn/cgrep?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) Usage ----- -Cgrep 6.6.31. Usage: cgrep [OPTION] [PATTERN] files...+```+Cgrep 8.0.0. Usage: cgrep [OPTION] [PATTERN] files... cgrep [OPTIONS] [ITEM] - Pattern:-- -f --file=FILE Read PATTERNs from file (one per line)- -w --word Force word matching- -p --prefix Force prefix matching- -s --suffix Force suffix matching- -e --edit Use edit distance- -G --regex Use regex matching (posix)- -P --regex-pcre Use regex matching (pcre)- -i --ignore-case Ignore case distinctions---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, LIT,- NUM, HEX, OCT, OR. -> e.g. "_1(_1 && \$)" search- for move constructors, "struct OR class _ { OR :- OR <" search for a class declaration-+ -f --file=FILE Read PATTERNs from file (one per line)+ -w --word Force word matching+ -p --prefix Force prefix matching+ -s --suffix Force suffix matching+ -e --edit Use edit distance+ -G --regex Use regex matching (posix)+ -P --pcre Use regex matching (pcre)+ -i --ignore-case Ignore case distinctions -C/C++ language:+Context filters:+ -c --code Enable search in source code+ -m --comment Enable search in comments+ -l --literal Enable search in string literals - --identifier Identifiers- --keyword Keywords- --directive Preprocessing directives- --header Headers names- --number Literal numbers- --string Literal strings- --char Literal chars- --oper Operators+Token filters:+ --name --identifier Identifiers+ --type --native Native Types+ --keyword Keywords+ --number Literal numbers+ --string Literal strings+ --op Operators +Semantic:+ -S --semantic "code" pattern: _, _1, _2... (identifiers), $, $1,+ $2... (optionals), ANY, KEY, STR, LIT, NUM, HEX, OCT,+ OR Output control:-- --max-count=INT Stop search in files after INT matches- --language-filter=ITEM Specify languages. ie: Cpp, +Haskell, -Makefile- --language-force=ITEM Force the language- --language-map Lists the language mappings- --magic-filter=ITEM Use unix magic as file-filter- -v --invert-match Select non-matching lines- --multiline=INT Enable multi-line matching- -r --recursive Enable recursive search (don't follow symlinks)- --prune-dir=ITEM Do not descend into dir- -R --deference-recursive Recursive, follow symlinks-+ --max-count=INT Stop search in files after INT matches+ -t --type-filter=ITEM Specify file types. ie: Cpp, +Haskell, -Makefile+ -k --kind-filter=ITEM Specify file kinds. Text, Config, Language, Data,+ Markup or Script+ --force-type=ITEM Force the type of file+ --type-list List the supported file types+ -v --invert-match Select non-matching lines+ --multiline=INT Enable multi-line matching+ -r --recursive Enable recursive search (don't follow symlinks)+ -T --skip-test Skip files that have 'test' in the name+ --prune-dir=ITEM Do not descend into dir+ -L --follow Follow symlinks Output format:-- --show-match Show list of matching tokens- --color Use colors to highlight the matching strings- --no-color Do not use colors (override config file)- -h --no-filename Suppress the file name prefix on output- --no-numbers Suppress both line and column numbers on output- --no-column Suppress the column number on output- --count Print only a count of matching lines per file- --filename-only Print only the name of files containing matches- --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- --editor Run the editor specified by EDITOR var., passing- the files that match- --vim Run vim the editor passing the files that match-+ --show-match Show list of matching tokens+ --color Use colors to highlight the match strings+ --no-color Do not use colors (override config file)+ -h --no-filename Suppress the file name prefix on output+ --no-numbers Suppress both line and column numbers on output+ --no-column Suppress the column number on output+ --count Print only a count of matching lines per file+ --filename-only Print only the name of files containing matches+ --json Format output as json object+ --vim Run vim editor passing the files that match+ --editor Run the editor specified by EDITOR var., passing+ the files that match+ --fileline When edit option is specified, pass the list of+ matching files in file:line format (e.g. vim+ 'file-line' plugin) Concurrency:-- -j --jobs=INT Number of jobs- --cores=INT Number of physical processors utilized- --chunk=INT Specify the length of chunks- -a --asynch Process chunks asynchronously-+ -j --threads=INT Number threads to run in parallel Miscellaneous:-- -d --debug=INT Debug level: 1, 2 or 3- --no-shallow Disable shallow-search - -? --help Display help message- -V --version Print version information- --numeric-version Print just the version number+ --verbose=INT Verbose level: 1, 2 or 3+ --no-shallow Disable shallow-search+ --palette Show color palette+ -? --help Display help message+ -V --version Print version information+ --numeric-version Print just the version number+```
cgrep.cabal view
@@ -1,69 +1,107 @@+Cabal-version: 2.2 Name: cgrep Description: Cgrep: a context-aware grep for source codes-Version: 6.6.32 +Version: 8.0.0 Synopsis: Command line tool Homepage: http://awgn.github.io/cgrep/-License: GPL-2+License: GPL-2.0-or-later License-file: LICENSE Author: Nicola Bonelli-Maintainer: Nicola Bonelli <nicola@pfq.io>+Maintainer: Nicola Bonelli <nicola@larthia.com> Category: Utils-Build-type: Simple +Build-type: Simple Stability: Experimental Extra-source-files: README.md-Cabal-version: >=1.10 +Common common-options+ build-depends: base ^>= 4.15.0.0++ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ if impl(ghc >= 8.0)+ ghc-options: -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies++ default-language: Haskell2010+ 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 - Reader - CGrep.Lang - CGrep.Filter - CGrep.Token - CGrep.Types - CGrep.CGrep - CGrep.Output - CGrep.Distance - CGrep.Common - CGrep.Context - CGrep.Parser.WildCard - CGrep.Parser.Generic.Token - CGrep.Parser.Token - CGrep.Parser.Cpp.Token - CGrep.Strategy.Generic.Semantic - CGrep.Strategy.Levenshtein - CGrep.Strategy.BoyerMoore - CGrep.Strategy.Cpp.Tokenizer - CGrep.Strategy.Cpp.Semantic + Default-Extensions: FlexibleContexts+ FlexibleInstances+ GeneralisedNewtypeDeriving+ DerivingStrategies+ MultiWayIf+ LambdaCase+ OverloadedLists+ OverloadedRecordDot+ OverloadedStrings+ PatternSynonyms+ RecordWildCards+ ScopedTypeVariables+ TupleSections+ TypeApplications+ UnboxedSums+ UnboxedTuples+ ViewPatterns+ BangPatterns+ MagicHash++ Other-Modules: Options+ Verbose+ CmdOptions+ Util+ Config+ Reader+ Search+ CGrep.FileType+ CGrep.FileKind+ CGrep.FileTypeMap+ CGrep.ContextFilter+ CGrep.Types+ CGrep.Output+ CGrep.Distance+ CGrep.Search+ CGrep.Common+ CGrep.Boundary+ CGrep.Parser.Char+ CGrep.Parser.Chunk+ CGrep.Parser.Token+ CGrep.Parser.Atom+ CGrep.Parser.Line+ CGrep.Strategy.Semantic+ CGrep.Strategy.Tokenizer+ CGrep.Strategy.Levenshtein+ CGrep.Strategy.BoyerMoore CGrep.Strategy.Regex Paths_cgrep- Build-Depends: base < 5.0, - cmdargs, - bytestring, - directory, - filepath, - stm, - containers, - array, - ghc-prim, - dlist, - ansi-terminal, - split, - safe, - stringsearch, - unordered-containers, + Autogen-modules: Paths_cgrep++ Build-Depends: base < 5.0,+ cmdargs,+ bytestring,+ directory,+ filepath,+ stm,+ containers,+ vector,+ array,+ ghc-prim,+ dlist,+ ansi-terminal,+ split,+ safe,+ stringsearch,+ unordered-containers, regex-base, regex-posix, regex-pcre,@@ -78,6 +116,24 @@ aeson, yaml, exceptions,+ mono-traversable,+ bytestring-strict-builder,+ bitwise,+ mmap,+ unagi-chan,+ posix-paths,+ rawfilepath,+ monad-loops,+ deepseq,+ bitarray,+ text, extra- Ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N++ Ghc-options: -O2 -optc-O3 + -funbox-strict-fields+ -fwrite-ide-info+ -hiedir=.hie+ -threaded+ -rtsopts "-with-rtsopts=-N -H1g -qn2"+ Default-language: Haskell2010
+ src/CGrep/Boundary.hs view
@@ -0,0 +1,46 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Boundary (+ Boundary(..)+ , BoundaryType(..)+ , pattern Begin+ , pattern End) where++import qualified Data.ByteString.Char8 as C+import Data.Word ( Word8 )++data Boundary = Boundary {+ bBegin :: C.ByteString+ , bEnd :: C.ByteString+} deriving stock (Show, Eq)+++newtype BoundaryType = BoundaryType { unpackBoundaryType :: Word8 }+ deriving newtype (Eq, Ord)++instance Show BoundaryType where+ show Begin = "begin"+ show End = "end"++pattern Begin :: BoundaryType+pattern Begin = BoundaryType 0+pattern End :: BoundaryType+pattern End = BoundaryType 1++{-# COMPLETE Begin, End #-}
− src/CGrep/CGrep.hs
@@ -1,99 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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 RecordWildCards #-}--module CGrep.CGrep ( sanitizeOptions- , runCgrep- , isRegexp) 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 Control.Monad.Trans.Reader-import Control.Monad.Catch-import Control.Monad.IO.Class--import System.IO--import CGrep.Lang-import CGrep.Common-import CGrep.Output--import Data.List-import Data.Maybe-import Options-import Reader-import Config--hasLanguage :: FilePath -> Options -> [Lang] -> Bool-hasLanguage path opt xs = isJust $ getFileLang 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- }---hasTokenizerOpt :: Options -> Bool-hasTokenizerOpt Options{..} =- identifier ||- keyword ||- directive ||- header ||- number ||- string ||- char ||- oper---isRegexp :: Options -> Bool-isRegexp opt = regex_posix opt || regex_pcre opt--runCgrep :: Config -> Options -> FilePath -> [Text8] -> OptionT IO [Output]-runCgrep conf opts filename patterns =- catch ( do- opt <- reader snd- case () of- _ | (not . isRegexp) opt && not (hasTokenizerOpt opt) && not (semantic opt) && edit_dist opt -> Levenshtein.search filename patterns- | (not . isRegexp) opt && not (hasTokenizerOpt opt) && not (semantic opt) -> BoyerMoore.search filename patterns- | (not . isRegexp) opt && semantic opt && hasLanguage filename opt [C,Cpp] -> CppSemantic.search filename patterns- | (not . isRegexp) opt && semantic opt -> Semantic.search filename patterns- | (not . isRegexp) opt -> CppTokenizer.search filename patterns- | isRegexp opt -> Regex.search filename patterns- | otherwise -> undefined- )- (\e -> let msg = show (e :: SomeException) in- liftIO $ do- hPutStrLn stderr $ showFileName conf opts filename ++ ": exception: " ++ takeN 80 msg- return [ ]- )-
src/CGrep/Common.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -19,72 +19,78 @@ module CGrep.Common ( Text8 , getTargetName , getTargetContents- , shallowSearch- , runSearch , expandMultiline , ignoreCase+ , subText , trim , trim8 , takeN) where -import qualified Data.ByteString.Char8 as C-import qualified Data.ByteString.Search as SC+import Data.Char (toLower)+import CGrep.Parser.Char (isSpace)+import CGrep.Types ( Offset, Text8 ) -import Data.Char+import Options+ ( Options(Options, no_shallow, multiline, ignore_case) ) -import CGrep.Types-import CGrep.Output+import Util ( spanGroup )+import Data.Int (Int64)+import System.IO.MMap ( mmapFileByteString ) -import Options-import Reader-import Util+import System.Posix.FilePath ( RawFilePath )+import qualified Data.Vector.Unboxed as UV+import Data.List (groupBy, group, sortOn, sort) +import GHC.Exts ( groupWith ) +import qualified Data.ByteString.Char8 as C+ takeN :: Int -> String -> String-takeN n xs | length xs > n = take n xs ++ "..."+takeN n xs | length xs > n = take n xs <> "..." | otherwise = xs+{-# INLINE takeN #-} trim :: String -> String trim = (dropWhile isSpace . reverse) . dropWhile isSpace . reverse-+{-# INLINE trim #-} trim8 :: Text8 -> Text8 trim8 = (C.dropWhile isSpace . C.reverse) . C.dropWhile isSpace . C.reverse+{-# INLINE trim8 #-} -getTargetName :: FilePath -> String-getTargetName [] = "<STDIN>"+getTargetName :: RawFilePath -> RawFilePath+getTargetName (C.null -> True )= "<STDIN>" getTargetName name = name---getTargetContents :: FilePath -> IO Text8-getTargetContents [] = C.getContents-getTargetContents xs = C.readFile xs---shallowSearch :: [Text8] -> Text8 -> [[Int]]-shallowSearch ps text = ps >>= (\p -> [p `SC.nonOverlappingIndices` text])+{-# INLINE getTargetName #-} -runSearch :: Options- -> FilePath- -> Bool- -> OptionT IO [Output]- -> OptionT IO [Output]-runSearch opt filename shallowTest doSearch =- if shallowTest || no_shallow opt- then doSearch- else mkOutput filename C.empty C.empty []+getTargetContents :: RawFilePath -> IO Text8+getTargetContents (C.null -> True) = C.getContents+getTargetContents xs = mmapFileByteString (C.unpack xs) Nothing+{-# INLINE getTargetContents #-} expandMultiline :: Options -> Text8 -> Text8 expandMultiline Options { multiline = n } xs | n == 1 = xs | otherwise = C.unlines $ map C.unwords $ spanGroup n (C.lines xs)+{-# INLINE expandMultiline #-} ignoreCase :: Options -> Text8 -> Text8 ignoreCase opt- | ignore_case opt = C.map toLowercase+ | ignore_case opt = C.map toLower | otherwise = id+{-# INLINE ignoreCase #-}+++subText :: [[Offset]] -> Text8 -> Text8+subText [] txt = txt+subText indices txt = case C.elemIndex '\n' (C.drop maxOff txt) of+ Nothing -> txt+ (Just n) -> C.take (maxOff + n) txt+ where maxOff = fromIntegral $ maximum (lastDef 0 <$> indices)+ lastDef def xs = if null xs then def else last xs+{-# INLINE subText #-}
− src/CGrep/Context.hs
@@ -1,31 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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- { getFilterCode :: !Bool- , getFilterComment :: !Bool- , getFilterLiteral :: !Bool- } deriving (Eq, Show)-
+ src/CGrep/ContextFilter.hs view
@@ -0,0 +1,309 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.ContextFilter where++import CGrep.Types ( Text8 )+import CGrep.Parser.Char ( chr, isSpace, ord )++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Short as B++import qualified Data.Map as Map++import Options ( Options(..) )+import Data.List (findIndex, nub, find)+import Data.Maybe (fromMaybe, isJust)+import qualified Data.Aeson.KeyMap as B+import CGrep.Boundary ( Boundary(..) )++import Data.Int ( Int32, Int64 )+import Data.Bits ( Bits((.|.), complement, (.&.), xor, shiftL, shiftR) )++import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as UV++import Data.HashMap.Internal.Strict (alter)+import Data.Word (Word64)+import qualified Data.ByteString.Unsafe as U++import Util ( findWithIndex )++type FilterFunction = ContextFilter -> Text8 -> Text8++data Context = Code | Comment | Literal+ deriving stock (Eq, Show)++newtype ContextBit = ContextBit Int32+ deriving stock (Show)+ deriving newtype (Eq, Bits)+++contextBitEmpty :: ContextBit+contextBitEmpty = ContextBit 0+contextBitCode :: ContextBit+contextBitCode = ContextBit 0x1+contextBitComment :: ContextBit+contextBitComment = ContextBit 0x2+contextBitLiteral :: ContextBit+contextBitLiteral = ContextBit 0x4+++(~=) :: ContextBit -> Bool -> ContextBit+b ~= True = b+_ ~= False = contextBitEmpty+{-# INLINE (~=) #-}+++(~?) :: ContextFilter -> ContextBit -> Bool+f ~? b = (unFilter f .&. b) /= contextBitEmpty+{-# INLINE (~?) #-}++(~!) :: ContextFilter -> ContextBit -> ContextFilter+a ~! b = ContextFilter $ unFilter a .&. complement b+{-# INLINE (~!) #-}+++newtype ContextFilter = ContextFilter { unFilter :: ContextBit }+ deriving stock (Show)+ deriving newtype (Eq, Bits)++contextFilterAll :: ContextFilter+contextFilterAll = ContextFilter (contextBitCode .|. contextBitComment .|. contextBitLiteral)+{-# NOINLINE contextFilterAll #-}++isContextFilterAll :: ContextFilter -> Bool+isContextFilterAll f = f == contextFilterAll+{-# INLINE isContextFilterAll #-}++codeFilter :: ContextFilter -> Bool+codeFilter f = (unFilter f .&. contextBitCode) /= contextBitEmpty+{-# INLINE codeFilter #-}++commentFilter :: ContextFilter -> Bool+commentFilter f = (unFilter f .&. contextBitComment) /= contextBitEmpty+{-# INLINE commentFilter #-}++literalFilter :: ContextFilter -> Bool+literalFilter f = (unFilter f .&. contextBitLiteral) /= contextBitEmpty+{-# INLINE literalFilter #-}+++data ParConfig = ParConfig+ { commBound :: [Boundary]+ , litrBound :: [Boundary]+ , rawBound :: [Boundary]+ , chrBound :: [Boundary]+ , inits :: B.ShortByteString+ , alterBoundary :: Bool+ }+++mkParConfig :: [Boundary] -> [Boundary] -> [Boundary] -> [Boundary] -> Bool -> ParConfig+mkParConfig cs ls rs chs ab =+ ParConfig {+ commBound = cs+ , litrBound = ls+ , rawBound = rs+ , chrBound = chs+ , inits = (B.pack . nub) ((fromIntegral . ord . C.head . bBegin <$> cs) <>+ (fromIntegral . ord . C.head . bBegin <$> ls) <>+ (fromIntegral . ord . C.head . bBegin <$> rs) <>+ (fromIntegral . ord . C.head . bBegin <$> chs))+ , alterBoundary = ab }++data ParState = ParState+ { ctxState :: !ContextState+ , nextState :: !ContextState+ , display :: !Bool+ , skip :: {-# UNPACK #-} !Int+ } deriving stock (Show)+++data ContextState =+ CodeState1 | CodeStateN |+ CommState1 {-# UNPACK #-} !Int |+ CommStateN {-# UNPACK #-} !Int |+ ChrState {-# UNPACK #-} !Int |+ LitrState1 {-# UNPACK #-} !Int |+ LitrStateN {-# UNPACK #-} !Int |+ RawState {-# UNPACK #-} !Int+ deriving stock (Show, Eq, Ord)+++mkContextFilter :: Options -> ContextFilter+mkContextFilter Options{..} =+ if not (code || comment || literal)+ then contextFilterAll+ else ContextFilter $ contextBitCode ~= code .|. contextBitComment ~= comment .|. contextBitLiteral ~= literal+++unpackBoundary :: Boundary -> (String, String)+unpackBoundary (Boundary a b) = (C.unpack a, C.unpack b)+{-# INLINE unpackBoundary #-}+++getContext :: ContextState -> Context+getContext CodeState1 = Code+getContext CodeStateN = Code+getContext (CommState1 _ ) = Comment+getContext (CommStateN _ ) = Comment+getContext (LitrState1 _) = Literal+getContext (LitrStateN _) = Literal+getContext (RawState _) = Literal+getContext (ChrState _) = Literal+{-# INLINE getContext #-}++-- contextFilterFun:+--++data ParData = ParData {+ pdText :: {-# UNPACK #-}!Text8,+ pdState :: !ParState+}++runContextFilter :: ParConfig -> ContextFilter -> Text8 -> Text8+runContextFilter conf@ParConfig{..} f txt | alterBoundary = fst $ C.unfoldrN (C.length txt) (contextFilter' conf) (ParData txt (ParState CodeState1 CodeState1 (codeFilter f) 0))+ | otherwise = fst $ C.unfoldrN (C.length txt) (contextFilter'' conf) (ParData txt (ParState CodeState1 CodeState1 (codeFilter f) 0))+ where contextFilter' :: ParConfig -> ParData -> Maybe (Char, ParData)+ contextFilter' c (ParData txt@(C.uncons -> Just (x,xs)) s) =+ let !s' = nextContextState c s txt f+ in if display s'+ then case (# getContext (ctxState s), getContext (ctxState s') #) of+ (# Code, Literal #) -> Just (chr 2, ParData xs s')+ (# Literal, Code #) -> Just (chr 3, ParData xs s')+ _ -> Just (x, ParData xs s')+ else if isSpace x+ then Just (x, ParData xs s')+ else Just (' ', ParData xs s')++ contextFilter' _ (ParData (C.uncons -> Nothing) _) = Nothing++ contextFilter'' :: ParConfig -> ParData -> Maybe (Char, ParData)+ contextFilter'' c (ParData txt@(C.uncons -> Just (x,xs)) s) =+ let !s' = nextContextState c s txt f+ in if display s' || isSpace x+ then Just (x, ParData xs s')+ else Just (' ', ParData xs s')+++{-# INLINE nextContextState #-}+nextContextState :: ParConfig -> ParState -> Text8 -> ContextFilter -> ParState+nextContextState c s@ParState{..} txt f+ | skip > 0 = {-# SCC skip #-} transState s{ skip = skip - 1 }++ | CodeState1 <- ctxState = {-# SCC next_code1 #-} if U.unsafeHead txt `B.elem` inits c+ then case findPrefixBoundary txt (commBound c) of+ (# i, Just b #) -> {-# SCC next_code1_1 #-} transState s{ nextState = CommState1 i, display = commentFilter f, skip = C.length (bBegin b) - 1 }+ _ -> case findPrefixBoundary txt (litrBound c) of+ (# i, Just b #) -> {-# SCC next_code1_2 #-} transState s{ nextState = LitrState1 i, display = codeFilter f, skip = C.length (bBegin b) - 1 }+ _ -> case findPrefixBoundary txt (rawBound c) of+ (# i, Just b #) -> {-# SCC next_code1_3 #-} transState s{ nextState = RawState i, display = codeFilter f, skip = C.length (bBegin b) - 1 }+ _ -> case findPrefixBoundary' txt (chrBound c) of+ (# i, Just b #) -> transState s{ nextState = ChrState i, display = codeFilter f, skip = C.length (bBegin b) - 1 }+ _ -> {-# SCC next_code1_5 #-} s{ ctxState = CodeStateN, nextState = CodeStateN, display = codeFilter f, skip = 0 }+ else {-# SCC next_code1_0 #-} s{ ctxState = CodeStateN, nextState = CodeStateN, display = codeFilter f, skip = 0 }++ | CodeStateN <- ctxState = {-# SCC next_code #-} if {-# SCC next_code_if #-} U.unsafeHead txt `B.elem` inits c+ then {-# SCC next_code_then #-} case findPrefixBoundary txt (commBound c) of+ (#i , Just b #) -> {-# SCC next_code1_1 #-} transState s{ nextState = CommState1 i, display = commentFilter f, skip = C.length (bBegin b) - 1 }+ _ -> case findPrefixBoundary txt (litrBound c) of+ (#i, Just b #) -> {-# SCC next_code1_2 #-} transState s{ nextState = LitrState1 i, display = codeFilter f, skip = C.length (bBegin b) - 1 }+ _ -> case findPrefixBoundary txt (rawBound c) of+ (# i, Just b #) -> {-# SCC next_code1_3 #-} transState s{ nextState = RawState i, display = codeFilter f, skip = C.length (bBegin b) - 1 }+ _ -> case findPrefixBoundary' txt (chrBound c) of+ (# i, Just b #) -> transState s{ nextState = ChrState i, display = codeFilter f, skip = C.length (bBegin b) - 1 }+ _ -> {-# SCC next_code_5 #-} s+ else {-# SCC next_code_else #-} s++ | CommState1 n <- ctxState =+ let Boundary _ e = commBound c !! n+ in {-# SCC next_comm1 #-} if e `C.isPrefixOf` txt+ then transState $ s{ nextState = CodeState1, display = commentFilter f, skip = C.length e - 1}+ else s{ ctxState = CommStateN n, nextState = CommStateN n, display = commentFilter f, skip = 0 }++ | CommStateN n <- ctxState =+ let Boundary _ e = commBound c !! n+ in {-# SCC next_comm #-} if e `C.isPrefixOf` txt+ then transState $ s{ nextState = CodeState1, display = commentFilter f, skip = C.length e - 1}+ else s++ | LitrState1 n <- ctxState =+ if C.head txt == '\\'+ then s { display = displayContext ctxState f, skip = 1 }+ else let Boundary _ e = litrBound c !! n+ in {-# SCC next_liter #-} if e `C.isPrefixOf` txt+ then s{ ctxState = CodeState1, nextState = CodeState1, display = codeFilter f, skip = C.length e - 1}+ else s{ ctxState = LitrStateN n, nextState = LitrStateN n, display = literalFilter f, skip = 0 }++ | LitrStateN n <- ctxState =+ if C.head txt == '\\'+ then s { display = displayContext ctxState f, skip = 1 }+ else let Boundary _ e = litrBound c !! n+ in {-# SCC next_liter #-} if e `C.isPrefixOf` txt+ then s{ ctxState = CodeState1, nextState = CodeState1, display = codeFilter f, skip = C.length e - 1}+ else s++ | ChrState n <- ctxState =+ if C.head txt == '\\'+ then s { display = displayContext ctxState f, skip = 1 }+ else let Boundary _ e = chrBound c !! n+ in {-# SCC next_chr #-} if e `C.isPrefixOf` txt+ then s{ ctxState = CodeState1, nextState = CodeState1, display = codeFilter f, skip = C.length e - 1}+ else s{ display = literalFilter f , skip = 0}++ | RawState n <- ctxState =+ let Boundary _ e = rawBound c !! n+ in {-# SCC next_raw #-} if e `C.isPrefixOf` txt+ then s{ ctxState = CodeState1, nextState = CodeState1, display = codeFilter f, skip = C.length e - 1}+ else s{ display = literalFilter f , skip = 0}+++displayContext :: ContextState -> ContextFilter -> Bool+displayContext CodeState1 cf = cf ~? contextBitCode+displayContext CodeStateN cf = cf ~? contextBitCode+displayContext (CommState1 _) cf = cf ~? contextBitComment+displayContext (CommStateN _) cf = cf ~? contextBitComment+displayContext (LitrState1 _) cf = cf ~? contextBitLiteral+displayContext (LitrStateN _) cf = cf ~? contextBitLiteral+displayContext (RawState _) cf = cf ~? contextBitLiteral+displayContext (ChrState _) cf = cf ~? contextBitLiteral+{-# INLINE displayContext #-}+++transState :: ParState -> ParState+transState s@ParState {..} | skip == 0 = s{ ctxState = nextState }+ | otherwise = s+{-# INLINE transState #-}+++findPrefixBoundary :: Text8 -> [Boundary] -> (# Int, Maybe Boundary #)+findPrefixBoundary xs vb = {-# SCC findPrefixBoundary #-}+ findWithIndex (\(Boundary b _ ) -> b `C.isPrefixOf` xs) vb+{-# INLINE findPrefixBoundary #-}+++findPrefixBoundary' :: Text8 -> [Boundary] -> (# Int, Maybe Boundary #)+findPrefixBoundary' txt bs =+ case findWithIndex (\(Boundary beg _ ) -> beg `C.isPrefixOf` txt) bs of+ elm@(# idx, Just b@(Boundary _ end) #) -> case C.tail txt of+ (C.uncons -> Just (y , ys)) ->+ let skip = if y == '\\' then 1 else 0+ in if end `C.isPrefixOf` C.drop skip ys then elm else (#0, Nothing #)+ _ -> (# 0, Nothing #)+ _ -> (# 0, Nothing #)
src/CGrep/Distance.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,7 +16,6 @@ -- 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@@ -50,4 +49,4 @@ | otherwise = dist < (len * 40 `div` 100) where len = fromIntegral (length a `min` length b) dist = distance a b-+{-# INLINE (~==) #-}
+ src/CGrep/FileKind.hs view
@@ -0,0 +1,43 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.FileKind (+ FileKind(..)+) where+++data FileKind = KindText | KindConfig | KindLanguage | KindData | KindMarkup | KindScript+ deriving stock (Eq, Ord, Enum, Bounded)+++instance Show FileKind where+ show KindText = "Text"+ show KindConfig = "Config"+ show KindLanguage = "Language"+ show KindData = "Data"+ show KindMarkup = "Markup"+ show KindScript = "Script"++instance Read FileKind where+ readsPrec _ "Text" = [(KindText, "")]+ readsPrec _ "Config" = [(KindConfig, "")]+ readsPrec _ "Language" = [(KindLanguage, "")]+ readsPrec _ "Data" = [(KindData, "")]+ readsPrec _ "Markup" = [(KindMarkup, "")]+ readsPrec _ "Script" = [(KindScript, "")]+ readsPrec _ _ = []
+ src/CGrep/FileType.hs view
@@ -0,0 +1,64 @@+---+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.FileType (+ FileType(..)+ , FileSelector(..)+ , readTypeList+ , readKindList )+ where++import qualified Data.Map as Map+import Control.Monad ( forM_ )+import Control.Applicative ( Alternative((<|>)) )+import Data.Maybe ( fromJust )++import qualified Data.ByteString.Char8 as C+import Options ( Options(Options, type_force) )+import Util ( prettyRead )+import System.Posix.FilePath (RawFilePath)+import CGrep.FileKind ( FileKind )+++data FileType = Agda | Assembly | Awk | Bash | C | CMake | Cabal | Chapel | Clojure | Coffee | Conf | Cpp | Csh | Csharp | Css | Cql |+ D | Dart | Dhall | Elm | Elixir | Erlang | Fish | Fortran | Fsharp | Go | GoMod | Haskell | Html | Idris | Java | Javascript | Json | Julia | Kotlin |+ Ksh | Latex | Lisp | Lua | Make | Nim | Nmap | OCaml | ObjectiveC | PHP | Perl | Python | R | Ruby | Rust | Scala | SmallTalk | Swift | Sql | Tcl |+ Text | Unison | VHDL | Verilog | Yaml | Toml | Ini | Zig | Zsh+ deriving stock (Read, Show, Eq, Ord, Bounded)++data FileSelector = Name RawFilePath| Ext C.ByteString+ deriving stock (Eq, Ord)+++instance Show FileSelector where+ show (Name x) = C.unpack x+ show (Ext e) = "*." <> C.unpack e+++-- utility functions++readTypeList :: [String] -> ([FileType], [FileType], [FileType])+readTypeList = foldl run ([],[],[])+ where run :: ([FileType], [FileType], [FileType]) -> String -> ([FileType], [FileType], [FileType])+ run (l1, l2, l3) l+ | '+':xs <- l = (l1, prettyRead xs "Type" : l2, l3)+ | '-':xs <- l = (l1, l2, prettyRead xs "Type" : l3)+ | otherwise = (prettyRead l "Type" : l1, l2, l3)++readKindList :: [String] -> [FileKind]+readKindList = map (`prettyRead` "Kind")
+ src/CGrep/FileTypeMap.hs view
@@ -0,0 +1,4906 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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 TupleSections #-}++module CGrep.FileTypeMap (+ FileTypeInfo (..),+ FileTypeInfoMap (..),+ WordType (..),+ CharIdentifierF,+ fileTypeLookup,+ fileTypeInfoLookup,+ fileTypeInfoMap,+ dumpFileTypeInfoMap,+ contextFilter,+) where++import CGrep.ContextFilter (+ ContextFilter,+ FilterFunction,+ isContextFilterAll,+ mkParConfig,+ runContextFilter,+ )+import CGrep.FileType (FileSelector (..), FileType (..))++import CGrep.Types (Text8)+import Control.Applicative (Alternative ((<|>)))+import Control.Monad (forM_)+import qualified Data.ByteString.Char8 as C+import qualified Data.Map as Map+import Data.Maybe (fromJust, isJust)+import Options (Options (Options, keyword, type_force))++import qualified Data.Array.BitArray as BA++import Data.List (findIndex)+import qualified Data.Set as S++import CGrep.Boundary (Boundary (Boundary))+import CGrep.Parser.Char (+ isAlphaNum_,+ isAlphaNum_',+ isAlphaNum_and,+ isAlpha_,+ isAlpha_',+ isAlpha_and,+ )+import CGrep.Parser.Char (isAlpha, isAlphaNum)++import System.Posix.FilePath (RawFilePath, takeBaseName, takeExtension, takeFileName)++import Data.Aeson (Value (Bool, String))+import Data.Bits (Bits (isSigned))+import qualified Data.HashMap.Strict as HM+import Data.MonoTraversable (WrappedPoly)+import GHC.Conc (BlockReason (BlockedOnBlackHole))+import CGrep.FileKind++newtype FileTypeInfoMap = FileTypeInfoMap {+ unMapInfo :: Map.Map FileType FileTypeInfo+}++newtype FileTypeMap = FileTypeMap {+ unMap :: Map.Map FileSelector (FileType, FileKind)+}++type CharIdentifierF = (Char -> Bool)++data WordType = Keyword | NativeType+ deriving stock (Eq, Ord, Show)++data FileTypeInfo = FileTypeInfo+ { ftSelector :: [FileSelector]+ , ftKind :: FileKind+ , ftChar :: [Boundary]+ , ftString :: [Boundary]+ , ftRawString :: [Boundary]+ , ftComment :: [Boundary]+ , ftIdentifierChars :: Maybe (CharIdentifierF, CharIdentifierF)+ , ftKeywords :: HM.HashMap C.ByteString WordType+ }++fileTypeInfoMap :: FileTypeInfoMap+fileTypeInfoMap = FileTypeInfoMap $+ Map.fromList+ [+ ( Agda+ , FileTypeInfo+ { ftSelector = [Ext "agda", Ext "lagda"]+ , ftKind = KindLanguage+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "abstract"+ , "codata"+ , "constructor"+ , "data"+ , "eta-equality"+ , "field"+ , "forall"+ , "hiding"+ , "import"+ , "in"+ , "inductive"+ , "infix"+ , "infixl"+ , "infixr"+ , "instance"+ , "let"+ , "module"+ , "mutual"+ , "no-eta-equality"+ , "open"+ , "pattern"+ , "postulate"+ , "primitive"+ , "private"+ , "public"+ , "quoteContext"+ , "quoteGoal"+ , "record"+ , "renaming"+ , "rewrite"+ , "Set"+ , "syntax"+ , "tactic"+ , "using"+ , "where"+ , "with"+ ]+ }+ )+ ,+ ( Assembly+ , FileTypeInfo+ { ftSelector = [Ext "s", Ext "S"]+ , ftKind = KindLanguage+ , ftComment = ["#" ~~ "\n", ";" ~~ "\n", "|" ~~ "\n", "!" ~~ "\n", "/*" ~~ "*/"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Awk+ , FileTypeInfo+ { ftSelector = [Ext "awk", Ext "mawk", Ext "gawk"]+ , ftKind = KindScript+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "BEGIN"+ , "END"+ , "if"+ , "else"+ , "while"+ , "do"+ , "for"+ , "in"+ , "break"+ , "continue"+ , "delete"+ , "next"+ , "nextfile"+ , "function"+ , "func"+ , "exit"+ ]+ }+ )+ ,+ ( Bash+ , FileTypeInfo+ { ftSelector = [Ext "sh", Ext "bash"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "if"+ , "then"+ , "elif"+ , "else"+ , "fi"+ , "time"+ , "for"+ , "in"+ , "until"+ , "while"+ , "do"+ , "done"+ , "case"+ , "esac"+ , "coproc"+ , "select"+ , "function"+ ]+ }+ )+ ,+ ( C+ , FileTypeInfo+ { ftSelector = [Ext "c", Ext "C", Ext "inc"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["R\"" ~~ "\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "int"+ , "short"+ , "long"+ , "float"+ , "double"+ , "char"+ , "bool"+ , "int8_t"+ , "int16_t"+ , "int32_t"+ , "int64_t"+ , "int_fast8_t"+ , "int_fast16_t"+ , "int_fast32_t"+ , "int_fast64_t"+ , "int_least8_t"+ , "int_least16_t"+ , "int_least32_t"+ , "int_least64_t"+ , "intmax_t"+ , "intptr_t"+ , "uint8_t"+ , "uint16_t"+ , "uint32_t"+ , "uint64_t"+ , "uint_fast8_t"+ , "uint_fast16_t"+ , "uint_fast32_t"+ , "uint_fast64_t"+ , "uint_least8_t"+ , "uint_least16_t"+ , "uint_least32_t"+ , "uint_least64_t"+ , "uintmax_t"+ , "uintptr_t"+ ]+ <> reserved+ [ "auto"+ , "break"+ , "case"+ , "const"+ , "continue"+ , "default"+ , "do"+ , "else"+ , "enum"+ , "extern"+ , "for"+ , "goto"+ , "if"+ , "inline"+ , "register"+ , "restrict"+ , "return"+ , "signed"+ , "sizeof"+ , "static"+ , "struct"+ , "switch"+ , "typedef"+ , "union"+ , "unsigned"+ , "void"+ , "volatile"+ , "while"+ , "_Alignas"+ , "_Alignof"+ , "_Atomic"+ , "_Bool"+ , "_Complex"+ , "_Decimal128"+ , "_Decimal32"+ , "_Decimal64"+ , "_Generic"+ , "_Imaginary"+ , "_Noreturn"+ , "_Static_assert"+ , "_Thread_local"+ , "if"+ , "elif"+ , "else"+ , "endif"+ , "ifdef"+ , "ifndef"+ , "define"+ , "undef"+ , "include"+ , "line"+ , "error"+ , "pragma"+ , "defined"+ , "__has_c_attribute"+ , "_Pragma"+ , "asm"+ , "fortran"+ ]+ }+ )+ ,+ ( CMake+ , FileTypeInfo+ { ftSelector = [Name "CMakeLists.txt", Ext "cmake"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Cabal+ , FileTypeInfo+ { ftSelector = [Ext "cabal"]+ , ftKind = KindConfig+ , ftComment = ["--" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Chapel+ , FileTypeInfo+ { ftSelector = [Ext "chpl"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = ["\"\"\"" ~~ "\"\"\"", "'''" ~~ "'''"]+ , ftIdentifierChars = Just (isAlpha_, isAlphaNum_and "$")+ , ftKeywords =+ types+ [ "void"+ , "nothing"+ , "bool"+ , "int"+ , "uint"+ , "real"+ , "imag"+ , "complex"+ , "string"+ , "bytes"+ ]+ <> reserved+ [ "align"+ , "as"+ , "atomic"+ , "begin"+ , "bool"+ , "borrowed"+ , "break"+ , "by"+ , "catch"+ , "class"+ , "cobegin"+ , "coforall"+ , "config"+ , "const"+ , "continue"+ , "defer"+ , "delete"+ , "dmapped"+ , "do"+ , "domain"+ , "else"+ , "enum"+ , "except"+ , "export"+ , "extern"+ , "false"+ , "for"+ , "forall"+ , "forwarding"+ , "if"+ , "in"+ , "index"+ , "inline"+ , "inout"+ , "iter"+ , "label"+ , "let"+ , "lifetime"+ , "local"+ , "locale"+ , "module"+ , "new"+ , "nil"+ , "noinit"+ , "on"+ , "only"+ , "otherwise"+ , "out"+ , "override"+ , "owned"+ , "param"+ , "private"+ , "prototype"+ , "proc"+ , "public"+ , "record"+ , "reduce"+ , "ref"+ , "require"+ , "return"+ , "scan"+ , "select"+ , "serial"+ , "shared"+ , "single"+ , "sparse"+ , "subdomain"+ , "sync"+ , "then"+ , "this"+ , "throw"+ , "throws"+ , "true"+ , "try"+ , "type"+ , "union"+ , "unmanaged"+ , "use"+ , "var"+ , "when"+ , "where"+ , "while"+ , "with"+ , "yield"+ , "zip"+ ]+ }+ )+ ,+ ( Clojure+ , FileTypeInfo+ { ftSelector = [Ext "clj", Ext "cljs", Ext "cljc", Ext "edn"]+ , ftKind = KindLanguage+ , ftComment = [";" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha, isAlphaNum_and "*+!-_?")+ , ftKeywords =+ types+ [ "nil"+ , "boolean"+ , "char"+ , "byte"+ , "short"+ , "int"+ , "long"+ , "float"+ , "double"+ ]+ <> reserved+ [ "and"+ , "let"+ , "def"+ , "defn"+ , "if"+ , "else"+ , "do"+ , "quote"+ , "var"+ , "fn"+ , "loop"+ , "recur"+ , "throw"+ , "try"+ , "monitor-enter"+ , "monitor-exit"+ ]+ }+ )+ ,+ ( Coffee+ , FileTypeInfo+ { ftSelector = [Ext "coffee"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n", "###" ~~ "###"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = ["'''" ~~ "'''", "\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Just (isAlpha_and "$", isAlphaNum_and "$")+ , ftKeywords =+ reserved+ [ "case"+ , "default"+ , "function"+ , "var"+ , "void"+ , "with"+ , "const"+ , "let"+ , "enum"+ , "export"+ , "import"+ , "native"+ , "__hasProp"+ , "__extends"+ , "__slice"+ , "__bind"+ , "__indexOf"+ , "implements"+ , "interface"+ , "package"+ , "private"+ , "protected"+ , "public"+ , "static"+ , "yield"+ , "true"+ , "false"+ , "null"+ , "this"+ , "new"+ , "delete"+ , "typeof"+ , "in"+ , "arguments"+ , "eval"+ , "instanceof"+ , "return"+ , "throw"+ , "break"+ , "continue"+ , "debugger"+ , "if"+ , "else"+ , "switch"+ , "for"+ , "while"+ , "do"+ , "try"+ , "catch"+ , "finally"+ , "class"+ , "extends"+ , "super"+ , "undefined"+ , "then"+ , "unless"+ , "until"+ , "loop"+ , "of"+ , "by"+ , "when"+ , "and"+ , "or"+ , "is"+ , "isnt"+ , "not"+ , "yes"+ , "no"+ , "on"+ , "off"+ ]+ }+ )+ ,+ ( Conf+ , FileTypeInfo+ { ftSelector = [Ext "config", Ext "conf", Ext "cfg", Ext "doxy"]+ , ftKind = KindConfig+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Cpp+ , FileTypeInfo+ { ftSelector =+ [ Ext "cpp"+ , Ext "CPP"+ , Ext "cxx"+ , Ext "cc"+ , Ext "cp"+ , Ext "c++"+ , Ext "tcc"+ , Ext "h"+ , Ext "H"+ , Ext "hpp"+ , Ext "ipp"+ , Ext "HPP"+ , Ext "hxx"+ , Ext "hh"+ , Ext "hp"+ , Ext "h++"+ , Ext "cu"+ , Ext "cuh"+ ]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["R\"(" ~~ ")\"", "R\"-(" ~~ ")-\"", "R\"--(" ~~ ")--\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "int"+ , "short"+ , "long"+ , "float"+ , "double"+ , "char"+ , "bool"+ , "int8_t"+ , "int16_t"+ , "int32_t"+ , "int64_t"+ , "int_fast8_t"+ , "int_fast16_t"+ , "int_fast32_t"+ , "int_fast64_t"+ , "int_least8_t"+ , "int_least16_t"+ , "int_least32_t"+ , "int_least64_t"+ , "intmax_t"+ , "intptr_t"+ , "uint8_t"+ , "uint16_t"+ , "uint32_t"+ , "uint64_t"+ , "uint_fast8_t"+ , "uint_fast16_t"+ , "uint_fast32_t"+ , "uint_fast64_t"+ , "uint_least8_t"+ , "uint_least16_t"+ , "uint_least32_t"+ , "uint_least64_t"+ , "uintmax_t"+ , "uintptr_t"+ , "nullptr_t"+ ]+ <> reserved+ [ "alignas"+ , "alignof"+ , "and"+ , "and_eq"+ , "asm"+ , "atomic_cancel"+ , "atomic_commit"+ , "atomic_noexcept"+ , "auto"+ , "bitand"+ , "bitor"+ , "break"+ , "case"+ , "catch"+ , "class"+ , "compl"+ , "concept"+ , "const"+ , "consteval"+ , "constexpr"+ , "constinit"+ , "const_cast"+ , "continue"+ , "co_await"+ , "co_return"+ , "co_yield"+ , "decltype"+ , "default"+ , "delete"+ , "do"+ , "dynamic_cast"+ , "else"+ , "enum"+ , "explicit"+ , "export"+ , "extern"+ , "false"+ , "for"+ , "friend"+ , "goto"+ , "if"+ , "inline"+ , "mutable"+ , "namespace"+ , "new"+ , "noexcept"+ , "not"+ , "not_eq"+ , "nullptr"+ , "operator"+ , "or"+ , "or_eq"+ , "private"+ , "protected"+ , "public"+ , "reflexpr"+ , "register"+ , "reinterpret_cast"+ , "requires"+ , "return"+ , "signed"+ , "sizeof"+ , "static"+ , "static_assert"+ , "static_cast"+ , "struct"+ , "switch"+ , "synchronized"+ , "template"+ , "this"+ , "thread_local"+ , "throw"+ , "true"+ , "try"+ , "typedef"+ , "typeid"+ , "typename"+ , "union"+ , "unsigned"+ , "using"+ , "virtual"+ , "void"+ , "volatile"+ , "wchar_t"+ , "while"+ , "xor"+ , "xor_eq"+ , "final"+ , "override"+ , "transaction_safe"+ , "transaction_safe_dynamic"+ , "import"+ , "module"+ , "elif"+ , "endif"+ , "ifdef"+ , "ifndef"+ , "define"+ , "undef"+ , "include"+ , "line"+ , "error"+ , "pragma"+ , "defined"+ , "__has_include"+ , "__has_cpp_attribute"+ , "export"+ , "import"+ , "module"+ ]+ }+ )+ ,+ ( Csharp+ , FileTypeInfo+ { ftSelector = [Ext "cs", Ext "CS"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "bool"+ , "byte"+ , "sbyte"+ , "char"+ , "decimal"+ , "double"+ , "float"+ , "int"+ , "uint"+ , "nint"+ , "nuint"+ , "long"+ , "ulong"+ , "short"+ , "ushort"+ ]+ <> reserved+ [ "abstract"+ , "as"+ , "base"+ , "break"+ , "case"+ , "catch"+ , "checked"+ , "class"+ , "const"+ , "continue"+ , "default"+ , "delegate"+ , "do"+ , "else"+ , "enum"+ , "event"+ , "explicit"+ , "extern"+ , "false"+ , "finally"+ , "fixed"+ , "for"+ , "foreach"+ , "goto"+ , "if"+ , "implicit"+ , "in"+ , "interface"+ , "internal"+ , "is"+ , "lock"+ , "namespace"+ , "new"+ , "null"+ , "object"+ , "operator"+ , "out"+ , "override"+ , "params"+ , "private"+ , "protected"+ , "public"+ , "readonly"+ , "ref"+ , "return"+ , "sealed"+ , "sizeof"+ , "stackalloc"+ , "static"+ , "string"+ , "struct"+ , "switch"+ , "this"+ , "throw"+ , "true"+ , "try"+ , "typeof"+ , "unchecked"+ , "unsafe"+ , "using"+ , "virtual"+ , "void"+ , "volatile"+ , "while"+ ]+ }+ )+ ,+ ( Csh+ , FileTypeInfo+ { ftSelector = [Ext "csh", Ext "tcsh"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "alias"+ , "alloc"+ , "bg"+ , "bindkey"+ , "break"+ , "breaksw"+ , "built-ins"+ , "bye"+ , "case"+ , "cd"+ , "chdir"+ , "complete"+ , "continue"+ , "default"+ , "dirs"+ , "echo"+ , "echotc"+ , "else"+ , "end"+ , "endif"+ , "endsw"+ , "eval"+ , "exec"+ , "exit"+ , "fg"+ , "filetest"+ , "foreach"+ , "glob"+ , "goto"+ , "hashstat"+ , "history"+ , "hup"+ , "if"+ , "jobs"+ , "kill"+ , "limit"+ , "log"+ , "login"+ , "logout"+ , "ls-F"+ , "newgrp"+ , "nice"+ , "nohup"+ , "notify"+ , "onintr"+ , "popd"+ , "printenv"+ , "pushd"+ , "rehash"+ , "repeat"+ , "sched"+ , "set"+ , "setenv"+ , "settc"+ , "setty"+ , "shift"+ , "source"+ , "stop"+ , "suspend"+ , "switch"+ , "telltc"+ , "time"+ , "umask"+ , "unalias"+ , "uncomplete"+ , "unhash"+ , "unlimit"+ , "unset"+ , "unsetenv"+ , "wait"+ , "watchlog"+ , "where"+ , "which"+ , "while"+ ]+ }+ )+ ,+ ( Css+ , FileTypeInfo+ { ftSelector = [Ext "css"]+ , ftKind = KindMarkup+ , ftComment = ["/*" ~~ "*/"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_and "-", isAlphaNum_and "-")+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Cql+ , FileTypeInfo+ { ftSelector = [Ext "cql"]+ , ftKind = KindLanguage+ , ftComment = ["--" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "ASCII"+ , "ADD"+ , "AGGREGATE"+ , "ALL"+ , "ALLOW"+ , "ALTER"+ , "AND"+ , "ANY"+ , "APPLY"+ , "AS"+ , "ASC"+ , "AUTHORIZE"+ , "BATCH"+ , "BEGIN"+ , "BIGINT"+ , "BY"+ , "CLUSTERING"+ , "COLUMNFAMILY"+ , "COMPACT"+ , "CONSISTENCY"+ , "COUNT"+ , "COUNTER"+ , "CREATE"+ , "CUSTOM"+ , "DATE"+ , "DECIMAL"+ , "DELETE"+ , "DESC"+ , "DISTINCT"+ , "DOUBLE"+ , "DROP"+ , "EACH_QUORUM"+ , "ENTRIES"+ , "EXISTS"+ , "FILTERING"+ , "FLOAT"+ , "FROM"+ , "FROZEN"+ , "FULL"+ , "GRANT"+ , "IF"+ , "IN"+ , "INDEX"+ , "INET"+ , "INFINITY"+ , "INSERT"+ , "INT"+ , "INTO"+ , "KEY"+ , "KEYSPACE"+ , "KEYSPACES"+ , "LEVEL"+ , "LIMIT"+ , "LIST"+ , "LOCAL_ONE"+ , "LOCAL_QUORUM"+ , "MAP"+ , "MATERIALIZED"+ , "MODIFY"+ , "NAN"+ , "OF"+ , "ON"+ , "ONE"+ , "ORDER"+ , "PARTITION"+ , "PASSWORD"+ , "PER"+ , "PERMISSION"+ , "PERMISSIONS"+ , "PRIMARY"+ , "QUORUM"+ , "RECURSIVE"+ , "RENAME"+ , "REVOKE"+ , "SCHEMA"+ , "SELECT"+ , "SET"+ , "SMALLINT"+ , "STATIC"+ , "STORAGE"+ , "SUPERUSER"+ , "T"+ , "TABLE"+ , "TEXT"+ , "THREE"+ , "TIME"+ , "TIMESTAMP"+ , "TIMEUUID"+ , "TINYINT"+ , "TO"+ , "TOKEN"+ , "TRUNCATE"+ , "TTL"+ , "TUPLE"+ , "TWO"+ , "TYPE"+ , "UNLOGGED"+ , "UPDATE"+ , "USE"+ , "USER"+ , "USERS"+ , "USING"+ , "UUID"+ , "VALUES"+ , "VARCHAR"+ , "VARINT"+ , "VIEW"+ , "WHERE"+ , "WITH"+ , "WRITETIME"+ ]+ }+ )+ ,+ ( D+ , FileTypeInfo+ { ftSelector = [Ext "d", Ext "D"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["r\"" ~~ "\"", "`" ~~ "`"]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "bool"+ , "byte"+ , "ubyte"+ , "short"+ , "ushort"+ , "int"+ , "uint"+ , "long"+ , "ulong"+ , "cent"+ , "ucent"+ , "char"+ , "wchar"+ , "dchar"+ , "float"+ , "double"+ , "real"+ , "ifloat"+ , "idouble"+ , "ireal"+ , "cfloat"+ , "cdouble"+ , "creal"+ , "void"+ ]+ <> reserved+ [ "abstract"+ , "alias"+ , "align"+ , "asm"+ , "assert"+ , "auto"+ , "body"+ , "break"+ , "case"+ , "cast"+ , "catch"+ , "class"+ , "const"+ , "continue"+ , "debug"+ , "default"+ , "delegate"+ , "delete"+ , "deprecated"+ , "do"+ , "else"+ , "enum"+ , "export"+ , "extern"+ , "false"+ , "final"+ , "finally"+ , "for"+ , "foreach"+ , "foreach_reverse"+ , "function"+ , "goto"+ , "if"+ , "immutable"+ , "import"+ , "in"+ , "inout"+ , "interface"+ , "invariant"+ , "is"+ , "lazy"+ , "macro"+ , "mixin"+ , "module"+ , "new"+ , "nothrow"+ , "null"+ , "out"+ , "override"+ , "package"+ , "pragma"+ , "private"+ , "protected"+ , "public"+ , "pure"+ , "ref"+ , "return"+ , "scope"+ , "shared"+ , "static"+ , "struct"+ , "super"+ , "switch"+ , "synchronized"+ , "template"+ , "this"+ , "throw"+ , "true"+ , "try"+ , "typeid"+ , "typeof"+ , "union"+ , "unittest"+ , "version"+ , "while"+ , "with"+ , "__FILE__"+ , "__FILE_FULL_PATH__"+ , "__MODULE__"+ , "__LINE__"+ , "__FUNCTION__"+ , "__PRETTY_FUNCTION__"+ , "__gshared"+ , "__traits"+ , "__vector"+ , "__parameters"+ ]+ }+ )+ ,+ ( Dart+ , FileTypeInfo+ { ftSelector = [Ext "dart"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = ["'''" ~~ "'''", "\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types ["int", "double", "num", "bool", "null"]+ <> reserved+ [ "assert"+ , "break"+ , "case"+ , "catch"+ , "class"+ , "const"+ , "continue"+ , "default"+ , "do"+ , "else"+ , "enum"+ , "extends"+ , "false"+ , "final"+ , "finally"+ , "for"+ , "if"+ , "in"+ , "is"+ , "new"+ , "rethrow"+ , "return"+ , "super"+ , "switch"+ , "this"+ , "throw"+ , "true"+ , "try"+ , "var"+ , "void"+ , "while"+ , "with"+ , "async"+ , "hide"+ , "on"+ , "show"+ , "sync"+ , "abstract"+ , "as"+ , "covariant"+ , "deferred"+ , "dynamic"+ , "export"+ , "extension"+ , "external"+ , "factory"+ , "function"+ , "get"+ , "implements"+ , "import"+ , "interface"+ , "library"+ , "mixin"+ , "operator"+ , "part"+ , "set"+ , "static"+ , "typedef"+ , "await"+ , "yield"+ ]+ }+ )+ ,+ ( Dhall+ , FileTypeInfo+ { ftSelector = [Ext "dhall"]+ , ftKind = KindConfig+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_', isAlphaNum_')+ , ftKeywords =+ types ["Bool", "Natural", "Integer", "Double", "Text", "Date", "Time", "List", "Optional"]+ <> reserved+ [ "if"+ , "then"+ , "else"+ , "toMap"+ , "with"+ , "merge"+ , "showConstructor"+ , "missing"+ , "as"+ , "using"+ , "let"+ , "assert"+ ]+ }+ )+ ,+ ( Elixir+ , FileTypeInfo+ { ftSelector = [Ext "ex", Ext "exs"]+ , ftKind = KindLanguage+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "integer"+ , "float"+ , "boolean"+ , "atom"+ , "binary"+ , "string"+ , "list"+ , "tuple"+ , "map"+ ]+ <> reserved+ [ "true"+ , "false"+ , "nil"+ , "when"+ , "and"+ , "or"+ , "not"+ , "in"+ , "fn"+ , "do"+ , "end"+ , "catch"+ , "rescue"+ , "after"+ , "else"+ ]+ }+ )+ ,+ ( Elm+ , FileTypeInfo+ { ftSelector = [Ext "elm"]+ , ftKind = KindLanguage+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Just (isAlpha, isAlphaNum_)+ , ftKeywords =+ types+ [ "Bool"+ , "Int"+ , "Float"+ , "String"+ , "Char"+ , "List"+ , "Maybe"+ , "Result"+ , "Order"+ , "Never"+ , "Html"+ , "msg"+ , "Cmd"+ , "Sub"+ ]+ <> reserved+ [ "type"+ , "alias"+ , "port"+ , "if"+ , "then"+ , "else"+ , "case"+ , "of"+ , "let"+ , "in"+ , "infix"+ , "left"+ , "right"+ , "non"+ , "module"+ , "import"+ , "exposing"+ , "as"+ , "where"+ , "effect"+ , "command"+ , "subscription"+ , "true"+ , "false"+ , "null"+ ]+ }+ )+ ,+ ( Erlang+ , FileTypeInfo+ { ftSelector = [Ext "erl", Ext "ERL", Ext "hrl", Ext "HRL"]+ , ftKind = KindLanguage+ , ftComment = ["%" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "Atom"+ , "Integer"+ , "Float"+ , "Boolean"+ , "String"+ , "Tuple"+ , "List"+ , "Function"+ , "Binary"+ , "PID"+ , "Port"+ , "Reference"+ , "Map"+ ]+ <> reserved+ [ "after"+ , "and"+ , "andalso"+ , "band"+ , "begin"+ , "bnot"+ , "bor"+ , "bsl"+ , "bsr"+ , "bxor"+ , "case"+ , "catch"+ , "cond"+ , "div"+ , "end"+ , "fun"+ , "if"+ , "let"+ , "not"+ , "of"+ , "or"+ , "orelse"+ , "receive"+ , "rem"+ , "try"+ , "when"+ , "xor"+ ]+ }+ )+ ,+ ( Fish+ , FileTypeInfo+ { ftSelector = [Ext "fish"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "and"+ , "argparse"+ , "begin"+ , "break"+ , "builtin"+ , "case"+ , "command"+ , "continue"+ , "else"+ , "end"+ , "eval"+ , "exec"+ , "for"+ , "function"+ , "if"+ , "not"+ , "or"+ , "read"+ , "return"+ , "set"+ , "status"+ , "string"+ , "switch"+ , "test"+ , "time"+ , "while"+ ]+ }+ )+ ,+ ( Fortran+ , FileTypeInfo+ { ftSelector =+ [ Ext "f"+ , Ext "for"+ , Ext "ftn"+ , Ext "F"+ , Ext "FOR"+ , Ext "FTN"+ , Ext "fpp"+ , Ext "FPP"+ , Ext "f90"+ , Ext "f95"+ , Ext "f03"+ , Ext "f08"+ , Ext "F90"+ , Ext "F95"+ , Ext "F03"+ , Ext "F08"+ ]+ , ftKind = KindLanguage+ , ftComment = ["!" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types ["integer", "real", "complex", "logical", "character"]+ <> reserved+ [ -- fortran77+ "assign"+ , "backspace"+ , "block"+ , "data"+ , "call"+ , "close"+ , "common"+ , "continue"+ , "data"+ , "dimension"+ , "do"+ , "else"+ , "else"+ , "if"+ , "end"+ , "endfile"+ , "endif"+ , "entry"+ , "equivalence"+ , "external"+ , "format"+ , "function"+ , "goto"+ , "if"+ , "implicit"+ , "inquire"+ , "intrinsic"+ , "open"+ , "parameter"+ , "pause"+ , "print"+ , "program"+ , "read"+ , "return"+ , "rewind"+ , "rewrite"+ , "save"+ , "stop"+ , "subroutine"+ , "then"+ , "write"+ , -- fortran 90+ "allocatable"+ , "allocate"+ , "case"+ , "contains"+ , "cycle"+ , "deallocate"+ , "elsewhere"+ , "exit?"+ , "include"+ , "interface"+ , "intent"+ , "module"+ , "namelist"+ , "nullify"+ , "only"+ , "operator"+ , "optional"+ , "pointer"+ , "private"+ , "procedure"+ , "public"+ , "recursive"+ , "result"+ , "select"+ , "sequence"+ , "target"+ , "use"+ , "while"+ , "where"+ , -- fortran 95+ "elemental"+ , "forall"+ , "pure"+ , -- fortran 03+ "abstract"+ , "associate"+ , "asynchronous"+ , "bind"+ , "class"+ , "deferred"+ , "enum"+ , "enumerator"+ , "extends"+ , "final"+ , "flush"+ , "generic"+ , "import"+ , "non_overridable"+ , "nopass"+ , "pass"+ , "protected"+ , "value"+ , "volatile"+ , "wait"+ , -- fortran 08+ "block"+ , "codimension"+ , "do"+ , "concurrent"+ , "contiguous"+ , "critical"+ , "error"+ , "stop"+ , "submodule"+ , "sync"+ , "all"+ , "sync"+ , "images"+ , "sync"+ , "memory"+ , "lock"+ , "unlock"+ ]+ }+ )+ ,+ ( Fsharp+ , FileTypeInfo+ { ftSelector = [Ext "fs", Ext "fsx", Ext "fsi"]+ , ftKind = KindLanguage+ , ftComment = ["(*" ~~ "*)", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Just (isAlpha_and "$@`?", isAlphaNum_and "$@`?")+ , ftKeywords =+ types+ [ "bool"+ , "byte"+ , "sbyte"+ , "int16"+ , "uint16"+ , "int"+ , "uint"+ , "int64"+ , "uint64"+ , "nativeint"+ , "unativeint"+ , "decimal"+ , "float"+ , "double"+ , "float32"+ , "single"+ , "char"+ , "string"+ ]+ <> reserved+ [ "abstract"+ , "and"+ , "as"+ , "assert"+ , "base"+ , "begin"+ , "class"+ , "default"+ , "delegate"+ , "do"+ , "done"+ , "downcast"+ , "downto"+ , "elif"+ , "else"+ , "end"+ , "exception"+ , "extern"+ , "FALSE"+ , "finally"+ , "fixed"+ , "for"+ , "fun"+ , "function"+ , "global"+ , "if"+ , "in"+ , "inherit"+ , "inline"+ , "interface"+ , "internal"+ , "lazy"+ , "let"+ , "let!"+ , "match"+ , "match!"+ , "member"+ , "module"+ , "mutable"+ , "namespace"+ , "new"+ , "not"+ , "null"+ , "of"+ , "open"+ , "or"+ , "override"+ , "private"+ , "public"+ , "rec"+ , "return"+ , "return!"+ , "select"+ , "static"+ , "struct"+ , "then"+ , "to"+ , "TRUE"+ , "try"+ , "type"+ , "upcast"+ , "use"+ , "use!"+ , "val"+ , "void"+ , "when"+ , "while"+ , "with"+ , "yield"+ , "yield!"+ , "const"+ , "asr"+ , "land"+ , "lor"+ , "lsl"+ , "lsr"+ , "lxor"+ , "mod"+ , "sig"+ , "break"+ , "checked"+ , "component"+ , "const"+ , "constraint"+ , "continue"+ , "event"+ , "external"+ , "include"+ , "mixin"+ , "parallel"+ , "process"+ , "protected"+ , "pure"+ , "sealed"+ , "tailcall"+ , "trait"+ , "virtual"+ ]+ }+ )+ ,+ ( Go+ , FileTypeInfo+ { ftSelector = [Ext "go"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["`" ~~ "`"]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "int8"+ , "int16"+ , "int32"+ , "int64"+ , "uint8"+ , "uint16"+ , "uint32"+ , "uint64"+ , "int"+ , "uint"+ , "rune"+ , "byte"+ , "uintptr"+ , "float32"+ , "float64"+ , "complex64"+ , "complex128"+ , "string"+ , "error"+ , "bool"+ ]+ <> reserved+ [ "break"+ , "default"+ , "func"+ , "interface"+ , "select"+ , "case"+ , "defer"+ , "go"+ , "map"+ , "struct"+ , "chan"+ , "else"+ , "goto"+ , "package"+ , "switch"+ , "const"+ , "fallthrough"+ , "if"+ , "range"+ , "type"+ , "continue"+ , "for"+ , "import"+ , "return"+ , "var"+ , "append"+ , "cap"+ , "close"+ , "copy"+ , "false"+ , "float32"+ , "float64"+ , "imag"+ , "iota"+ , "len"+ , "make"+ , "new"+ , "nil"+ , "panic"+ , "print"+ , "println"+ , "real"+ , "recover"+ , "true"+ ]+ }+ )+ ,+ ( GoMod+ , FileTypeInfo+ { ftSelector = [Name "go.mod"]+ , ftKind = KindConfig+ , ftComment = ["//" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords =+ reserved+ [ "module"+ , "go"+ , "require"+ , "exclude"+ , "replace"+ , "retract"+ ]+ }+ )+ ,+ ( Haskell+ , FileTypeInfo+ { ftSelector = [Ext "hs", Ext "lhs", Ext "hsc"]+ , ftKind = KindLanguage+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["[r|" ~~ "|]", "[q|" ~~ "|]", "[s|" ~~ "|]", "[here|" ~~ "|]", "[i|" ~~ "|]"]+ , ftIdentifierChars = Just (isAlpha_', isAlphaNum_')+ , ftKeywords =+ types+ [ "Bool"+ , "Char"+ , "String"+ , "ByteString"+ , "Text"+ , "Int"+ , "Int8"+ , "Int16"+ , "Int32"+ , "Int64"+ , "Word8"+ , "Word16"+ , "Word32"+ , "Word64"+ , "Integer"+ , "Float"+ , "Double"+ , "Complex"+ ]+ <> reserved+ [ "as"+ , "case"+ , "class"+ , "data"+ , "default"+ , "deriving"+ , "do"+ , "else"+ , "hiding"+ , "if"+ , "import"+ , "in"+ , "infix"+ , "infixl"+ , "infixr"+ , "instance"+ , "let"+ , "module"+ , "newtype"+ , "of"+ , "qualified"+ , "then"+ , "type"+ , "where"+ , "forall"+ , "mdo"+ , "family"+ , "role"+ , "pattern"+ , "static"+ , "group"+ , "by"+ , "using"+ , "foreign"+ , "export"+ , "label"+ , "dynamic"+ , "safe"+ , "interruptible"+ , "unsafe"+ , "stdcall"+ , "ccall"+ , "capi"+ , "prim"+ , "javascript"+ , "rec"+ , "proc"+ ]+ }+ )+ ,+ ( Html+ , FileTypeInfo+ { ftSelector = [Ext "htm", Ext "html"]+ , ftKind = KindMarkup+ , ftComment = ["<!--" ~~ "-->"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_, isAlpha_and "-:.")+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Idris+ , FileTypeInfo+ { ftSelector = [Ext "idr", Ext "lidr"]+ , ftKind = KindLanguage+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n", "|||" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_', isAlphaNum_')+ , ftKeywords =+ types ["Int", "Integer", "Double", "Char", "String", "Ptr", "Bool"]+ <> reserved+ [ "abstract"+ , "auto"+ , "codata"+ , "data"+ , "if"+ , "parameters"+ , "public"+ , "then"+ , "total"+ , "using"+ , "case"+ , "class"+ , "concrete"+ , "covering"+ , "default"+ , "do"+ , "else"+ , "export"+ , "failing"+ , "forall"+ , "implementation"+ , "implicit"+ , "import"+ , "impossible"+ , "in"+ , "incomplete"+ , "instance"+ , "interface"+ , "let"+ , "module"+ , "mutual"+ , "namespace"+ , "of"+ , "open"+ , "params"+ , "partial"+ , "postulate"+ , "private"+ , "proof"+ , "public"+ , "record"+ , "return"+ , "rewrite"+ , "syntax"+ , "then"+ , "total"+ , "unreachable"+ , "where"+ , "with"+ , "using"+ ]+ }+ )+ ,+ ( Java+ , FileTypeInfo+ { ftSelector = [Ext "java"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_and "$", isAlphaNum_and "$")+ , ftKeywords =+ types+ [ "bytes"+ , "char"+ , "short"+ , "int"+ , "long"+ , "float"+ , "double"+ , "boolean"+ , "void"+ ]+ <> reserved+ [ "abstract"+ , "assert"+ , "break"+ , "case"+ , "catch"+ , "class"+ , "continue"+ , "const"+ , "default"+ , "do"+ , "else"+ , "enum"+ , "exports"+ , "extends"+ , "final"+ , "finally"+ , "for"+ , "goto"+ , "if"+ , "implements"+ , "import"+ , "instanceof"+ , "int"+ , "interface"+ , "module"+ , "native"+ , "new"+ , "package"+ , "private"+ , "protected"+ , "public"+ , "requires"+ , "return"+ , "static"+ , "strictfp"+ , "super"+ , "switch"+ , "synchronized"+ , "this"+ , "throw"+ , "throws"+ , "transient"+ , "try"+ , "var"+ , "volatile"+ , "while"+ , "true"+ , "false"+ , "null"+ ]+ }+ )+ ,+ ( Javascript+ , FileTypeInfo+ { ftSelector = [Ext "js"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_and "$", isAlphaNum_and "$")+ , ftKeywords =+ reserved+ [ "abstract"+ , "arguments"+ , "await"+ , "break"+ , "byte"+ , "case"+ , "catch"+ , "char"+ , "class"+ , "const"+ , "continue"+ , "debugger"+ , "default"+ , "delete"+ , "do"+ , "double"+ , "else"+ , "enum"+ , "eval"+ , "export"+ , "extends"+ , "false"+ , "final"+ , "finally"+ , "float"+ , "for"+ , "function"+ , "goto"+ , "if"+ , "implements"+ , "import"+ , "in"+ , "instanceof"+ , "int"+ , "interface"+ , "let"+ , "long"+ , "native"+ , "new"+ , "null"+ , "package"+ , "private"+ , "protected"+ , "public"+ , "return"+ , "short"+ , "static"+ , "super"+ , "switch"+ , "synchronized"+ , "this"+ , "throw"+ , "throws"+ , "transient"+ , "true"+ , "try"+ , "typeof"+ , "var"+ , "volatile"+ , "while"+ , "with"+ , "yield"+ ]+ }+ )+ ,+ ( Json+ , FileTypeInfo+ { ftSelector = [Ext "json", Ext "ndjson"]+ , ftKind = KindData+ , ftComment = []+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Julia+ , FileTypeInfo+ { ftSelector = [Ext "jl"]+ , ftKind = KindLanguage+ , ftComment = ["#" ~~ "\n", "#-" ~~ "-#"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "Float16"+ , "Float32"+ , "Float64"+ , "Bool"+ , "Char"+ , "Int8"+ , "UInt8"+ , "Int16"+ , "UInt16"+ , "Int32"+ , "UInt32"+ , "Int64"+ , "UInt64"+ , "Int128"+ , "UInt128"+ , -- super types+ "Integer"+ , "AbstractChar"+ , "AbstractFloat"+ , "Signed"+ , "Unsigned"+ ]+ <> reserved+ [ "baremodule"+ , "begin"+ , "break"+ , "catch"+ , "const"+ , "continue"+ , "do"+ , "else"+ , "elseif"+ , "end"+ , "export"+ , "false"+ , "finally"+ , "for"+ , "function"+ , "global"+ , "if"+ , "import"+ , "let"+ , "local"+ , "macro"+ , "module"+ , "quote"+ , "return"+ , "struct"+ , "true"+ , "try"+ , "using"+ , "while"+ ]+ }+ )+ ,+ ( Kotlin+ , FileTypeInfo+ { ftSelector = [Ext "kt", Ext "kts", Ext "ktm"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "Byte"+ , "Short"+ , "Int"+ , "Long"+ , "Float"+ , "Double"+ , "UByte"+ , "UShort"+ , "UInt"+ , "ULong"+ , "Boolean"+ , "Char"+ ]+ <> reserved+ [ "as"+ , "break"+ , "class"+ , "continue"+ , "do"+ , "else"+ , "false"+ , "for"+ , "fun"+ , "if"+ , "in"+ , "interface"+ , "is"+ , "null"+ , "object"+ , "package"+ , "return"+ , "super"+ , "this"+ , "throw"+ , "true"+ , "try"+ , "typealias"+ , "typeof"+ , "val"+ , "var"+ , "when"+ , "while"+ , "by"+ , "catch"+ , "constructor"+ , "delegate"+ , "dynamic"+ , "field"+ , "file"+ , "finally"+ , "get"+ , "import"+ , "init"+ , "param"+ , "property"+ , "receiver"+ , "set"+ , "setparam"+ , "value"+ , "where"+ , "abstract"+ , "actual"+ , "annotation"+ , "companion"+ , "const"+ , "crossinline"+ , "data"+ , "enum"+ , "expect"+ , "external"+ , "final"+ , "infix"+ , "inline"+ , "inner"+ , "internal"+ , "lateinit"+ , "noinline"+ , "open"+ , "operator"+ , "out"+ , "override"+ , "private"+ , "protected"+ , "public"+ , "reified"+ , "sealed"+ , "suspend"+ , "tailrec"+ , "vararg"+ , "field"+ , "it"+ ]+ }+ )+ ,+ ( Ksh+ , FileTypeInfo+ { ftSelector = [Ext "ksh"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "case"+ , "do"+ , "done"+ , "elif"+ , "else"+ , "esac"+ , "fi"+ , "for"+ , "function"+ , "if"+ , "in"+ , "select"+ , "then"+ , "time"+ , "until"+ , "while"+ ]+ }+ )+ ,+ ( Latex+ , FileTypeInfo+ { ftSelector = [Ext "latex", Ext "tex"]+ , ftKind = KindMarkup+ , ftComment = ["%" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Lisp+ , FileTypeInfo+ { ftSelector = [Ext "lisp", Ext "cl"]+ , ftKind = KindLanguage+ , ftComment = [";" ~~ "\n", "#|" ~~ "|#"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_, isAlphaNum_and "!$%&*+-./:<=>?@^~")+ , ftKeywords =+ types+ [ "array"+ , "atom"+ , "bignum"+ , "bit"+ , "bit-vector"+ , "character"+ , "compiled-function"+ , "complex"+ , "cons"+ , "double-float"+ , "fixnum"+ , "float"+ , "function"+ , "hash-table"+ , "integer"+ , "keyword"+ , "list"+ , "long-float"+ , "nil"+ , "null"+ , "number"+ , "package"+ , "pathname"+ , "random-state"+ , "ratio"+ , "rational"+ , "readtable"+ , "sequence"+ , "short-float"+ , "signed-byte"+ , "simple-array"+ , "simple-bit-vector"+ , "simple-string"+ , "simple-vector"+ , "single-float"+ , "standard-char"+ , "stream"+ , "string"+ , "symbol"+ , "t"+ , "unsigned-byte"+ , "vector"+ ]+ }+ )+ ,+ ( Lua+ , FileTypeInfo+ { ftSelector = [Ext "lua"]+ , ftKind = KindLanguage+ , ftComment = ["--[[" ~~ "--]]", "--" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = ["[===[" ~~ "]===]", "[==[" ~~ "]==]", "[=[" ~~ "]=]", "[[" ~~ "]]"]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "and"+ , "break"+ , "do"+ , "else"+ , "elseif"+ , "end"+ , "false"+ , "for"+ , "function"+ , "if"+ , "in"+ , "local"+ , "nil"+ , "not"+ , "or"+ , "repeat"+ , "return"+ , "then"+ , "true"+ , "until"+ , "while"+ ]+ }+ )+ ,+ ( Make+ , FileTypeInfo+ { ftSelector = [Name "Makefile", Name "makefile", Name "GNUmakefile", Ext "mk", Ext "mak", Ext "make"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_and "-", isAlpha_and "-")+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Nmap+ , FileTypeInfo+ { ftSelector = [Ext "nse"]+ , ftKind = KindScript+ , ftComment = ["--" ~~ "\n", "[[" ~~ "]]"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Nim+ , FileTypeInfo+ { ftSelector = [Ext "nim"]+ , ftKind = KindLanguage+ , ftComment = ["#[" ~~ "#]", "#" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "int"+ , "int8"+ , "int16"+ , "int32"+ , "int64"+ , "uint"+ , "uint8"+ , "uint16"+ , "uint32"+ , "uint64"+ , "float"+ , "float32"+ , "float64"+ , "bool"+ , "string"+ , "cstring"+ ]+ <> reserved+ [ "addr"+ , "and"+ , "as"+ , "asm"+ , "bind"+ , "block"+ , "break"+ , "case"+ , "cast"+ , "concept"+ , "const"+ , "continue"+ , "converter"+ , "defer"+ , "discard"+ , "distinct"+ , "div"+ , "do"+ , "elif"+ , "else"+ , "end"+ , "enum"+ , "except"+ , "export"+ , "finally"+ , "for"+ , "from"+ , "func"+ , "if"+ , "import"+ , "in"+ , "include"+ , "interface"+ , "is"+ , "isnot"+ , "iterator"+ , "let"+ , "macro"+ , "method"+ , "mixin"+ , "mod"+ , "nil"+ , "not"+ , "notin"+ , "object"+ , "of"+ , "or"+ , "out"+ , "proc"+ , "ptr"+ , "raise"+ , "ref"+ , "return"+ , "shl"+ , "shr"+ , "static"+ , "template"+ , "try"+ , "tuple"+ , "type"+ , "using"+ , "var"+ , "when"+ , "while"+ , "xor"+ , "yield"+ ]+ }+ )+ ,+ ( OCaml+ , FileTypeInfo+ { ftSelector = [Ext "ml", Ext "mli"]+ , ftKind = KindLanguage+ , ftComment = ["(*" ~~ "*)"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["{id|" ~~ "|id}"]+ , ftIdentifierChars = Just (isAlpha_, isAlphaNum_')+ , ftKeywords =+ types+ [ "int"+ , "float"+ , "char"+ , "string"+ , "bool"+ , "unit"+ , "list"+ , "array"+ , "exn"+ , "option"+ , "ref"+ ]+ <> reserved+ [ "and"+ , "as"+ , "assert"+ , "asr"+ , "begin"+ , "class"+ , "constraint"+ , "do"+ , "done"+ , "downto"+ , "else"+ , "end"+ , "exception"+ , "external"+ , "false"+ , "for"+ , "fun"+ , "function"+ , "functor"+ , "if"+ , "in"+ , "include"+ , "inherit"+ , "initializer"+ , "land"+ , "lazy"+ , "let"+ , "lor"+ , "lsl"+ , "lsr"+ , "lxor"+ , "match"+ , "method"+ , "mod"+ , "module"+ , "mutable"+ , "new"+ , "nonrec"+ , "object"+ , "of"+ , "open"+ , "or"+ , "private"+ , "rec"+ , "sig"+ , "struct"+ , "then"+ , "to"+ , "true"+ , "try"+ , "type"+ , "val"+ , "virtual"+ , "when"+ , "while"+ , "with"+ ]+ }+ )+ ,+ ( ObjectiveC+ , FileTypeInfo+ { ftSelector = [Ext "m", Ext "mi"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "char"+ , "int"+ , "short"+ , "long"+ , "float"+ , "double"+ , "signed"+ , "unsigned"+ ]+ <> reserved+ [ "void"+ , "id"+ , "const"+ , "volatile"+ , "in"+ , "out"+ , "inout"+ , "bycopy"+ , "byref"+ , "oneway"+ , "self"+ , "super"+ , "interface"+ , "end"+ , "@implementation"+ , "@end"+ , "@interface"+ , "@end"+ , "@implementation"+ , "@end"+ , "@protoco"+ , "@end"+ , "@class"+ ]+ }+ )+ ,+ ( PHP+ , FileTypeInfo+ { ftSelector = [Ext "php", Ext "php3", Ext "php4", Ext "php5", Ext "phtml"]+ , ftKind = KindScript+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n", "#" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = ["<<END" ~~ "END;", "<<'END'" ~~ "END;"]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "__halt_compiler"+ , "abstract"+ , "and"+ , "array"+ , "as"+ , "break"+ , "callable"+ , "case"+ , "catch"+ , "class"+ , "clone"+ , "const"+ , "continue"+ , "declare"+ , "default"+ , "die"+ , "do"+ , "echo"+ , "else"+ , "elseif"+ , "empty"+ , "enddeclare"+ , "endfor"+ , "endforeach"+ , "endif"+ , "endswitch"+ , "endwhile"+ , "eval"+ , "exit"+ , "extends"+ , "final"+ , "finally"+ , "fn"+ , "for"+ , "foreach"+ , "function"+ , "global"+ , "goto"+ , "if"+ , "implements"+ , "include"+ , "include_once"+ , "instanceof"+ , "insteadof"+ , "interface"+ , "isset"+ , "list"+ , "match"+ , "namespace"+ , "new"+ , "or"+ , "print"+ , "private"+ , "protected"+ , "public"+ , "readonly"+ , "require"+ , "require_once"+ , "return"+ , "static"+ , "switch"+ , "throw"+ , "trait"+ , "try"+ , "unset"+ , "use"+ , "var"+ , "while"+ , "xor"+ , "yield"+ , "yield"+ , "from"+ ]+ }+ )+ ,+ ( Perl+ , FileTypeInfo+ { ftSelector = [Ext "pl", Ext "pm", Ext "pm6", Ext "plx", Ext "perl"]+ , ftKind = KindScript+ , ftComment = ["=pod" ~~ "=cut", "#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = ["<<\"END\";" ~~ "END", "<<'END'" ~~ "END", "<<'EOT';" ~~ "EOT", "<<\"EOT\";" ~~ "EOT"]+ , ftIdentifierChars = Nothing+ , ftKeywords = reserved []+ }+ )+ ,+ ( Python+ , FileTypeInfo+ { ftSelector = [Ext "py", Ext "pyx", Ext "pxd", Ext "pxi", Ext "scons"]+ , ftKind = KindLanguage+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\"", "'''" ~~ "'''", "r'" ~~ "'"]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "False"+ , "await"+ , "else"+ , "import"+ , "pass"+ , "None"+ , "break"+ , "except"+ , "in"+ , "raise"+ , "True"+ , "class"+ , "finally"+ , "is"+ , "return"+ , "and"+ , "continue"+ , "for"+ , "lambda"+ , "try"+ , "as"+ , "def"+ , "from"+ , "nonlocal"+ , "while"+ , "assert"+ , "del"+ , "global"+ , "not"+ , "with"+ , "async"+ , "elif"+ , "if"+ , "or"+ , "yield"+ ]+ }+ )+ ,+ ( R+ , FileTypeInfo+ { ftSelector = [Ext "r", Ext "rdata", Ext "rds", Ext "rda"]+ , ftKind = KindLanguage+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_and ".", isAlphaNum_and ".")+ , ftKeywords =+ reserved+ [ "if"+ , "else"+ , "repeat"+ , "while"+ , "function"+ , "for"+ , "in"+ , "next"+ , "break"+ , "TRUE"+ , "FALSE"+ , "NULL"+ , "Inf"+ , "NaN"+ , "NA"+ , "NA_integer_"+ , "NA_real_"+ , "NA_complex_"+ , "NA_character_"+ , "…"+ ]+ }+ )+ ,+ ( Ruby+ , FileTypeInfo+ { ftSelector = [Ext "rb", Ext "ruby"]+ , ftKind = KindLanguage+ , ftComment = ["=begin" ~~ "=end", "#" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["'" ~~ "'", "\"" ~~ "\"", "%|" ~~ "|", "%q(" ~~ ")", "%Q(" ~~ ")"]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "BEGIN"+ , "END"+ , "alias"+ , "and"+ , "begin"+ , "break"+ , "case"+ , "class"+ , "def"+ , "module"+ , "next"+ , "nil"+ , "not"+ , "or"+ , "redo"+ , "rescue"+ , "retry"+ , "return"+ , "elsif"+ , "end"+ , "false"+ , "ensure"+ , "for"+ , "if"+ , "true"+ , "undef"+ , "unless"+ , "do"+ , "else"+ , "super"+ , "then"+ , "until"+ , "when"+ , "while"+ , "defined?"+ , "self"+ ]+ }+ )+ ,+ ( Rust+ , FileTypeInfo+ { ftSelector = [Ext "rs", Ext "rlib"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["r##\"" ~~ "\"##", "r#\"" ~~ "\"#", "r\"" ~~ "\""]+ , ftIdentifierChars = Just (isAlpha_, isAlphaNum_and "#")+ , ftKeywords =+ types+ [ "i8"+ , "u8"+ , "i16"+ , "u16"+ , "i32"+ , "u32"+ , "i64"+ , "u64"+ , "i128"+ , "u128"+ , "isize"+ , "usize"+ , "bool"+ , "char"+ , "str"+ , "String"+ ]+ <> reserved+ [ "as"+ , "use"+ , "extern"+ , "crate"+ , "break"+ , "const"+ , "continue"+ , "crate"+ , "else"+ , "if"+ , "let"+ , "enum"+ , "extern"+ , "false"+ , "fn"+ , "for"+ , "if"+ , "impl"+ , "in"+ , "for"+ , "let"+ , "loop"+ , "match"+ , "mod"+ , "move"+ , "mut"+ , "pub"+ , "impl"+ , "ref"+ , "return"+ , "Self"+ , "self"+ , "static"+ , "struct"+ , "super"+ , "trait"+ , "true"+ , "type"+ , "unsafe"+ , "use"+ , "where"+ , "while"+ , "abstract"+ , "alignof"+ , "become"+ , "box"+ , "do"+ , "final"+ , "macro"+ , "offsetof"+ , "override"+ , "priv"+ , "proc"+ , "pure"+ , "sizeof"+ , "typeof"+ , "unsized"+ , "virtual"+ , "yield"+ , "async"+ , "await"+ , "dyn"+ , -- weak keywords+ "macro_rules"+ , "union"+ , "'static"+ , -- reserved for future use+ "abstract"+ , "become"+ , "box"+ , "do"+ , "final"+ , "macro"+ , "override"+ , "priv"+ , "typeof"+ , "unsized"+ , "virtual"+ , "yield"+ , "try"+ ]+ }+ )+ ,+ ( Scala+ , FileTypeInfo+ { ftSelector = [Ext "scala"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_and "$", isAlphaNum_and "$")+ , ftKeywords =+ types+ [ "Byte"+ , "Short"+ , "Int"+ , "Long"+ , "Float"+ , "Double"+ , "Char"+ , "String"+ , "Boolean"+ , "Unit"+ , "Null"+ , "Nothing"+ , "Any"+ , "AnyRef"+ ]+ <> reserved+ [ "abstract"+ , "case"+ , "catch"+ , "class"+ , "def"+ , "do"+ , "else"+ , "extends"+ , "false"+ , "final"+ , "finally"+ , "for"+ , "forSome"+ , "if"+ , "implicit"+ , "import"+ , "lazy"+ , "match"+ , "new"+ , "null"+ , "object"+ , "override"+ , "package"+ , "private"+ , "protected"+ , "return"+ , "sealed"+ , "super"+ , "this"+ , "throw"+ , "trait"+ , "true"+ , "try"+ , "type"+ , "val"+ , "var"+ , "while"+ , "with"+ , "yield"+ ]+ }+ )+ ,+ ( SmallTalk+ , FileTypeInfo+ { ftSelector = [Ext "st", Ext "gst"]+ , ftKind = KindLanguage+ , ftComment = ["\"" ~~ "\""]+ , ftChar = ["$" ~~ ""]+ , ftString = ["'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha, isAlphaNum)+ , ftKeywords =+ reserved+ [ "true"+ , "false"+ , "nil"+ , "self"+ , "super"+ , "thisContext"+ ]+ }+ )+ ,+ ( Swift+ , FileTypeInfo+ { ftSelector = [Ext "swift"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\"\"\"" ~~ "\"\"\""]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "Int"+ , "Int8"+ , "Int16"+ , "Int32"+ , "Int64"+ , "UInt"+ , "UInt8"+ , "UInt16"+ , "UInt32"+ , "UInt64"+ , "Float"+ , "Double"+ , "Float80"+ , "Float16"+ , "Bool"+ , "String"+ , "Character"+ , "Array"+ , "Dictionary"+ , "Set"+ , "Optional"+ , "Any"+ , "AnyObject"+ ]+ <> reserved+ [ "associatedtype"+ , "class"+ , "deinit"+ , "enum"+ , "extension"+ , "fileprivate"+ , "func"+ , "import"+ , "init"+ , "inout"+ , "internal"+ , "let"+ , "open"+ , "operator"+ , "private"+ , "precedencegroup"+ , "protocol"+ , "public"+ , "rethrows"+ , "static"+ , "struct"+ , "subscript"+ , "typealias"+ , "var"+ , "break"+ , "case"+ , "catch"+ , "continue"+ , "default"+ , "defer"+ , "do"+ , "else"+ , "fallthrough"+ , "for"+ , "guard"+ , "if"+ , "in"+ , "repeat"+ , "return"+ , "throw"+ , "switch"+ , "where"+ , "while"+ , "Any"+ , "as"+ , "catch"+ , "false"+ , "is"+ , "nil"+ , "rethrows"+ , "self"+ , "Self"+ , "super"+ , "throw"+ , "throws"+ , "true"+ , "try"+ , "#available"+ , "#colorLiteral"+ , "#column"+ , "#dsohandle"+ , "#elseif"+ , "#else"+ , "#endif"+ , "#error"+ , "#fileID"+ , "#fileLiteral"+ , "#filePath"+ , "#file"+ , "#function"+ , "#if"+ , "#imageLiteral"+ , "#keyPath"+ , "#line"+ , "#selector"+ , "#sourceLocation"+ , "#warning"+ , "associativity"+ , "convenience"+ , "didSet"+ , "dynamic"+ , "final"+ , "get"+ , "indirect"+ , "infix"+ , "lazy"+ , "left"+ , "mutating"+ , "none"+ , "nonmutating"+ , "optional"+ , "override"+ , "postfix"+ , "precedence"+ , "prefix"+ , "Protocol"+ , "required"+ , "right"+ , "set"+ , "some"+ , "Type"+ , "unowned"+ , "weak"+ , "willSet"+ ]+ }+ )+ ,+ ( Sql+ , FileTypeInfo+ { ftSelector = [Ext "sql"]+ , ftKind = KindLanguage+ , ftComment = ["--" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "ABORT"+ , "ABORTSESSION"+ , "ABS"+ , "ABSOLUTE"+ , "ACCESS"+ , "ACCESSIBLE"+ , "ACCESS_LOCK"+ , "ACCOUNT"+ , "ACOS"+ , "ACOSH"+ , "ACTION"+ , "ADD"+ , "ADD_MONTHS"+ , "ADMIN"+ , "AFTER"+ , "AGGREGATE"+ , "ALIAS"+ , "ALL"+ , "ALLOCATE"+ , "ALLOW"+ , "ALTER"+ , "ALTERAND"+ , "AMP"+ , "ANALYSE"+ , "ANALYZE"+ , "AND"+ , "ANSIDATE"+ , "ANY"+ , "ARE"+ , "ARRAY"+ , "ARRAY_AGG"+ , "ARRAY_EXISTS"+ , "ARRAY_MAX_CARDINALITY"+ , "AS"+ , "ASC"+ , "ASENSITIVE"+ , "ASIN"+ , "ASINH"+ , "ASSERTION"+ , "ASSOCIATE"+ , "ASUTIME"+ , "ASYMMETRIC"+ , "AT"+ , "ATAN"+ , "ATAN2"+ , "ATANH"+ , "ATOMIC"+ , "AUDIT"+ , "AUTHORIZATION"+ , "AUX"+ , "AUXILIARY"+ , "AVE"+ , "AVERAGE"+ , "AVG"+ , "BACKUP"+ , "BEFORE"+ , "BEGIN"+ , "BEGIN_FRAME"+ , "BEGIN_PARTITION"+ , "BETWEEN"+ , "BIGINT"+ , "BINARY"+ , "BIT"+ , "BLOB"+ , "BOOLEAN"+ , "BOTH"+ , "BREADTH"+ , "BREAK"+ , "BROWSE"+ , "BT"+ , "BUFFERPOOL"+ , "BULK"+ , "BUT"+ , "BY"+ , "BYTE"+ , "BYTEINT"+ , "BYTES"+ , "CALL"+ , "CALLED"+ , "CAPTURE"+ , "CARDINALITY"+ , "CASCADE"+ , "CASCADED"+ , "CASE"+ , "CASESPECIFIC"+ , "CASE_N"+ , "CAST"+ , "CATALOG"+ , "CCSID"+ , "CD"+ , "CEIL"+ , "CEILING"+ , "CHANGE"+ , "CHAR"+ , "CHAR2HEXINT"+ , "CHARACTER"+ , "CHARACTERS"+ , "CHARACTER_LENGTH"+ , "CHARS"+ , "CHAR_LENGTH"+ , "CHECK"+ , "CHECKPOINT"+ , "CLASS"+ , "CLASSIFIER"+ , "CLOB"+ , "CLONE"+ , "CLOSE"+ , "CLUSTER"+ , "CLUSTERED"+ , "CM"+ , "COALESCE"+ , "COLLATE"+ , "COLLATION"+ , "COLLECT"+ , "COLLECTION"+ , "COLLID"+ , "COLUMN"+ , "COLUMN_VALUE"+ , "COMMENT"+ , "COMMIT"+ , "COMPLETION"+ , "COMPRESS"+ , "COMPUTE"+ , "CONCAT"+ , "CONCURRENTLY"+ , "CONDITION"+ , "CONNECT"+ , "CONNECTION"+ , "CONSTRAINT"+ , "CONSTRAINTS"+ , "CONSTRUCTOR"+ , "CONTAINS"+ , "CONTAINSTABLE"+ , "CONTENT"+ , "CONTINUE"+ , "CONVERT"+ , "CONVERT_TABLE_HEADER"+ , "COPY"+ , "CORR"+ , "CORRESPONDING"+ , "COS"+ , "COSH"+ , "COUNT"+ , "COVAR_POP"+ , "COVAR_SAMP"+ , "CREATE"+ , "CROSS"+ , "CS"+ , "CSUM"+ , "CT"+ , "CUBE"+ , "CUME_DIST"+ , "CURRENT"+ , "CURRENT_CATALOG"+ , "CURRENT_DATE"+ , "CURRENT_DEFAULT_TRANSFORM_GROUP"+ , "CURRENT_LC_CTYPE"+ , "CURRENT_PATH"+ , "CURRENT_ROLE"+ , "CURRENT_ROW"+ , "CURRENT_SCHEMA"+ , "CURRENT_SERVER"+ , "CURRENT_TIME"+ , "CURRENT_TIMESTAMP"+ , "CURRENT_TIMEZONE"+ , "CURRENT_TRANSFORM_GROUP_FOR_TYPE"+ , "CURRENT_USER"+ , "CURRVAL"+ , "CURSOR"+ , "CV"+ , "CYCLE"+ , "DATA"+ , "DATABASE"+ , "DATABASES"+ , "DATABLOCKSIZE"+ , "DATE"+ , "DATEFORM"+ , "DAY"+ , "DAYS"+ , "DAY_HOUR"+ , "DAY_MICROSECOND"+ , "DAY_MINUTE"+ , "DAY_SECOND"+ , "DBCC"+ , "DBINFO"+ , "DEALLOCATE"+ , "DEC"+ , "DECFLOAT"+ , "DECIMAL"+ , "DECLARE"+ , "DEFAULT"+ , "DEFERRABLE"+ , "DEFERRED"+ , "DEFINE"+ , "DEGREES"+ , "DEL"+ , "DELAYED"+ , "DELETE"+ , "DENSE_RANK"+ , "DENY"+ , "DEPTH"+ , "DEREF"+ , "DESC"+ , "DESCRIBE"+ , "DESCRIPTOR"+ , "DESTROY"+ , "DESTRUCTOR"+ , "DETERMINISTIC"+ , "DIAGNOSTIC"+ , "DIAGNOSTICS"+ , "DICTIONARY"+ , "DISABLE"+ , "DISABLED"+ , "DISALLOW"+ , "DISCONNECT"+ , "DISK"+ , "DISTINCT"+ , "DISTINCTROW"+ , "DISTRIBUTED"+ , "DIV"+ , "DO"+ , "DOCUMENT"+ , "DOMAIN"+ , "DOUBLE"+ , "DROP"+ , "DSSIZE"+ , "DUAL"+ , "DUMP"+ , "DYNAMIC"+ , "EACH"+ , "ECHO"+ , "EDITPROC"+ , "ELEMENT"+ , "ELSE"+ , "ELSEIF"+ , "EMPTY"+ , "ENABLED"+ , "ENCLOSED"+ , "ENCODING"+ , "ENCRYPTION"+ , "END"+ , "END"+ , "EXEC"+ , "ENDING"+ , "END_FRAME"+ , "END_PARTITION"+ , "EQ"+ , "EQUALS"+ , "ERASE"+ , "ERRLVL"+ , "ERROR"+ , "ERRORFILES"+ , "ERRORTABLES"+ , "ESCAPE"+ , "ESCAPED"+ , "ET"+ , "EVERY"+ , "EXCEPT"+ , "EXCEPTION"+ , "EXCLUSIVE"+ , "EXEC"+ , "EXECUTE"+ , "EXISTS"+ , "EXIT"+ , "EXP"+ , "EXPLAIN"+ , "EXTERNAL"+ , "EXTRACT"+ , "FALLBACK"+ , "FALSE"+ , "FASTEXPORT"+ , "FENCED"+ , "FETCH"+ , "FIELDPROC"+ , "FILE"+ , "FILLFACTOR"+ , "FILTER"+ , "FINAL"+ , "FIRST"+ , "FIRST_VALUE"+ , "FLOAT"+ , "FLOAT4"+ , "FLOAT8"+ , "FLOOR"+ , "FOR"+ , "FORCE"+ , "FOREIGN"+ , "FORMAT"+ , "FOUND"+ , "FRAME_ROW"+ , "FREE"+ , "FREESPACE"+ , "FREETEXT"+ , "FREETEXTTABLE"+ , "FREEZE"+ , "FROM"+ , "FULL"+ , "FULLTEXT"+ , "FUNCTION"+ , "FUSION"+ , "GE"+ , "GENERAL"+ , "GENERATED"+ , "GET"+ , "GIVE"+ , "GLOBAL"+ , "GO"+ , "GOTO"+ , "GRANT"+ , "GRAPHIC"+ , "GROUP"+ , "GROUPING"+ , "GROUPS"+ , "GT"+ , "HANDLER"+ , "HASH"+ , "HASHAMP"+ , "HASHBAKAMP"+ , "HASHBUCKET"+ , "HASHROW"+ , "HAVING"+ , "HELP"+ , "HIGH_PRIORITY"+ , "HOLD"+ , "HOLDLOCK"+ , "HOST"+ , "HOUR"+ , "HOURS"+ , "HOUR_MICROSECOND"+ , "HOUR_MINUTE"+ , "HOUR_SECOND"+ , "IDENTIFIED"+ , "IDENTITY"+ , "IDENTITYCOL"+ , "IDENTITY_INSERT"+ , "IF"+ , "IGNORE"+ , "ILIKE"+ , "IMMEDIATE"+ , "IN"+ , "INCLUSIVE"+ , "INCONSISTENT"+ , "INCREMENT"+ , "INDEX"+ , "INDICATOR"+ , "INFILE"+ , "INHERIT"+ , "INITIAL"+ , "INITIALIZE"+ , "INITIALLY"+ , "INITIATE"+ , "INNER"+ , "INOUT"+ , "INPUT"+ , "INS"+ , "INSENSITIVE"+ , "INSERT"+ , "INSTEAD"+ , "INT"+ , "INT1"+ , "INT2"+ , "INT3"+ , "INT4"+ , "INT8"+ , "INTEGER"+ , "INTEGERDATE"+ , "INTERSECT"+ , "INTERSECTION"+ , "INTERVAL"+ , "INTO"+ , "IO_AFTER_GTIDS"+ , "IO_BEFORE_GTIDS"+ , "IS"+ , "ISNULL"+ , "ISOBID"+ , "ISOLATION"+ , "ITERATE"+ , "JAR"+ , "JOIN"+ , "JOURNAL"+ , "JSON_ARRAY"+ , "JSON_ARRAYAGG"+ , "JSON_EXISTS"+ , "JSON_OBJECT"+ , "JSON_OBJECTAGG"+ , "JSON_QUERY"+ , "JSON_TABLE"+ , "JSON_TABLE_PRIMITIVE"+ , "JSON_VALUE"+ , "KEEP"+ , "KEY"+ , "KEYS"+ , "KILL"+ , "KURTOSIS"+ , "LABEL"+ , "LAG"+ , "FTUAGE"+ , "LARGE"+ , "LAST"+ , "LAST_VALUE"+ , "LATERAL"+ , "LC_CTYPE"+ , "LE"+ , "LEAD"+ , "LEADING"+ , "LEAVE"+ , "LEFT"+ , "LESS"+ , "LEVEL"+ , "LIKE"+ , "LIKE_REGEX"+ , "LIMIT"+ , "LINEAR"+ , "LINENO"+ , "LINES"+ , "LISTAGG"+ , "LN"+ , "LOAD"+ , "LOADING"+ , "LOCAL"+ , "LOCALE"+ , "LOCALTIME"+ , "LOCALTIMESTAMP"+ , "LOCATOR"+ , "LOCATORS"+ , "LOCK"+ , "LOCKING"+ , "LOCKMAX"+ , "LOCKSIZE"+ , "LOG"+ , "LOG10"+ , "LOGGING"+ , "LOGON"+ , "LONG"+ , "LONGBLOB"+ , "LONGTEXT"+ , "LOOP"+ , "LOWER"+ , "LOW_PRIORITY"+ , "LT"+ , "MACRO"+ , "MAINTAINED"+ , "MAP"+ , "MASTER_BIND"+ , "MASTER_SSL_VERIFY_SERVER_CERT"+ , "MATCH"+ , "MATCHES"+ , "MATCH_NUMBER"+ , "MATCH_RECOGNIZE"+ , "MATERIALIZED"+ , "MAVG"+ , "MAX"+ , "MAXEXTENTS"+ , "MAXIMUM"+ , "MAXVALUE"+ , "MCHARACTERS"+ , "MDIFF"+ , "MEDIUMBLOB"+ , "MEDIUMINT"+ , "MEDIUMTEXT"+ , "MEMBER"+ , "MERGE"+ , "METHOD"+ , "MICROSECOND"+ , "MICROSECONDS"+ , "MIDDLEINT"+ , "MIN"+ , "MINDEX"+ , "MINIMUM"+ , "MINUS"+ , "MINUTE"+ , "MINUTES"+ , "MINUTE_MICROSECOND"+ , "MINUTE_SECOND"+ , "MLINREG"+ , "MLOAD"+ , "MLSLABEL"+ , "MOD"+ , "MODE"+ , "MODIFIES"+ , "MODIFY"+ , "MODULE"+ , "MONITOR"+ , "MONRESOURCE"+ , "MONSESSION"+ , "MONTH"+ , "MONTHS"+ , "MSUBSTR"+ , "MSUM"+ , "MULTISET"+ , "NAMED"+ , "NAMES"+ , "NATIONAL"+ , "NATURAL"+ , "NCHAR"+ , "NCLOB"+ , "NE"+ , "NESTED_TABLE_ID"+ , "NEW"+ , "NEW_TABLE"+ , "NEXT"+ , "NEXTVAL"+ , "NO"+ , "NOAUDIT"+ , "NOCHECK"+ , "NOCOMPRESS"+ , "NONCLUSTERED"+ , "NONE"+ , "NORMALIZE"+ , "NOT"+ , "NOTNULL"+ , "NOWAIT"+ , "NO_WRITE_TO_BINLOG"+ , "NTH_VALUE"+ , "NTILE"+ , "NULL"+ , "NULLIF"+ , "NULLIFZERO"+ , "NULLS"+ , "NUMBER"+ , "NUMERIC"+ , "NUMPARTS"+ , "OBID"+ , "OBJECT"+ , "OBJECTS"+ , "OCCURRENCES_REGEX"+ , "OCTET_LENGTH"+ , "OF"+ , "OFF"+ , "OFFLINE"+ , "OFFSET"+ , "OFFSETS"+ , "OLD"+ , "OLD_TABLE"+ , "OMIT"+ , "ON"+ , "ONE"+ , "ONLINE"+ , "ONLY"+ , "OPEN"+ , "OPENDATASOURCE"+ , "OPENQUERY"+ , "OPENROWSET"+ , "OPENXML"+ , "OPERATION"+ , "OPTIMIZATION"+ , "OPTIMIZE"+ , "OPTIMIZER_COSTS"+ , "OPTION"+ , "OPTIONALLY"+ , "OR"+ , "ORDER"+ , "ORDINALITY"+ , "ORGANIZATION"+ , "OUT"+ , "OUTER"+ , "OUTFILE"+ , "OUTPUT"+ , "OVER"+ , "OVERLAPS"+ , "OVERLAY"+ , "OVERRIDE"+ , "PACKAGE"+ , "PAD"+ , "PADDED"+ , "PARAMETER"+ , "PARAMETERS"+ , "PART"+ , "PARTIAL"+ , "PARTITION"+ , "PARTITIONED"+ , "PARTITIONING"+ , "PASSWORD"+ , "PATH"+ , "PATTERN"+ , "PCTFREE"+ , "PER"+ , "PERCENT"+ , "PERCENTILE_CONT"+ , "PERCENTILE_DISC"+ , "PERCENT_RANK"+ , "PERIOD"+ , "PERM"+ , "PERMANENT"+ , "PIECESIZE"+ , "PIVOT"+ , "PLACING"+ , "PLAN"+ , "PORTION"+ , "POSITION"+ , "POSITION_REGEX"+ , "POSTFIX"+ , "POWER"+ , "PRECEDES"+ , "PRECISION"+ , "PREFIX"+ , "PREORDER"+ , "PREPARE"+ , "PRESERVE"+ , "PREVVAL"+ , "PRIMARY"+ , "PRINT"+ , "PRIOR"+ , "PRIQTY"+ , "PRIVATE"+ , "PRIVILEGES"+ , "PROC"+ , "PROCEDURE"+ , "PROFILE"+ , "PROGRAM"+ , "PROPORTIONAL"+ , "PROTECTION"+ , "PSID"+ , "PTF"+ , "PUBLIC"+ , "PURGE"+ , "QUALIFIED"+ , "QUALIFY"+ , "QUANTILE"+ , "QUERY"+ , "QUERYNO"+ , "RADIANS"+ , "RAISERROR"+ , "RANDOM"+ , "RANGE"+ , "RANGE_N"+ , "RANK"+ , "RAW"+ , "READ"+ , "READS"+ , "READTEXT"+ , "READ_WRITE"+ , "REAL"+ , "RECONFIGURE"+ , "RECURSIVE"+ , "REF"+ , "REFERENCES"+ , "REFERENCING"+ , "REFRESH"+ , "REGEXP"+ , "REGR_AVGX"+ , "REGR_AVGY"+ , "REGR_COUNT"+ , "REGR_INTERCEPT"+ , "REGR_R2"+ , "REGR_SLOPE"+ , "REGR_SXX"+ , "REGR_SXY"+ , "REGR_SYY"+ , "RELATIVE"+ , "RELEASE"+ , "RENAME"+ , "REPEAT"+ , "REPLACE"+ , "REPLICATION"+ , "REPOVERRIDE"+ , "REQUEST"+ , "REQUIRE"+ , "RESIGNAL"+ , "RESOURCE"+ , "RESTART"+ , "RESTORE"+ , "RESTRICT"+ , "RESULT"+ , "RESULT_SET_LOCATOR"+ , "RESUME"+ , "RET"+ , "RETRIEVE"+ , "RETURN"+ , "RETURNING"+ , "RETURNS"+ , "REVALIDATE"+ , "REVERT"+ , "REVOKE"+ , "RIGHT"+ , "RIGHTS"+ , "RLIKE"+ , "ROLE"+ , "ROLLBACK"+ , "ROLLFORWARD"+ , "ROLLUP"+ , "ROUND_CEILING"+ , "ROUND_DOWN"+ , "ROUND_FLOOR"+ , "ROUND_HALF_DOWN"+ , "ROUND_HALF_EVEN"+ , "ROUND_HALF_UP"+ , "ROUND_UP"+ , "ROUTINE"+ , "ROW"+ , "ROWCOUNT"+ , "ROWGUIDCOL"+ , "ROWID"+ , "ROWNUM"+ , "ROWS"+ , "ROWSET"+ , "ROW_NUMBER"+ , "RULE"+ , "RUN"+ , "RUNNING"+ , "SAMPLE"+ , "SAMPLEID"+ , "SAVE"+ , "SAVEPOINT"+ , "SCHEMA"+ , "SCHEMAS"+ , "SCOPE"+ , "SCRATCHPAD"+ , "SCROLL"+ , "SEARCH"+ , "SECOND"+ , "SECONDS"+ , "SECOND_MICROSECOND"+ , "SECQTY"+ , "SECTION"+ , "SECURITY"+ , "SECURITYAUDIT"+ , "SEEK"+ , "SEL"+ , "SELECT"+ , "SEMANTICKEYPHRASETABLE"+ , "SEMANTICSIMILARITYDETAILSTABLE"+ , "SEMANTICSIMILARITYTABLE"+ , "SENSITIVE"+ , "SEPARATOR"+ , "SEQUENCE"+ , "SESSION"+ , "SESSION_USER"+ , "SET"+ , "SETRESRATE"+ , "SETS"+ , "SETSESSRATE"+ , "SETUSER"+ , "SHARE"+ , "SHOW"+ , "SHUTDOWN"+ , "SIGNAL"+ , "SIMILAR"+ , "SIMPLE"+ , "SIN"+ , "SINH"+ , "SIZE"+ , "SKEW"+ , "SKIP"+ , "SMALLINT"+ , "SOME"+ , "SOUNDEX"+ , "SOURCE"+ , "SPACE"+ , "SPATIAL"+ , "SPECIFIC"+ , "SPECIFICTYPE"+ , "SPOOL"+ , "SQL"+ , "SQLEXCEPTION"+ , "SQLSTATE"+ , "SQLTEXT"+ , "SQLWARNING"+ , "SQL_BIG_RESULT"+ , "SQL_CALC_FOUND_ROWS"+ , "SQL_SMALL_RESULT"+ , "SQRT"+ , "SS"+ , "SSL"+ , "STANDARD"+ , "START"+ , "STARTING"+ , "STARTUP"+ , "STATE"+ , "STATEMENT"+ , "STATIC"+ , "STATISTICS"+ , "STAY"+ , "STDDEV_POP"+ , "STDDEV_SAMP"+ , "STEPINFO"+ , "STOGROUP"+ , "STORED"+ , "STORES"+ , "STRAIGHT_JOIN"+ , "STRING_CS"+ , "STRUCTURE"+ , "STYLE"+ , "SUBMULTISET"+ , "SUBSCRIBER"+ , "SUBSET"+ , "SUBSTR"+ , "SUBSTRING"+ , "SUBSTRING_REGEX"+ , "SUCCEEDS"+ , "SUCCESSFUL"+ , "SUM"+ , "SUMMARY"+ , "SUSPEND"+ , "SYMMETRIC"+ , "SYNONYM"+ , "SYSDATE"+ , "SYSTEM"+ , "SYSTEM_TIME"+ , "SYSTEM_USER"+ , "SYSTIMESTAMP"+ , "TABLE"+ , "TABLESAMPLE"+ , "TABLESPACE"+ , "TAN"+ , "TANH"+ , "TBL_CS"+ , "TEMPORARY"+ , "TERMINATE"+ , "TERMINATED"+ , "TEXTSIZE"+ , "THAN"+ , "THEN"+ , "THRESHOLD"+ , "TIME"+ , "TIMESTAMP"+ , "TIMEZONE_HOUR"+ , "TIMEZONE_MINUTE"+ , "TINYBLOB"+ , "TINYINT"+ , "TINYTEXT"+ , "TITLE"+ , "TO"+ , "TOP"+ , "TRACE"+ , "TRAILING"+ , "TRAN"+ , "TRANSACTION"+ , "TRANSLATE"+ , "TRANSLATE_CHK"+ , "TRANSLATE_REGEX"+ , "TRANSLATION"+ , "TREAT"+ , "TRIGGER"+ , "TRIM"+ , "TRIM_ARRAY"+ , "TRUE"+ , "TRUNCATE"+ , "TRY_CONVERT"+ , "TSEQUAL"+ , "TYPE"+ , "UC"+ , "UESCAPE"+ , "UID"+ , "UNDEFINED"+ , "UNDER"+ , "UNDO"+ , "UNION"+ , "UNIQUE"+ , "UNKNOWN"+ , "UNLOCK"+ , "UNNEST"+ , "UNPIVOT"+ , "UNSIGNED"+ , "UNTIL"+ , "UPD"+ , "UPDATE"+ , "UPDATETEXT"+ , "UPPER"+ , "UPPERCASE"+ , "USAGE"+ , "USE"+ , "USER"+ , "USING"+ , "UTC_DATE"+ , "UTC_TIME"+ , "UTC_TIMESTAMP"+ , "VALIDATE"+ , "VALIDPROC"+ , "VALUE"+ , "VALUES"+ , "VALUE_OF"+ , "VARBINARY"+ , "VARBYTE"+ , "VARCHAR"+ , "VARCHAR2"+ , "VARCHARACTER"+ , "VARGRAPHIC"+ , "VARIABLE"+ , "VARIADIC"+ , "VARIANT"+ , "VARYING"+ , "VAR_POP"+ , "VAR_SAMP"+ , "VCAT"+ , "VERBOSE"+ , "VERSIONING"+ , "VIEW"+ , "VIRTUAL"+ , "VOLATILE"+ , "VOLUMES"+ , "WAIT"+ , "WAITFOR"+ , "WHEN"+ , "WHENEVER"+ , "WHERE"+ , "WHILE"+ , "WIDTH_BUCKET"+ , "WINDOW"+ , "WITH"+ , "WITHIN"+ , "WITHIN_GROUP"+ , "WITHOUT"+ , "WLM"+ , "WORK"+ , "WRITE"+ , "WRITETEXT"+ , "XMLCAST"+ , "XMLEXISTS"+ , "XMLNAMESPACES"+ , "XOR"+ , "YEAR"+ , "YEARS"+ , "YEAR_MONTH"+ , "ZEROFILL"+ , "ZEROIFNULL"+ , "ZONE"+ ]+ }+ )+ ,+ ( Tcl+ , FileTypeInfo+ { ftSelector = [Ext "tcl", Ext "tk"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftKeywords = HM.empty+ , ftIdentifierChars = Just (isAlpha, isAlphaNum)+ }+ )+ ,+ ( Text+ , FileTypeInfo+ { ftSelector =+ [ Ext "txt"+ , Ext "md"+ , Ext "markdown"+ , Ext "mdown"+ , Ext "mkdn"+ , Ext "mkd"+ , Ext "mdwn"+ , Ext "mdtxt"+ , Ext "mdtext"+ , Ext "text"+ , Name "README"+ , Name "INSTALL"+ , Name "VERSION"+ , Name "LICENSE"+ , Name "AUTHORS"+ , Name "CHANGELOG"+ , Name "go.sum"+ ]+ , ftKind = KindText+ , ftComment = []+ , ftChar = []+ , ftString = []+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Unison+ , FileTypeInfo+ { ftSelector = [Ext "u"]+ , ftKind = KindLanguage+ , ftComment = ["{-" ~~ "-}", "--" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\"", "\"\"\"" ~~ "\"\"\""]+ , ftRawString = []+ , ftIdentifierChars = Just (isAlpha_', isAlphaNum_and ['!', '\''])+ , ftKeywords =+ types+ [ "Text"+ , "Number"+ , "Boolean"+ , "List"+ , "Optional"+ , "Maybe"+ , "Either"+ , "Tuple"+ , "Function"+ ]+ <> reserved+ [ "type"+ , "ability"+ , "structural"+ , "unique"+ , "if"+ , "then"+ , "else"+ , "forall"+ , "handle"+ , "with"+ , "where"+ , "use"+ , "true"+ , "false"+ , "alias"+ , "typeLink"+ , "termLink"+ , "let"+ , "namespace"+ , "match"+ , "cases"+ ]+ }+ )+ ,+ ( VHDL+ , FileTypeInfo+ { ftSelector = [Ext "vhd", Ext "vhdl"]+ , ftKind = KindLanguage+ , ftComment = ["--" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "std_logic"+ , "std_logic_vector"+ , "integer"+ , "real"+ , "boolean"+ , "character"+ , "string"+ , "time"+ , "bit"+ , "bit_vector"+ , "signed"+ , "unsigned"+ ]+ <> reserved+ [ "abs"+ , "access"+ , "after"+ , "alias"+ , "all"+ , "and"+ , "architecture"+ , "array"+ , "assert"+ , "attribute"+ , "begin"+ , "block"+ , "body"+ , "buffer"+ , "bus"+ , "case"+ , "component"+ , "configuration"+ , "constant"+ , "disconnect"+ , "downto"+ , "else"+ , "elsif"+ , "end"+ , "entity"+ , "exit"+ , "file"+ , "for"+ , "function"+ , "generate"+ , "generic"+ , "group"+ , "guarded"+ , "if"+ , "impure"+ , "in"+ , "inertial"+ , "inout"+ , "is"+ , "label"+ , "library"+ , "linkage"+ , "literal"+ , "loop"+ , "map"+ , "mod"+ , "nand"+ , "new"+ , "next"+ , "nor"+ , "not"+ , "null"+ , "of"+ , "on"+ , "open"+ , "or"+ , "others"+ , "out"+ , "package"+ , "port"+ , "postponed"+ , "procedure"+ , "process"+ , "pure"+ , "range"+ , "record"+ , "register"+ , "reject"+ , "return"+ , "rol"+ , "ror"+ , "select"+ , "severity"+ , "signal"+ , "shared"+ , "sla"+ , "sli"+ , "sra"+ , "srl"+ , "subtype"+ , "then"+ , "to"+ , "transport"+ , "type"+ , "unaffected"+ , "units"+ , "until"+ , "use"+ , "variable"+ , "wait"+ , "when"+ , "while"+ , "with"+ , "xnor"+ , "xor"+ ]+ }+ )+ ,+ ( Verilog+ , FileTypeInfo+ { ftSelector = [Ext "v", Ext "vh", Ext "sv"]+ , ftKind = KindLanguage+ , ftComment = ["/*" ~~ "*/", "//" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "wire"+ , "reg"+ , "integer"+ , "real"+ , "time"+ , "parameter"+ , "event"+ , "genvar"+ , "string"+ ]+ <> reserved+ [ "always"+ , "end"+ , "ifnone"+ , "or"+ , "rpmos"+ , "tranif1"+ , "and"+ , "endcase"+ , "initial"+ , "output"+ , "rtran"+ , "tri"+ , "assign"+ , "endmodule"+ , "inout"+ , "rtranif0"+ , "tri0"+ , "begin"+ , "endfunction"+ , "input"+ , "pmos"+ , "rtranif1"+ , "tri1"+ , "buf"+ , "endprimitive"+ , "posedge"+ , "scalared"+ , "triand"+ , "bufif0"+ , "endspecify"+ , "join"+ , "primitive"+ , "small"+ , "trior"+ , "bufif1"+ , "endtable"+ , "large"+ , "pull0"+ , "specify"+ , "trireg"+ , "case"+ , "endtask"+ , "macromodule"+ , "pull1"+ , "specparam"+ , "vectored"+ , "casex"+ , "medium"+ , "pullup"+ , "strong0"+ , "wait"+ , "casez"+ , "for"+ , "module"+ , "pulldown"+ , "strong1"+ , "wand"+ , "cmos"+ , "force"+ , "nand"+ , "rcmos"+ , "supply0"+ , "weak0"+ , "deassign"+ , "forever"+ , "negedge"+ , "supply1"+ , "weak1"+ , "default"+ , "for"+ , "nmos"+ , "realtime"+ , "table"+ , "while"+ , "defparam"+ , "function"+ , "nor"+ , "task"+ , "disable"+ , "highz0"+ , "not"+ , "release"+ , "wor"+ , "edge"+ , "highz1"+ , "notif0"+ , "repeat"+ , "tran"+ , "xnor"+ , "else"+ , "if"+ , "notif1"+ , "rnmos"+ , "tranif0"+ , "xor"+ ]+ }+ )+ ,+ ( Yaml+ , FileTypeInfo+ { ftSelector = [Ext "yaml", Ext "yml"]+ , ftKind = KindConfig+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "'" ~~ "'"]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Toml+ , FileTypeInfo+ { ftSelector = [Ext "toml", Name "Cargo.lock"]+ , ftKind = KindConfig+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\"", "\"\"\"" ~~ "\"\"\""]+ , ftRawString = ["'" ~~ "'", "'''" ~~ "'''"]+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Ini+ , FileTypeInfo+ { ftSelector = [Ext "ini"]+ , ftKind = KindConfig+ , ftComment = [";" ~~ "\n", "#" ~~ "\n"]+ , ftChar = []+ , ftString = ["\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Just (const False, const False)+ , ftKeywords = HM.empty+ }+ )+ ,+ ( Zig+ , FileTypeInfo+ { ftSelector = [Ext "zig"]+ , ftKind = KindLanguage+ , ftComment = ["//" ~~ "\n"]+ , ftChar = ["'" ~~ "'"]+ , ftString = ["\"" ~~ "\""]+ , ftRawString = ["\\" ~~ "\n"]+ , ftIdentifierChars = Nothing+ , ftKeywords =+ types+ [ "i8"+ , "u8"+ , "i16"+ , "u16"+ , "i32"+ , "u32"+ , "i64"+ , "u64"+ , "i128"+ , "u128"+ , "isize"+ , "usize"+ , "c_short"+ , "c_ushort"+ , "c_int"+ , "c_uint"+ , "c_long"+ , "c_ulong"+ , "c_longlong"+ , "c_ulonglong"+ , "c_longdouble"+ , "f16"+ , "f32"+ , "f64"+ , "f80"+ , "f128"+ , "bool"+ , "anyopaque"+ , "void"+ , "noreturn"+ , "type"+ , "anyerror"+ , "comptime_int"+ , "comptime_float"+ ]+ <> reserved+ [ "addrspace"+ , "align"+ , "allowzero"+ , "and"+ , "anyframe"+ , "anytype"+ , "asm"+ , "async"+ , "await"+ , "break"+ , "catch"+ , "comptime"+ , "const"+ , "continue"+ , "defer"+ , "else"+ , "enum"+ , "errdefer"+ , "error"+ , "export"+ , "extern"+ , "fn"+ , "for"+ , "if"+ , "inline"+ , "linksection"+ , "noalias"+ , "noinline"+ , "nosuspend"+ , "or"+ , "orelse"+ , "packed"+ , "pub"+ , "resume"+ , "return"+ , "struct"+ , "suspend"+ , "switch"+ , "test"+ , "threadlocal"+ , "try"+ , "union"+ , "unreachable"+ , "usingnamespace"+ , "var"+ , "volatile"+ , "while"+ ]+ }+ )+ ,+ ( Zsh+ , FileTypeInfo+ { ftSelector = [Ext "zsh"]+ , ftKind = KindScript+ , ftComment = ["#" ~~ "\n"]+ , ftChar = []+ , ftString = ["'" ~~ "'", "\"" ~~ "\""]+ , ftRawString = []+ , ftIdentifierChars = Nothing+ , ftKeywords =+ reserved+ [ "do"+ , "done"+ , "esac"+ , "then"+ , "elif"+ , "else"+ , "fi"+ , "for"+ , "case"+ , "if"+ , "while"+ , "function"+ , "repeat"+ , "time"+ , "until"+ , "select"+ , "coproc"+ , "nocorrect"+ , "foreach"+ , "end"+ ]+ }+ )+ ]+++reserved :: [C.ByteString] -> HM.HashMap C.ByteString WordType+reserved = HM.fromList . map (,Keyword)+{-# INLINE reserved #-}++types :: [C.ByteString] -> HM.HashMap C.ByteString WordType+types = HM.fromList . map (,NativeType)+{-# INLINE types #-}++mkFilterFunction :: Bool -> FileTypeInfo -> Maybe FilterFunction+mkFilterFunction alterBoundary FileTypeInfo{..} =+ Just $+ runContextFilter (mkParConfig ftComment ftString ftRawString ftChar alterBoundary)+{-# INLINE mkFilterFunction #-}++contextFilter :: Maybe FileType -> ContextFilter -> Bool -> Text8 -> Text8+contextFilter _ (isContextFilterAll -> True) False txt = txt+contextFilter Nothing _ _ txt = txt+contextFilter (Just ftype) filt alterBoundary txt+ | Just fun <- parFunc = fun filt txt+ | otherwise = txt+ where+ parFunc = mkFilterFunction alterBoundary =<< Map.lookup ftype (unMapInfo fileTypeInfoMap)+{-# INLINE contextFilter #-}++fileTypeLookup :: Options -> RawFilePath -> Maybe (FileType, FileKind)+fileTypeLookup opts f = forcedType opts <|> lookupFileType f+ where+ lookupFileType :: RawFilePath -> Maybe (FileType, FileKind)+ lookupFileType f = Map.lookup (Name $ takeFileName f) m <|> Map.lookup (Ext (C.dropWhile (== '.') $ takeExtension f)) m+ m = unMap fileTypeMap+{-# INLINE fileTypeLookup #-}+++fileTypeInfoLookup :: Options -> RawFilePath -> Maybe (FileType, FileTypeInfo)+fileTypeInfoLookup opts f = fileTypeLookup opts f >>= \(typ, kid) -> (typ,) <$> Map.lookup typ (unMapInfo fileTypeInfoMap)+{-# INLINE fileTypeInfoLookup #-}++fileTypeMap :: FileTypeMap+fileTypeMap = FileTypeMap $ Map.fromList $ concatMap (\(typ, FileTypeInfo{..}) -> map (, (typ, ftKind)) ftSelector) $ Map.toList (unMapInfo fileTypeInfoMap)+{-# NOINLINE fileTypeMap #-}++dumpFileTypeInfoMap :: FileTypeInfoMap -> IO ()+dumpFileTypeInfoMap m = forM_ ((Map.toList . unMapInfo) m) $ \(l, ex) ->+ putStrLn $ show l <> [' ' | _ <- [length (show l) .. 12]] <> "-> " <> show (ftSelector ex)++dumpFileTypeMap :: FileTypeMap -> IO ()+dumpFileTypeMap m = forM_ (Map.toList (unMap m)) $ \(ext, l) ->+ putStrLn $ show ext <> [' ' | _ <- [length (show ext) .. 12]] <> "-> " <> show l++forcedType :: Options -> Maybe (FileType, FileKind)+forcedType Options{type_force = l}+ | Just typ <- l = Map.lookup (Ext $ C.pack typ) m <|> Map.lookup (Name $ C.pack typ) m+ | otherwise = Nothing+ where m = unMap fileTypeMap++(~~) :: C.ByteString -> C.ByteString -> Boundary+(~~) = Boundary+{-# INLINE (~~) #-}
− src/CGrep/Filter.hs
@@ -1,237 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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 RecordWildCards #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}--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- } deriving (Show)---data ParState = ParState- { cxtState :: !ContextState- , display :: !Bool- , skip :: {-# UNPACK #-} !Int- } deriving (Show)---data ContextState = CodeState | CommState {-# UNPACK #-} !Int | LitrState {-# UNPACK #-} !Int- deriving (Show, Eq, Ord)----- filter Context:-----mkContextFilter :: Options -> ContextFilter-mkContextFilter Options{..} =- if not (code || comment || literal)- then ContextFilter { getFilterCode = True, getFilterComment = True, getFilterLiteral = True }- else ContextFilter { getFilterCode = code , getFilterComment = comment , getFilterLiteral = literal }---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 = commfilt, 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 = commfilt, 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- [ (Assembly, mkFilterFunction [("#", "\n"), (";", "\n"), ("|", "\n"), ("!", "\n"), ("/*", "*/")] [("\"", "\"")] )- , (Awk, mkFilterFunction [("#", "\n")] [("\"", "\"")] )- , (C, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (CMake, mkFilterFunction [("#", "\n")] [("\"", "\"")] )- , (Cabal, mkFilterFunction [("--", "\n")] [("\"", "\"")] )- , (Chapel, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Clojure, mkFilterFunction [(";", "\n")] [("\"", "\"")] )- , (Coffee, mkFilterFunction [("###", "###"), ("#", "\n")] [("\"", "\"")] )- , (Conf, mkFilterFunction [("#", "\n")] [("'", "'"), ("\"", "\"")] )- , (Cpp, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Csharp, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Css, mkFilterFunction [("/*", "*/")] [("\"", "\"")] )- , (D, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Dart, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\""), ("'", "'")] )- , (Elixir, mkFilterFunction [("#", "\n")] [("\"", "\"")] )- , (Erlang, mkFilterFunction [("%", "\n")] [("\"", "\"")] )- , (Fsharp, mkFilterFunction [("(*", "*)"), ("//", "\n")] [("\"", "\"")] )- , (Go, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Haskell, mkFilterFunction [("{-", "-}"), ("--", "\n")] [("\"", "\""), ("[r|", "|]"), ("[q|", "|]"), ("[s|", "|]"), ("[here|","|]"), ("[i|", "|]")] )- , (Html, mkFilterFunction [("<!--", "-->")] [("\"", "\"")] )- , (Idris, mkFilterFunction [("{-", "-}"), ("--", "\n"), ("|||", "\n")] [("\"", "\"")] )- , (Java, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Javascript, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Kotlin, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\""), ("'","'"), ("\"\"\"", "\"\"\"")] )- , (Latex, mkFilterFunction [("%", "\n")] [("\"", "\"")] )- , (Lua, mkFilterFunction [("--[[","--]]"), ("--", "\n")] [("'", "'"), ("\"", "\""), ("[===[", "]===]"), ("[==[", "]==]"), ("[=[", "]=]"), ("[[", "]]") ] )- , (Make, mkFilterFunction [("#", "\n")] [("'", "'"), ("\"", "\"")] )- , (Nmap, mkFilterFunction [("--", "\n"), ("[[","]]")] [("'", "'"), ("\"", "\"")])- , (OCaml, mkFilterFunction [("(*", "*)")] [("\"", "\"")] )- , (ObjectiveC, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (PHP, mkFilterFunction [("/*", "*/"), ("//", "\n"), ("#", "\n") ] [("'", "'"), ("\"", "\"")] )- , (Perl, mkFilterFunction [("=pod", "=cut"), ("#", "\n")] [("'", "'"), ("\"", "\"")] )- , (Python, mkFilterFunction [("#", "\n")] [("\"\"\"", "\"\"\""), ("'''", "'''"), ("'", "'"), ("\"", "\"")] )- , (Ruby, mkFilterFunction [("=begin", "=end"), ("#", "\n")] [("'", "'"), ("\"", "\""), ("%|", "|"), ("%q(", ")"), ("%Q(", ")") ])- , (Scala, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Shell, mkFilterFunction [("#", "\n")] [("'", "'"), ("\"", "\"")] )- , (Swift, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Tcl, mkFilterFunction [("#", "\n")] [("\"", "\"")] )- , (VHDL, mkFilterFunction [("--", "\n")] [("\"", "\"")] )- , (Verilog, mkFilterFunction [("/*", "*/"), ("//", "\n")] [("\"", "\"")] )- , (Vim, mkFilterFunction [("\"", "\n")] [("'", "'")] )- , (Yaml, mkFilterFunction [("#", "\n")] [("\"", "\"")] )- ]
− src/CGrep/Lang.hs
@@ -1,147 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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 TupleSections #-}--module CGrep.Lang ( Lang(..)- , langMap- , getFileLang- , 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 = Assembly | Awk | C | CMake | Cabal | Chapel | Clojure | Coffee | Conf | Cpp | Csharp | Css |- D | Dart | Elixir | Erlang | Fortran | Fsharp | Go | Haskell | Html | Idris | Java | Javascript | Kotlin |- Latex | Lua | Make | Nmap | OCaml | ObjectiveC | PHP | Perl | Python | Ruby | Scala | Shell | Swift | Tcl |- Text | VHDL | Verilog | Vim | Yaml- 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- [ (Assembly, [Ext "s", Ext "S"])- , (Awk, [Ext "awk", Ext "mawk", Ext "gawk"])- , (C, [Ext "c", Ext "C", Ext "inc"])- , (CMake, [Name "CMakeLists.txt", Ext "cmake"])- , (Cabal, [Ext "cabal"])- , (Chapel, [Ext "chpl"])- , (Clojure, [Ext "clj", Ext "cljs", Ext "cljc", Ext "edn"])- , (Coffee, [Ext "coffee"])- , (Conf, [Ext "config", Ext "conf", Ext "cfg", Ext "doxy"])- , (Cpp, [Ext "cpp", Ext "CPP", Ext "cxx", Ext "cc", Ext "cp", Ext "c++", Ext "tcc",- Ext "h", Ext "H", Ext "hpp", Ext "ipp", Ext "HPP", Ext "hxx", Ext "hh", Ext "hp", Ext "h++",- Ext "cu", Ext "cuh"])- , (Csharp, [Ext "cs", Ext "CS"])- , (Css, [Ext "css"])- , (D, [Ext "d", Ext "D"])- , (Dart, [Ext "dart"])- , (Elixir, [Ext "ex", Ext "exs"])- , (Erlang, [Ext "erl", Ext "ERL",Ext "hrl", Ext "HRL"])- , (Fortran, [Ext "f", Ext "for", Ext "ftn",- Ext "F", Ext "FOR", Ext "FTN", Ext "fpp", Ext "FPP",- Ext "f90", Ext "f95", Ext "f03", Ext "f08",- Ext "F90", Ext "F95", Ext "F03", Ext "F08"])- , (Fsharp, [Ext "fs", Ext "fsx", Ext "fsi"])- , (Go, [Ext "go"])- , (Haskell, [Ext "hs", Ext "lhs", Ext "hsc"])- , (Html, [Ext "htm", Ext "html"])- , (Idris, [Ext "idr", Ext "lidr"])- , (Java, [Ext "java"])- , (Javascript,[Ext "js"])- , (Kotlin, [Ext "kt", Ext "kts", Ext "ktm"])- , (Latex, [Ext "latex", Ext "tex"])- , (Lua, [Ext "lua"])- , (Make, [Name "Makefile", Name "makefile", Name "GNUmakefile", Ext "mk", Ext "mak"])- , (Nmap, [Ext "nse"])- , (OCaml , [Ext "ml", Ext "mli"])- , (ObjectiveC,[Ext "m", Ext "mi"])- , (PHP, [Ext "php", Ext "php3", Ext "php4", Ext "php5",Ext "phtml"])- , (Perl, [Ext "pl", Ext "pm", Ext "pm6", Ext "plx", Ext "perl"])- , (Python, [Ext "py", Ext "pyx", Ext "pxd", Ext "pxi", Ext "scons"])- , (Ruby, [Ext "rb", Ext "ruby"])- , (Scala, [Ext "scala"])- , (Shell, [Ext "sh", Ext "bash", Ext "csh", Ext "tcsh", Ext "ksh", Ext "zsh"])- , (Swift, [Ext "swift"])- , (Tcl, [Ext "tcl", Ext "tk"])- , (Text, [Ext "txt", Ext "md", Ext "markdown", Ext "mdown", Ext "mkdn", Ext "mkd", Ext "mdwn", Ext "mdtxt", Ext "mdtext", Ext "text", Name "README", Name "INSTALL", Name "VERSION", Name "LICENSE", Name "AUTHORS", Name "CHANGELOG"])- , (VHDL, [Ext "vhd", Ext "vhdl"])- , (Verilog, [Ext "v", Ext "vh", Ext "sv"])- , (Vim, [Ext "vim"])- , (Yaml, [Ext "yaml", Ext "yml"])- ]---langRevMap :: LangRevMapType-langRevMap = Map.fromList $ concatMap (\(l, xs) -> map (,l) xs ) $ Map.toList langMap---- utility functions--lookupFileLang :: FilePath -> Maybe Lang-lookupFileLang 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{ language_force = l }- | Nothing <- l = Nothing- | otherwise = Map.lookup (Ext $ fromJust l) langRevMap <|> Map.lookup (Name $ fromJust l) langRevMap---getFileLang :: Options -> FilePath -> Maybe Lang-getFileLang opts f = forcedLang opts <|> lookupFileLang f---dumpLangMap :: LangMapType -> IO ()-dumpLangMap m = forM_ (Map.toList m) $ \(l, ex) ->- putStrLn $ show l ++ [ ' ' | _ <- [length (show l)..12]] ++ "-> " ++ show ex---dumpLangRevMap :: LangRevMapType -> IO ()-dumpLangRevMap m = forM_ (Map.toList m) $ \(ext, l) ->- putStrLn $ show ext ++ [ ' ' | _ <- [length (show ext)..12 ]] ++ "-> " ++ show l---splitLangList :: [String] -> ([Lang], [Lang], [Lang])-splitLangList = foldl run ([],[],[])- where run :: ([Lang], [Lang], [Lang]) -> String -> ([Lang], [Lang], [Lang])- run (l1, l2, l3) l- | '+':xs <- l = (l1, prettyRead xs "Lang" : l2, l3)- | '-':xs <- l = (l1, l2, prettyRead xs "Lang" : l3)- | otherwise = (prettyRead l "Lang" : l1, l2, l3)
src/CGrep/Output.hs view
@@ -1,5 +1,6 @@--- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io> --+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+-- -- 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@@ -15,293 +16,258 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-} module CGrep.Output ( Output(..)- , mkOutput- , putPrettyHeader- , putPrettyFooter- , prettyOutput+ , mkOutputElements+ , putOutputElements+ , runSearch , showFileName- , showFile , showBold) where import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as B+ import qualified Data.ByteString.Char8 as C-import qualified Codec.Binary.UTF8.String as UC+import qualified Data.ByteString.Lazy.Char8 as LC+import qualified Data.ByteString.Unsafe as BU -import Text.Show.Unicode-import System.Console.ANSI+import qualified Data.Vector.Unboxed as UV -#ifdef ENABLE_HINT-import Language.Haskell.Interpreter-#endif+import Data.Vector.Unboxed ( (!) ) -import Control.Monad.Trans.Reader-import Control.Monad.IO.Class+import System.Console.ANSI+ ( setSGRCode,+ ConsoleIntensity(BoldIntensity),+ SGR(SetConsoleIntensity) ) -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif+import Control.Monad.Trans.Reader ( ask, reader )+import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import Data.Maybe import Data.List-import Data.Function+ ( foldl', sortBy, groupBy, isPrefixOf, nub, sort, genericLength, intersperse )+import Data.Function ( on ) -import CGrep.Types-import CGrep.Token+import CGrep.Types ( Text8, Offset )+import CGrep.Parser.Chunk ( Chunk(..), MatchLine(..) ) -import Options-import Util-import Config-import Reader-import Safe+import Config ( Config(configColorFile, configColorMatch) )+import Reader ( ReaderIO, Env(..) )+import Data.Int ( Int64 )+import Data.Word ( Word8 )+import Data.ByteString.Internal (c2w)+import qualified Data.Vector.Fusion.Util as VU (Box(..)) +import System.Posix.FilePath (RawFilePath) +import qualified Data.Vector.Generic as GV+import CGrep.Parser.Line ( getLineOffsets )+import Options+ ( Options(Options, invert_match, json, filename_only, no_shallow,+ no_filename, count, no_color, no_numbers, no_column, show_match,+ color) )+ data Output = Output- { outFilePath :: FilePath- , outLineNo :: Int- , outLine :: Text8- , outTokens :: [Token]+ { outFilePath :: RawFilePath+ , outLineNumb :: {-# UNPACK #-} !Int64+ , outLine :: {-# UNPACK #-} !Text8+ , outChunks :: ![Chunk] }- deriving (Show) +outTokens :: Output -> [Text8]+outTokens (Output fp ln l cs) = cToken <$> cs+{-# INLINE outTokens #-} -getOffsetsLines :: Text8 -> [Int]-getOffsetsLines txt = let l = C.length txt in filter (<(l-1)) $ C.elemIndices '\n' txt +insertIndex :: UV.Vector Offset -> Offset -> Int+insertIndex vs x = search vs 0 (UV.length vs)+ where search xs !lo !hi+ | lo == hi = lo+ | otherwise = let !mid = (lo + hi) `quot` 2+ in if x < VU.unBox(xs `GV.basicUnsafeIndexM` mid)+ then search xs lo mid+ else search xs (mid+1) hi -getOffset2d :: [OffsetLine] -> Offset -> Offset2d-getOffset2d idx off =- let prc = filter (< off) idx- (len_prc, last_prc) = foldl' (\(len,_) cur -> (len + 1, cur)) (0,off) prc- in (len_prc, off - last_prc - 1) +getLineNumberAndOffset :: UV.Vector Offset -> Offset -> (# Int, Offset #)+getLineNumberAndOffset xs x =+ let idx = insertIndex xs x+ in (# idx, x - xs `UV.unsafeIndex` (idx-1) #)+{-# INLINE getLineNumberAndOffset #-} -mkOutput :: (Monad m) => FilePath -> Text8 -> Text8 -> [Token] -> OptionT m [Output]-mkOutput f text multi ts = do- invert <- reader (invert_match . snd)- return $ if invert then map (\(n, xs) -> Output f n (ls !! (n-1)) xs) . invertMatchLines (length ls) $ mkMatchLines multi ts- else map (\(n, xs) -> Output f n (ls !! (n-1)) xs) $ mkMatchLines multi ts++mkOutputElements :: UV.Vector Int64 -> RawFilePath -> Text8 -> Text8 -> [Chunk] -> ReaderIO [Output]+mkOutputElements lineOffsets f text multi ts = do+ invert <- invert_match <$> reader opt+ return $ if invert then map (\(MatchLine n xs) -> Output f n (ls !! fromIntegral (n-1)) xs) . invertLines (length ls) $ mkMatchLines lineOffsets multi ts+ else map (\(MatchLine n xs) -> Output f n (ls !! fromIntegral (n-1)) xs) $ mkMatchLines lineOffsets multi ts where ls = C.lines text+{-# INLINE mkOutputElements #-} -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+mkMatchLines :: UV.Vector Int64 -> Text8 -> [Chunk] -> [MatchLine]+mkMatchLines lineOffsets _ [] = []+mkMatchLines lineOffsets text ts = map mergeGroup $ groupBy ((==) `on` lOffset) . sortBy (compare `on` lOffset) $+ (\chunk -> let (# r, c #) = getLineNumberAndOffset lineOffsets (cOffset chunk) in MatchLine (fromIntegral r) [Chunk (cTyp chunk) (cToken chunk) c]) <$> ts+ where mergeGroup :: [MatchLine] -> MatchLine+ mergeGroup ls = MatchLine ((lOffset . head) ls) (foldl' (\l m -> l <> lChunks m) [] ls) -invertMatchLines :: Int -> [MatchLine] -> [MatchLine]-invertMatchLines n xs = filter (\(i,_) -> i `notElem` idx ) $ take n [ (i, []) | i <- [1..]]- where idx = map fst xs+invertLines :: Int -> [MatchLine] -> [MatchLine]+invertLines n xs = filter (\(MatchLine i _) -> i `notElem` idx ) $ take n [ MatchLine i [] | i <- [1..]]+ where idx = lOffset <$> xs+{-# INLINE invertLines #-} -putPrettyHeader :: OptionT IO ()-putPrettyHeader = do- (_,opt) <- ask- case () of- _ | json opt -> liftIO $ putStrLn "["- | xml opt -> liftIO $ putStrLn "<?xml version=\"1.0\"?>" >> putStrLn "<cgrep>"- | otherwise -> return ()-+putOutputElements :: [Output] -> ReaderIO (Maybe B.Builder)+putOutputElements [] = pure Nothing+putOutputElements out = do+ Env{..} <- ask+ if | json opt -> Just <$> jsonOutput out+ | filename_only opt -> Just <$> filenameOutput out+ | otherwise -> Just <$> defaultOutput out -putPrettyFooter :: OptionT IO ()-putPrettyFooter = do- (_,opt) <- ask- case () of- _ | json opt -> liftIO $ putStrLn "]"- | xml opt -> liftIO $ putStrLn "</cgrep>"- | otherwise -> return ()+runSearch :: Options+ -> RawFilePath+ -> Bool+ -> ReaderIO [Output]+ -> ReaderIO [Output]+runSearch opt filename eligible doSearch =+ if eligible || no_shallow opt+ then doSearch+ else mkOutputElements UV.empty filename C.empty C.empty ([] :: [Chunk]) -prettyOutput :: (Monad m) => [Output] -> OptionT m [String]-prettyOutput out = do- (_,opt) <- ask- case () of- _ | isJust $ format opt -> mapM formatOutput out- | filename_only opt -> filenameOutput out- | json opt -> jsonOutput out- | xml opt -> xmlOutput out-#ifdef ENABLE_HINT- | isJust $ hint opt -> hintOputput out-#endif- | otherwise -> defaultOutput out--defaultOutput :: (Monad m) => [Output] -> OptionT m [String]+defaultOutput :: [Output] -> ReaderIO B.Builder defaultOutput xs = do- (conf,opt) <- ask- case () of- _ | Options{ no_filename = False, no_numbers = False , count = False } <- opt- -> return $ map (\out -> concat $ [showFile conf, showSep ":", showLineCol, showSep ":", showTokens, showLine conf] <*> [opt] <*> [out]) xs-- | Options{ no_filename = False, no_numbers = True , count = False } <- opt- -> return $ map (\out -> concat $ [showFile conf, showSep ":", showTokens, showLine conf] <*> [opt] <*> [out] ) xs-- | Options{ no_filename = True , no_numbers = False , count = False } <- opt- -> return $ map (\out -> concat $ [showLineCol, showSep ":", showTokens, showLine conf] <*> [opt] <*> [out] ) xs-- | Options{ no_filename = True , no_numbers = True , count = False } <- opt- -> return $ map (\out -> concat $ [showTokens, showLine conf] <*> [opt] <*> [out]) xs-- | Options{ no_filename = False, count = True } <- opt -> do let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs- return $ map (\ys@(y:_) -> showFile conf opt y ++ ":" ++ show (length ys)) gs-- | Options{ count = True } <- opt -> do let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs- return $ map (show . length) gs- | otherwise -> undefined---jsonOutput :: (Monad m) => [Output] -> OptionT m [String]-jsonOutput outs = return $- [" { \"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 ++ "}" ]+ Env{..} <- ask+ if | Options{ no_filename = False, no_numbers = False , count = False } <- opt+ -> pure $ mconcat . intersperse (B.char8 '\n') $ map (\out -> buildFileName conf opt out <> B.char8 ':' <> buildLineCol opt out <> B.char8 ':' <> buildTokens opt out <> buildLine conf opt out) xs + | Options{ no_filename = False, no_numbers = True , count = False } <- opt+ -> pure $ mconcat . intersperse (B.char8 '\n') $ map (\out -> buildFileName conf opt out <> B.char8 ':' <> buildTokens opt out <> buildLine conf opt out) xs -filenameOutput :: (Monad m) => [Output] -> OptionT m [String]-filenameOutput outs = return $ nub $ map (\(Output fname _ _ _) -> fname) outs+ | Options{ no_filename = True , no_numbers = False , count = False } <- opt+ -> pure $ mconcat . intersperse (B.char8 '\n') $ map (\out -> buildTokens opt out <> buildLine conf opt out) xs + | Options{ no_filename = True , no_numbers = True , count = False } <- opt+ -> pure $ mconcat . intersperse (B.char8 '\n') $ map (\out -> buildTokens opt out <> buildLine conf opt out) xs -xmlOutput :: (Monad m) => [Output] -> OptionT m [String]-xmlOutput outs = return $- ["<file name=" ++ show fname ++ ">" ] ++- ["<matches>" ] ++- [foldl mkMatch "" outs] ++- ["</matches>"] ++- ["</file>"]- where fname | (Output f _ _ _) <- head outs = f- mkToken (n, xs) = "<token col=\"" ++ show n ++ "\" >" ++ xs ++ "</token>"- mkMatch xs (Output _ n l ts) = xs ++ "<match line=" ++ show l ++ " row=\"" ++ show n ++ "\">" ++- unwords (map mkToken ts) ++- "</match>"+ | Options{ no_filename = False, count = True } <- opt+ -> do+ let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs+ pure $ mconcat . intersperse (B.char8 '\n') $ (\ys@(y:_) -> buildFileName conf opt y <> B.char8 ':' <> B.intDec (length ys)) <$> gs+ | Options{ count = True } <- opt+ -> do+ let gs = groupBy (\(Output f1 _ _ _) (Output f2 _ _ _) -> f1 == f2) xs+ pure $ mconcat . intersperse (B.char8 '\n') $ (\ys@(y:_) -> B.intDec (length ys)) <$> gs -formatOutput :: (Monad m) => Output -> OptionT m String-formatOutput out = do- (conf,opt) <- ask- return $ replace (fromJust $ format opt)- [- ("#f", showFile conf opt out),- ("#n", showLineCol opt out),- ("#l", showLine conf opt out),- ("#t", ushow 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 ts' = map snd (outTokens out)+jsonOutput :: [Output] -> ReaderIO B.Builder+jsonOutput [] = pure mempty+jsonOutput outs = pure $ mconcat . intersperse (B.char8 '\n') $+ [B.byteString "{ \"file\":\"" <> B.byteString fname <> B.byteString "\", \"matches\":["] <>+ [ mconcat $ intersperse (B.char8 ',') (foldl mkMatch [] outs) ] <> [B.byteString "]}"]+ where fname | (Output f _ _ _) <- head outs = f+ mkJToken chunk = B.byteString "{ \"col\":" <> B.int64Dec (cOffset chunk) <> B.byteString ", \"token\":\"" <> B.byteString (cToken chunk) <> B.byteString "\" }"+ mkMatch xs (Output _ n _ ts) =+ xs <> [B.byteString "{ \"row\": " <> B.int64Dec n <> B.byteString ", \"tokens\":[" <>+ mconcat (intersperse (B.byteString ",") (map mkJToken ts)) <> B.byteString "] }" ] -replace :: String -> [(String, String)] -> String-replace ys@(x:xs) pats =- let pats' = filter ((`isPrefixOf` ys) . fst) pats in- if null pats' then x : replace xs pats- else let new = head pats' in snd new ++ replace (drop (length(fst new) - 1) xs) pats-replace [] _ = []+filenameOutput :: [Output] -> ReaderIO B.Builder+filenameOutput outs = return $ mconcat . intersperse (B.char8 '\n') $ B.byteString <$> nub ((\(Output fname _ _ _) -> fname) <$> outs)+{-# INLINE filenameOutput #-} -#ifdef ENABLE_HINT-hintOputput :: [Output] -> OptionT IO [String]-hintOputput outs = do- (_,opt) <- ask- let cmds = map mkCmd outs- out <- runInterpreter $ setImports ["Prelude", "Data.List"] >> mapM (`interpret` (as :: String)) cmds- return $ either ((:[]) . show) id out- where mkCmd out@(Output f n l ts) = "let a # b = a !! b " ++- "; file = " ++ show (showFile opt out) ++- "; row = " ++ show n ++- "; line = " ++ show (showLine conf opt ts l) ++- "; tokens = " ++ ushow (map snd ts) ++ " in " ++- (fromJust $ hint opt)-#endif--bold, resetTerm :: String-bold = setSGRCode [SetConsoleIntensity BoldIntensity]-resetTerm = setSGRCode []+bold, reset :: C.ByteString+bold = C.pack $ setSGRCode [SetConsoleIntensity BoldIntensity]+reset = C.pack $ setSGRCode []+{-# NOINLINE bold #-}+{-# NOINLINE reset #-} +boldBuilder, resetBuilder :: B.Builder+boldBuilder = B.byteString bold+resetBuilder = B.byteString reset+{-# NOINLINE boldBuilder #-}+{-# NOINLINE resetBuilder #-} -type ColorString = String+type ColorString = C.ByteString -showSep :: String -> Options -> Output -> String-showSep xs _ _ = xs+buildFileName :: Config -> Options -> Output -> B.Builder+buildFileName conf opt = buildFileName' conf opt . outFilePath+ where buildFileName' :: Config -> Options -> B.ByteString -> B.Builder+ buildFileName' conf opt = buildColoredAs opt $ C.pack (setSGRCode (configColorFile conf))+{-# INLINE buildFileName #-} -showFile :: Config -> Options -> Output -> String-showFile conf opt = showFileName conf opt . outFilePath+buildColoredAs :: Options -> ColorString -> B.ByteString -> B.Builder+buildColoredAs Options { color = c, no_color = c'} colorCode str+ | c && not c'= B.byteString colorCode <> B.byteString str <> resetBuilder+ | otherwise = B.byteString str+{-# INLINE buildColoredAs #-} -showLineCol :: Options -> Output -> String-showLineCol Options{no_numbers = True } _ = ""-showLineCol Options{no_numbers = False, no_column = True } (Output _ n _ _) = show n-showLineCol Options{no_numbers = False, no_column = False } (Output _ n _ []) = show n-showLineCol Options{no_numbers = False, no_column = False } (Output _ n _ ts) = show n ++ ":" ++ show ((+1) . fst . head $ ts)+buildLineCol :: Options -> Output -> B.Builder+buildLineCol Options{no_numbers = True } _ = mempty+buildLineCol Options{no_numbers = False, no_column = True } (Output _ n _ _) = B.int64Dec n+buildLineCol Options{no_numbers = False, no_column = False } (Output _ n _ []) = B.int64Dec n+buildLineCol Options{no_numbers = False, no_column = False } (Output _ n _ ts) = B.int64Dec n <> B.char8 ':' <> B.int64Dec ((+1) . cOffset . head $ ts)+{-# INLINE buildLineCol #-} -showTokens :: Options -> Output -> String-showTokens Options { show_match = st } out- | st = ushow (map snd (outTokens out))- | otherwise = ""+buildTokens :: Options -> Output -> B.Builder+buildTokens Options { show_match = st } out+ | st = boldBuilder <> mconcat (B.byteString <$> outTokens out) <> resetBuilder <> B.char8 ':'+ | otherwise = mempty -showLine :: Config -> Options -> Output -> String-showLine conf Options { color = c, no_color = c' } out- | c && not c'= hilightLine conf (sortBy (flip compare `on` (length . snd )) (outTokens out)) line- | otherwise = line- where line = UC.decode $ B.unpack $ outLine out+buildLine :: Config -> Options -> Output -> B.Builder+buildLine conf Options { color = c, no_color = c' } out+ | c && not c'= highlightLine conf (sortBy (flip compare `on` (C.length . cToken)) (outChunks out)) (outLine out)+ | otherwise = B.byteString $ outLine out+{-# INLINE buildLine #-} -showFileName :: Config -> Options -> String -> String-showFileName conf opt = showColoredAs opt $ setSGRCode (configColorFile conf)+showFileName :: Config -> Options -> RawFilePath -> RawFilePath+showFileName conf opt = showColoredAs opt $ C.pack (setSGRCode (configColorFile conf))+{-# INLINE showFileName #-} -showBold :: Options -> String -> String+showBold :: Options -> C.ByteString -> C.ByteString showBold opt = showColoredAs opt bold+{-# INLINE showBold #-} -showColoredAs :: Options -> ColorString -> String -> String+showColoredAs :: Options -> C.ByteString -> C.ByteString -> C.ByteString showColoredAs Options { color = c, no_color = c'} colorCode str- | c && not c'= colorCode ++ str ++ resetTerm+ | c && not c'= colorCode <> str <> reset | otherwise = str+{-# INLINE showColoredAs #-} -hilightLine :: Config -> [Token] -> String -> String-hilightLine conf ts = hilightLine' (hilightIndicies ts, 0, 0)- where hilightLine' :: ([(Int, Int)], Int, Int) -> String -> String- hilightLine' _ [] = []- hilightLine' (ns, n, bs) s@(x:_) = (case () of- _ | check && bs' == 0 -> if fst stack > 0 then colorMatch ++ [x] ++ resetTerm- else x : resetTerm- | check && bs' > 0 -> colorMatch ++ [x]- | otherwise -> next- ) ++ hilightLine' (ns, n + nn, bs') rest+highlightLine :: Config -> [Chunk] -> Text8 -> B.Builder+highlightLine conf ts = highlightLine' (highlightIndexes ts, 0, 0)+ where highlightLine' :: ([(Int64, Int64)], Int64, Int) -> C.ByteString -> B.Builder+ highlightLine' _ (C.uncons -> Nothing) = mempty+ highlightLine' (ns, !n, !bs) s@(C.uncons -> Just (x,_)) =+ (if | check && bs' == 0 -> if fst stack > 0 then B.string8 colorMatch <> B.char8 x <> resetBuilder else B.char8 x <> resetBuilder+ | check && bs' > 0 -> B.string8 colorMatch <> B.char8 x+ | otherwise -> B.byteString next) <> highlightLine' (ns, n + nn, bs') rest where stack = foldr (\(a, b) (c, d) -> (c + fromEnum (a == n), d + fromEnum (b == n))) (0, 0) ns check = fst stack > 0 || snd stack > 0 colorMatch = setSGRCode (configColorMatch conf) bs' = bs + fst stack - snd stack plain = nub . sort $ foldr (\(a, b) acc -> a : b : acc) [] ns nn | check = 1- | null plain' = length s+ | null plain' = fromIntegral (C.length s) | otherwise = head plain' - n where plain' = dropWhile (<=n) plain- (next, rest) = splitAt nn s+ (next, rest) = C.splitAt (fromIntegral nn) s+ highlightLine' _ _ = undefined -hilightIndicies :: [Token] -> [(Int, Int)]-hilightIndicies = foldr (\t a -> let b = fst t in (b, b + length (snd t) - 1) : a) [] . filter (notNull . snd)+highlightIndexes :: [Chunk] -> [(Int64, Int64)]+highlightIndexes = foldr (\chunk a -> let b = cOffset chunk in (fromIntegral b, b + fromIntegral (C.length (cToken chunk)) - 1) : a) [] . filter (not. B.null . cToken)+{-# INLINE highlightIndexes #-}
+ src/CGrep/Parser/Atom.hs view
@@ -0,0 +1,221 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Parser.Atom (Atom(..), Atoms,+ mkAtomFromToken,+ combineAtoms,+ filterTokensWithAtoms,+ wildCardMap,+ wildCardMatch,+ wildCardsMatch) where++import qualified Data.Map as M++import CGrep.Common ( trim, trim8 )+import CGrep.Distance ( (~==) )+import CGrep.Parser.Char ( isDigit )++import Data.List+ ( isSuffixOf, findIndices, isInfixOf, isPrefixOf, subsequences )+import Options+ ( Options(edit_dist, word_match, prefix_match, suffix_match) )+import Util ( spanGroup, rmQuote8 )++import qualified CGrep.Parser.Token as T+import qualified Data.ByteString.Char8 as C+import qualified CGrep.Parser.Chunk as T++data Atom =+ Any |+ Keyword |+ Number |+ Oct |+ Hex |+ String |+ Literal |+ Identifier C.ByteString |+ Raw T.Token+ deriving stock (Eq, Ord, Show)++type Atoms = [Atom]++wildCardMap :: M.Map C.ByteString Atom+wildCardMap = M.fromList+ [+ ("ANY", Any ),+ ("KEY", Keyword ),+ ("OCT", Oct ),+ ("HEX", Hex ),+ ("NUM", Number ),+ ("STR", String ),+ ("LIT", String )+ ]++mkAtomFromToken :: T.Token -> Atom+mkAtomFromToken t+ | T.isTokenIdentifier t = case () of+ _ | Just wc <- M.lookup str wildCardMap -> wc+ | isAtomIdentifier str -> Identifier str+ | otherwise -> Raw $ T.mkTokenIdentifier (rmAtomEscape str) (T.tOffset t)+ where str = T.tToken t+ | otherwise = Raw t+++combineAtoms :: [Atoms] -> [Atoms]+combineAtoms (m1:r@(m2:m3:ms))+ | [Raw b] <- m2, T.tToken b == "OR" = combineAtoms $ (m1<>m3):ms+ | otherwise = m1 : combineAtoms r+combineAtoms [m1,m2] = [m1,m2]+combineAtoms [m1] = [m1]+combineAtoms [] = []+++{-# INLINE filterTokensWithAtoms #-}+filterTokensWithAtoms :: Options -> [Atoms] -> [T.Token] -> [T.Token]+filterTokensWithAtoms opt ws ts = go opt (spanOptionalCards ws) ts+ where go :: Options -> [[Atoms]] -> [T.Token] -> [T.Token]+ go _ [] _ = []+ go opt (g:gs) ts =+ {-# SCC "atom_find_total" #-} concatMap (take grpLen . (`drop` ts)) ({-# SCC "atom_find_indices" #-} findIndices (wildCardsCompare opt g) grp) <> {-# SCC atom_find_req #-} go opt gs ts+ where grp = {-# SCC "atomSpanGroup" #-} spanGroup grpLen ts+ grpLen = length g+++spanOptionalCards :: [Atoms] -> [[Atoms]]+spanOptionalCards wc = map (`filterCardIndices` wc') idx+ where wc' = zip [0..] wc+ idx = subsequences $+ findIndices (\case+ [Identifier (C.uncons -> Just ('$', _))] -> True+ _ -> False) wc+++filterCardIndices :: [Int] -> [(Int, Atoms)] -> [Atoms]+filterCardIndices ns ps = map snd $ filter (\(n, _) -> n `notElem` ns) ps+{-# INLINE filterCardIndices #-}+++wildCardsCompare :: Options -> [Atoms] -> [T.Token] -> Bool+wildCardsCompare opt l r =+ wildCardsCompareAll ts && wildCardsCheckOccurrences ts+ where ts = wildCardsGroupCompare opt l r+{-# INLINE wildCardsCompare #-}+++isAtomIdentifier :: C.ByteString -> Bool+isAtomIdentifier s =+ if | Just (x, C.uncons -> Just (y, xs)) <- C.uncons s -> wprefix x && isDigit y+ | Just (x, "") <- C.uncons s -> wprefix x+ | otherwise -> error "isAtomIdentifier"+ where wprefix x = x == '$' || x == '_'+++rmAtomEscape :: C.ByteString -> C.ByteString+rmAtomEscape (C.uncons -> Just ('$',xs)) = xs+rmAtomEscape (C.uncons -> Just ('_',xs)) = xs+rmAtomEscape xs = xs+{-# INLINE rmAtomEscape #-}+++wildCardsCompareAll :: [(Bool, (Atoms, [C.ByteString]))] -> Bool+wildCardsCompareAll = all fst+{-# INLINE wildCardsCompareAll #-}+{-# SCC wildCardsCompareAll #-}++-- Note: pattern $ and _ match any token, whereas $1 $2 (_1 _2 etc.) match tokens+-- that must compare equal in the respective occurrences++wildCardsCheckOccurrences :: [(Bool, (Atoms, [C.ByteString]))] -> Bool+wildCardsCheckOccurrences ts = M.foldr (\xs r -> r && all (== head xs) xs) True m+ where m = M.mapWithKey (\k xs ->+ case k of+ [Identifier "_0"] -> xs+ [Identifier "_1"] -> xs+ [Identifier "_2"] -> xs+ [Identifier "_3"] -> xs+ [Identifier "_4"] -> xs+ [Identifier "_5"] -> xs+ [Identifier "_6"] -> xs+ [Identifier "_7"] -> xs+ [Identifier "_8"] -> xs+ [Identifier "_9"] -> xs+ [Identifier "$0"] -> xs+ [Identifier "$1"] -> xs+ [Identifier "$2"] -> xs+ [Identifier "$3"] -> xs+ [Identifier "$4"] -> xs+ [Identifier "$5"] -> xs+ [Identifier "$6"] -> xs+ [Identifier "$7"] -> xs+ [Identifier "$8"] -> xs+ [Identifier "$9"] -> xs+ _ -> []+ ) $ M.fromListWith (<>) (map snd ts)+{-# INLINE wildCardsCheckOccurrences #-}+{-# SCC wildCardsCheckOccurrences #-}+++wildCardsGroupCompare :: Options -> [Atoms] -> [T.Token] -> [(Bool, (Atoms, [C.ByteString]))]+wildCardsGroupCompare opt ls rs+ | length rs >= length ls = zipWith (tokensZip opt) ls rs+ | otherwise = [ (False, ([Any], [])) ]+{-# INLINE wildCardsGroupCompare #-}+{-# SCC wildCardsGroupCompare #-}+++tokensZip :: Options -> Atoms -> T.Token -> (Bool, (Atoms, [C.ByteString]))+tokensZip opt l r+ | wildCardsMatch opt l r = (True, (l, [T.tToken r]))+ | otherwise = (False, ([Any],[] ))+{-# INLINE tokensZip #-}+{-# SCC tokensZip #-}+++wildCardsMatch :: Options -> Atoms -> T.Token -> Bool+wildCardsMatch opt m t = any (\w -> wildCardMatch opt w t) m+{-# INLINE wildCardsMatch #-}+{-# SCC wildCardsMatch #-}+++{-# SCC wildCardMatch #-}+wildCardMatch :: Options -> Atom -> T.Token -> Bool+wildCardMatch opt (Raw l) r+ | T.isTokenIdentifier l && T.isTokenIdentifier r = {-# SCC wildcard_raw_0 #-}+ if | word_match opt -> T.tToken l == T.tToken r+ | prefix_match opt -> T.tToken l `C.isPrefixOf` T.tToken r+ | suffix_match opt -> T.tToken l `C.isSuffixOf` T.tToken r+ | edit_dist opt -> (C.unpack . T.tToken) l ~== C.unpack (T.tToken r)+ | otherwise -> T.tToken l `C.isInfixOf` T.tToken r+ | T.isTokenString l && T.isTokenString r = {-# SCC wildcard_raw_1 #-}+ if | word_match opt -> ls == rs+ | prefix_match opt -> ls `C.isPrefixOf` rs+ | suffix_match opt -> ls `C.isSuffixOf` rs+ | edit_dist opt -> C.unpack ls ~== C.unpack rs+ | otherwise -> ls `C.isInfixOf` rs+ | otherwise = {-# SCC wildcard_raw_2 #-} l `T.eqToken` r+ where ls = rmQuote8 $ trim8 (T.tToken l)+ rs = rmQuote8 $ trim8 (T.tToken r)++wildCardMatch _ Any _ = {-# SCC wildcard_any #-} True+wildCardMatch _ (Identifier _) t = {-# SCC wildcard_identifier #-} T.isTokenIdentifier t+wildCardMatch _ Keyword t = {-# SCC wildcard_keyword #-} T.isTokenKeyword t+wildCardMatch _ String t = {-# SCC wildcard_string #-} T.isTokenString t+wildCardMatch _ Literal t = {-# SCC wildcard_lit #-} T.isTokenString t+wildCardMatch _ Number t = {-# SCC wildcard_number #-} T.isTokenNumber t+wildCardMatch _ Oct t = {-# SCC wildcard_octal #-} T.isTokenNumber t && case C.uncons (T.tToken t) of Just ('0', C.uncons -> Just (d, _)) -> isDigit d; _ -> False+wildCardMatch _ Hex t = {-# SCC wildcard_hex #-} T.isTokenNumber t && case C.uncons (T.tToken t) of Just ('0', C.uncons -> Just ('x',_)) -> True; _ -> False
+ src/CGrep/Parser/Char.hs view
@@ -0,0 +1,130 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Parser.Char (+ chr+ , ord+ , isDigit+ , isSpace+ , isHexDigit+ , isCharNumber+ , isAlphaNum+ , isAlpha+ , isAlphaNum_+ , isAlpha_+ , isAlpha_'+ , isAlphaNum_'+ , isBracket'+ , isAlpha_and+ , isAlphaNum_and+) where++import GHC.Exts ( Char(C#), Int(I#), ord# )+import GHC.Base (isTrue#, int2Word#, leWord#, chr#)++ord :: Char -> Int+ord (C# c#) = I# (ord# c#)+{-# INLINE ord #-}+++chr :: Int -> Char+chr i@(I# i#)+ | isTrue# (int2Word# i# `leWord#` 0x10FFFF##) = C# (chr# i#)+ | otherwise+ = errorWithoutStackTrace ("CGrep.Char: bad argument: " ++ show i)+{-# INLINE chr #-}+++isDigit :: Char -> Bool+isDigit c = (fromIntegral (ord c - ord '0') :: Word) <= 9+{-# INLINE isDigit #-}+++isSpace :: Char -> Bool+isSpace c = uc == 32 || uc == 0xa0 || (uc - 0x9 <= 4) && not ctrl+ where+ uc = ord c+ ctrl = uc == 2 || uc == 3+{-# INLINE isSpace #-}+++isHexDigit :: Char -> Bool+isHexDigit c = isDigit c ||+ (fromIntegral (ord c - ord 'A')::Word) <= 5 ||+ (fromIntegral (ord c - ord 'a')::Word) <= 5+{-# INLINE isHexDigit #-}+++isCharNumber :: Char -> Bool+isCharNumber c = isHexDigit c || c `elem` (".xX" :: String)+{-# INLINE isCharNumber #-}+++isAlphaNum :: Char -> Bool+isAlphaNum c = o >= 97 && o <= 122 ||+ o >= 65 && o <= 90 ||+ o >= 48 && o <= 57+ where o = ord c+{-# INLINE isAlphaNum #-}+++isAlpha :: Char -> Bool+isAlpha c = o >= 97 && o <= 122 ||+ o >= 65 && o <= 90+ where o = ord c+{-# INLINE isAlpha #-}+++isAlphaNum_ :: Char -> Bool+isAlphaNum_ c = o >= 97 && o <= 122 ||+ o >= 65 && o <= 90 ||+ o >= 48 && o <= 57 || c == '_'+ where o = ord c+{-# INLINE isAlphaNum_ #-}+++isAlpha_ :: Char -> Bool+isAlpha_ c = o >= 97 && o <= 122 ||+ o >= 65 && o <= 90 || c == '_'+ where o = ord c+{-# INLINE isAlpha_ #-}+++isAlpha_' :: Char -> Bool+isAlpha_' c = isAlpha_ c || c == '_' || c == '\''+{-# INLINE isAlpha_' #-}+++isAlphaNum_' :: Char -> Bool+isAlphaNum_' c = isAlphaNum_ c || c == '_' || c == '\''+{-# INLINE isAlphaNum_' #-}+++isBracket' :: Char -> Bool+isBracket' c = c `elem` ("[]{}()" :: String)+{-# INLINE isBracket' #-}+++isAlpha_and :: String -> Char -> Bool+isAlpha_and s c = isAlpha_ c || c == '_' || c `elem` s+{-# INLINE isAlpha_and #-}+++isAlphaNum_and :: String -> Char -> Bool+isAlphaNum_and s c = isAlphaNum_ c || c == '_' || c `elem` s+{-# INLINE isAlphaNum_and #-}
+ src/CGrep/Parser/Chunk.hs view
@@ -0,0 +1,223 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Parser.Chunk (+ parseChunks+ , Chunk(..)+ , MatchLine(..)+ , ChunkType+ , pattern ChunkIdentifier+ , pattern ChunkKeyword+ , pattern ChunkDigit+ , pattern ChunkBracket+ , pattern ChunkString+ , pattern ChunkNativeType+ , pattern ChunkOperator+ , pattern ChunkUnspec+ ) where+++import CGrep.Parser.Char+ ( isDigit,+ isSpace,+ isCharNumber,+ isAlphaNum_,+ isAlpha_,+ isBracket',+ isCharNumber,+ isBracket',+ isAlpha_,+ isAlphaNum_+ )++import CGrep.Types ( Text8, Offset )+import Data.List (genericLength)+import CGrep.FileTypeMap ( FileTypeInfo(..) )++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Internal as BI++import qualified ByteString.StrictBuilder as B++import Data.MonoTraversable ( MonoFoldable(oforM_) )++import Data.STRef ( STRef, newSTRef, writeSTRef, readSTRef )+import Control.Monad.ST ( ST, runST )++import qualified Data.Sequence as S+import Data.Sequence ((|>), Seq((:<|), (:|>), Empty))+import Data.Maybe ( fromMaybe )+import Data.Word ( Word8 )+++newtype ChunkType = ChunkType {unChunkType :: Word8}+ deriving newtype (Eq, Ord)+++instance Show ChunkType where+ show ChunkUnspec = "*"+ show ChunkIdentifier = "identifier"+ show ChunkKeyword = "keyword"+ show ChunkDigit = "digit"+ show ChunkBracket = "bracket"+ show ChunkOperator = "operator"+ show ChunkString = "string"+ show ChunkNativeType = "native-type"+ {-# INLINE show #-}+++pattern ChunkUnspec :: ChunkType+pattern ChunkUnspec = ChunkType 0++pattern ChunkIdentifier :: ChunkType+pattern ChunkIdentifier = ChunkType 1++pattern ChunkKeyword :: ChunkType+pattern ChunkKeyword = ChunkType 2++pattern ChunkDigit :: ChunkType+pattern ChunkDigit = ChunkType 3++pattern ChunkBracket :: ChunkType+pattern ChunkBracket = ChunkType 4++pattern ChunkOperator :: ChunkType+pattern ChunkOperator = ChunkType 5++pattern ChunkString :: ChunkType+pattern ChunkString = ChunkType 6++pattern ChunkNativeType :: ChunkType+pattern ChunkNativeType = ChunkType 7++{-# COMPLETE ChunkIdentifier, ChunkKeyword, ChunkDigit, ChunkBracket, ChunkOperator, ChunkString, ChunkNativeType, ChunkUnspec #-}++data Chunk = Chunk {+ cTyp :: {-# UNPACK #-} !ChunkType+ , cToken :: {-# UNPACK #-} !Text8+ , cOffset :: {-# UNPACK #-} !Offset+} deriving stock (Eq, Show, Ord)+++data MatchLine = MatchLine {+ lOffset :: {-# UNPACK #-} !Offset,+ lChunks :: [Chunk]+} deriving stock (Eq, Show)+++newtype ChunkState = ChunkState { unChunkState :: Word8 }+ deriving newtype (Eq, Ord)++instance Show ChunkState where+ show StateSpace = "space"+ show StateAlpha = "alpha"+ show StateDigit = "digit"+ show StateBracket = "bracket"+ show StateOther = "other"+ {-# INLINE show #-}++pattern StateSpace :: ChunkState+pattern StateSpace = ChunkState 0++pattern StateAlpha :: ChunkState+pattern StateAlpha = ChunkState 1++pattern StateDigit :: ChunkState+pattern StateDigit = ChunkState 2++pattern StateBracket :: ChunkState+pattern StateBracket = ChunkState 3++pattern StateOther :: ChunkState+pattern StateOther = ChunkState 4++{-# COMPLETE StateSpace, StateAlpha, StateDigit, StateBracket, StateOther #-}+++(<~) :: STRef s a -> a -> ST s ()+ref <~ !x = writeSTRef ref x+{-# INLINE (<~) #-}+++{-# INLINE parseChunks #-}+parseChunks :: Maybe FileTypeInfo -> Text8 -> S.Seq Chunk+parseChunks l t = runST $ case l >>= \FileTypeInfo {..} -> ftIdentifierChars of+ Just (isAlpha1, isAlphaN) -> parseChunks' isAlpha_ isAlphaNum_ t+ _ -> parseChunks' isAlpha_ isAlphaNum_ t+ where parseChunks' :: (Char->Bool) -> (Char -> Bool) -> C.ByteString -> ST s (S.Seq Chunk)+ parseChunks' isAlpha1 isAlphaN txt = do+ stateR <- newSTRef StateSpace+ offR <- newSTRef 0+ accR <- newSTRef (mempty :: B.Builder)+ tokensR <- newSTRef S.empty+ oforM_ txt $ \w -> do+ let x = BI.w2c w+ state <- readSTRef stateR+ off <- readSTRef offR+ acc <- readSTRef accR+ tokens <- readSTRef tokensR+ case state of+ StateSpace ->+ if | isSpace x -> do stateR <~ StateSpace ; accR <~ mempty+ | isAlpha1 x -> do stateR <~ StateAlpha ; accR <~ B.asciiChar x+ | isDigit x -> do stateR <~ StateDigit ; accR <~ B.asciiChar x+ | isBracket' x -> do stateR <~ StateBracket ; accR <~ B.asciiChar x+ | otherwise -> do stateR <~ StateOther ; accR <~ B.asciiChar x+ StateAlpha ->+ if | isAlphaN x -> do stateR <~ StateAlpha ; accR <~ (acc <> B.asciiChar x)+ | isSpace x -> do stateR <~ StateSpace ; accR <~ mempty ; tokensR <~ (tokens |> toChunk off acc)+ | isBracket' x -> do stateR <~ StateBracket ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | otherwise -> do stateR <~ StateOther ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ StateDigit ->+ if | isCharNumber x -> do stateR <~ StateDigit ; accR <~ (acc <> B.asciiChar x)+ | isSpace x -> do stateR <~ StateSpace ; accR <~ mempty ; tokensR <~ (tokens |> toChunk off acc)+ | isAlpha1 x -> do stateR <~ StateAlpha ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | isBracket' x -> do stateR <~ StateBracket ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | otherwise -> do stateR <~ StateOther ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ StateBracket ->+ if | isSpace x -> do stateR <~ StateSpace ; accR <~ mempty ; tokensR <~ (tokens |> toChunk off acc)+ | isAlpha1 x -> do stateR <~ StateAlpha ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | isDigit x -> do stateR <~ StateDigit ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | isBracket' x -> do stateR <~ StateBracket ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | otherwise -> do stateR <~ StateOther ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ StateOther ->+ if | isSpace x -> do stateR <~ StateSpace ; accR <~ mempty ; tokensR <~ (tokens |> toChunk off acc)+ | isAlpha1 x -> do stateR <~ StateAlpha ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | isDigit x -> if B.builderBytes acc == "."+ then do stateR <~ StateDigit ; accR <~ (acc <> B.asciiChar x)+ else do stateR <~ StateDigit ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | isBracket' x -> do stateR <~ StateBracket ; accR <~ B.asciiChar x ; tokensR <~ (tokens |> toChunk off acc)+ | otherwise -> do stateR <~ StateOther ; accR <~ (acc <> B.asciiChar x)+ offR <~ (off+1)++ lastAcc <- readSTRef accR+ tokens <- readSTRef tokensR++ if B.builderLength lastAcc == 0+ then return tokens+ else do+ state <- readSTRef stateR+ off <- readSTRef offR+ return $ tokens |> toChunk off lastAcc+++toChunk :: Offset -> B.Builder -> Chunk+toChunk off b = Chunk ChunkUnspec str (off - fromIntegral (B.builderLength b))+ where str = B.builderBytes b+{-# INLINE toChunk #-}
− src/CGrep/Parser/Cpp/Token.hs
@@ -1,381 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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.Parser.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--import CGrep.Parser.Token--data TokenizerState = TokenizerState Source {-# UNPACK #-} !Offset !CppState-type Source = C.ByteString-type Offset = Int---data Token =- TokenIdentifier { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenDirective { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenKeyword { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenNumber { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenHeaderName { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenString { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenChar { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenOperOrPunct { toString :: !String, toOffset :: {-# UNPACK #-} !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 (Eq)---instance SemanticToken Token where- tkIsIdentifier = isIdentifier- tkIsString = isString- tkIsChar = isChar- tkIsNumber = isLiteralNumber- tkIsKeyword = isKeyword- tkEquivalent = tokenCompare- tkToString = toString- tkToOffset = toOffset- tkToIdentif = TokenIdentifier----- Tokenize the source code in a list of Token--- Precondition: the C++ source code must be well-formed-----tokenizer :: Source -> [Token]-tokenizer xs = runGetToken (TokenizerState 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 (TokenizerState (C.uncons -> Nothing) _ _) = []-runGetToken tstate = token : runGetToken ns- where (token, ns) = getToken tstate---getToken :: TokenizerState -> (Token, TokenizerState)--getToken (TokenizerState (C.uncons -> Nothing) _ _) = error "getToken: internal error"-getToken (TokenizerState xs off state) =- let token = fromJust $- getTokenDirective xs state `mplus`- getTokenHeaderName xs state `mplus`- getTokenNumber xs state `mplus`- getTokenString xs state `mplus`- getTokenChar xs state `mplus`- getTokenIdOrKeyword xs state `mplus`- getTokenOpOrPunct xs state- tstring = toString token- len = fromIntegral $ length tstring- (xs', w) = dropWhite $ C.drop (fromIntegral len) xs- in- (token { toOffset = off }, TokenizerState 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 :: HS.HashSet Char--validHexSet = HS.fromList "0123456789abcdefABCDEFxX"-validOctSet = HS.fromList "01234567"-validDecSet = 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` validDecSet -> x : getNumber xs NumberFloat- | x == 'e' || x == 'E' -> x : getNumber xs NumberExp- | otherwise -> ""-- | state == NumberExp = case () of _- | x `HS.member` validDecSet -> x : getNumber xs NumberExp- | x == '+' || x == '-' -> x : getNumber xs NumberExp- | otherwise -> ""--getNumber _ _ = undefined---getTokenString xs@(C.uncons -> Just (x,_)) _- | x == '"' = Just $ TokenString (getLiteral '"' '"' False xs) 0- | otherwise = Nothing-getTokenString (C.uncons -> Nothing) _ = Nothing-getTokenString _ _ = Nothing---getTokenChar xs@(C.uncons -> Just (x,_)) _- | x == '\'' = Just $ TokenChar (getLiteral '\'' '\'' False xs) 0- | otherwise = Nothing-getTokenChar (C.uncons -> Nothing) _ = Nothing-getTokenChar _ _ = Nothing---getTokenIdOrKeyword xs@(C.uncons -> Just (x,_)) _- | not $ isIdentifierChar' x = Nothing- | name `HS.member` keywords = Just $ TokenKeyword name 0- | otherwise = Just $ TokenIdentifier name 0- where name = C.unpack $ C.takeWhile isIdentifierChar' xs-getTokenIdOrKeyword (C.uncons -> Nothing) _ = Nothing-getTokenIdOrKeyword _ _ = Nothing---getTokenOpOrPunct source _ = go source (min 4 (C.length source))- where go _ 0- | C.length source > 0 = error $ "operator or punct: error " ++ show source- | otherwise = Nothing- go src len- | sub `HS.member` operOrPunct = Just $ TokenOperOrPunct sub 0- | otherwise = go src (len-1)- where sub = C.unpack (C.take len src)---getLiteral :: Char -> Char -> Bool -> C.ByteString -> String-getLiteral _ _ _ (C.uncons -> Nothing) = []-getLiteral b e False ys@(C.uncons -> Just (x,xs))- | x == b = b : getLiteral b e True xs- | otherwise = error $ "literal: error " ++ C.unpack ys-getLiteral b e True (C.uncons -> Just (x,xs))- | x == e = [e]- | x == '\\' = '\\' : x' : getLiteral b e True xs'- | otherwise = x : getLiteral b e True xs- where- (C.uncons -> Just(x',xs')) = xs-getLiteral _ _ _ _ = []---operOrPunct :: HS.HashSet String-operOrPunct = HS.fromList [ "{","}","[","]","#","(",")",";",":","?",".","+","-","*",- "/","%","^","&","|","~","!","=","<",">","," ,- "##", "<:", ":>", "<%", "%>", "%:", "::", ".*", "+=", "-=",- "*=", "/=", "%=", "^=", "&=", "|=", ">=", "<=",- "&&", "||", "==", "!=", "++", "--", "->", "//", "/*", "*/",- "...", "<<=", ">>=", "->*",- "%:%:" ]--keywords :: HS.HashSet String-keywords = HS.fromList ["alignas", "continue", "friend", "alignof", "decltype", "goto", "asm",- "default", "if", "auto", "delete", "inline", "bool", "do", "int", "break",- "double", "long", "case", "dynamic_cast", "mutable", "catch", "else",- "namespace", "char", "enum", "new", "char16_t", "explicit", "noexcept",- "char32_t", "export", "nullptr", "class", "extern", "operator", "const",- "false", "private", "constexpr", "float", "protected", "const_cast", "for",- "public", "register", "true", "reinterpret_cast", "try", "return", "typedef",- "short", "typeid", "signed", "typename", "sizeof", "union", "static", "unsigned",- "static_assert", "using", "static_cast", "virtual", "struct", "void", "switch",- "volatile", "template", "wchar_t", "this", "while", "thread_local", "throw",- "and", "and_eq", "bitand", "bitor", "compl", "not", "not_eq", "or", "or_eq",- "xor", "xor_eq"]-
− src/CGrep/Parser/Generic/Token.hs
@@ -1,213 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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.Parser.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.Parser.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, toOffset :: {-# UNPACK #-} !Offset } |- TokenDigit { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenBracket { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenLiteral { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenOther { toString :: !String, toOffset :: {-# UNPACK #-} !Offset }- deriving (Show, Eq, Ord)---instance SemanticToken Token where- tkIsIdentifier = _isTokenAlpha- tkIsString = _isTokenLiteral- tkIsChar = _isTokenLiteral- tkIsNumber = _isTokenDigit- tkIsKeyword = const False- tkEquivalent = tokenCompare- tkToString = toString- tkToOffset = toOffset- tkToIdentif = TokenAlpha---_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 {-# UNPACK #-} !Offset {-# UNPACK #-} !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-
+ src/CGrep/Parser/Line.hs view
@@ -0,0 +1,91 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Parser.Line (+ getLineOffsets+ , getAllLineOffsets+ , getLineByOffset+ , lowerBound+ ) where++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as LC++import qualified Data.Vector.Unboxed as UV+import Data.Vector.Unboxed ((!))+import qualified Data.ByteString.Unsafe as BU+import Data.ByteString.Internal (c2w)+import CGrep.Types ( Offset, Text8, LText8 )+import Data.Int ( Int64 )+++-- Returns a vector of offsets for a given character in a ByteString, up to the given maximum offset.+charOffsets :: Char -> Int64 -> C.ByteString -> UV.Vector Int64+charOffsets c maxOff bs = UV.unfoldrN (fromIntegral maxOff) (findOffsets bs maxOff) 0+ where findOffsets :: C.ByteString -> Int64 -> Int64 -> Maybe (Int64, Int64)+ findOffsets bs' maxOff' i+ | i >= maxOff' = Nothing+ | BU.unsafeIndex bs' (fromIntegral i) == c2w c = Just (fromIntegral i, i + 1)+ | otherwise = findOffsets bs' maxOff' (i + 1)+++getLineOffsets :: Int64 -> Text8 -> UV.Vector Offset+getLineOffsets maxOff text =+ let idx = nlOffsets (fromIntegral maxOff) text+ in if UV.null idx+ then idx+ else if UV.last idx == fromIntegral (C.length text -1)+ then UV.init idx+ else idx++{-# INLINE nlOffsets #-}+nlOffsets :: Int -> Text8 -> UV.Vector Int64+nlOffsets maxOff' bs' = UV.unfoldrN maxOff' (findOffsets maxOff' bs') (-1)++findOffsets :: Int -> Text8 -> Int -> Maybe (Int64, Int)+findOffsets max ts !i+ | i == -1 = Just (0, 0)+ | i >= max = Nothing+ | BU.unsafeIndex ts (fromIntegral i) == c2w '\n' = Just (fromIntegral i + 1, i + 1)+ | otherwise = findOffsets max ts (i + 1)+++getAllLineOffsets :: Text8 -> UV.Vector Offset+getAllLineOffsets ts = getLineOffsets (fromIntegral $ C.length ts) ts+{-# INLINE getAllLineOffsets #-}+++lowerBound :: UV.Vector Int64 -> Int64 -> Int64+lowerBound vec v = lowerBoundGo vec v 0 (UV.length vec-1)++lowerBoundGo :: UV.Vector Int64 -> Int64 -> Int -> Int -> Int64+lowerBoundGo vec v !left !right+ | left > right = if right >= 0 then vec `UV.unsafeIndex` right else -1+ | otherwise = case v `compare` midValue of+ LT -> lowerBoundGo vec v left (mid - 1)+ EQ -> midValue+ _ -> lowerBoundGo vec v (mid + 1) right+ where+ mid = (left + right) `div` 2+ midValue = vec `UV.unsafeIndex` mid+++getLineByOffset :: Offset -> Text8 -> UV.Vector Int64 -> (# Text8, Offset #)+getLineByOffset off text vec = (# (head . C.lines) (C.drop (fromIntegral lb) text), lb #)+ where lb = lowerBound vec off+{-# INLINE getLineByOffset #-}
src/CGrep/Parser/Token.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,17 +16,407 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -module CGrep.Parser.Token (SemanticToken(..)) where+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE DuplicateRecordFields #-} +module CGrep.Parser.Token (+ parseTokens+ , filterToken+ , Token(..)+ , TokenFilter(..)+ , mkTokenFilter+ , eqToken+ , isTokenIdentifier+ , isTokenKeyword+ , isTokenNumber+ , isTokenBracket+ , isTokenString+ , isTokenOperator+ , isTokenUnspecified+ , tTyp+ , tToken+ , tOffset+ , mkTokenIdentifier+ , mkTokenKeyword+ , mkTokenDigit+ , mkTokenBracket+ , mkTokenString+ , mkTokenOperator -class (Show t, Ord t) => SemanticToken t where- tkIsIdentifier :: t -> Bool- tkIsString :: t -> Bool- tkIsChar :: t -> Bool- tkIsNumber :: t -> Bool- tkIsKeyword :: t -> Bool- tkEquivalent :: t -> t -> Bool- tkToString :: t -> String- tkToOffset :: t -> Int- tkToIdentif :: String -> Int -> t+ ) where +import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Internal as BI+import qualified Data.DList as DL++import CGrep.Parser.Char+ ( chr,+ isAlphaNum_,+ isAlpha_,+ isBracket',+ isCharNumber,+ isDigit,+ isSpace,+ isCharNumber,+ isBracket',+ isAlpha_,+ isAlphaNum_ )++import CGrep.Types (Offset, Text8)+import Data.List (genericLength)++import CGrep.FileTypeMap+ ( CharIdentifierF,+ FileTypeInfo(ftKeywords, ftIdentifierChars), WordType (..) )++import qualified Data.HashMap.Strict as HM+import qualified Data.Sequence as S+import Data.Sequence ((|>), Seq((:<|), (:|>), Empty))++import Control.Monad.ST ( ST, runST )+import Data.STRef ( STRef, newSTRef, readSTRef, writeSTRef, modifySTRef', modifySTRef )+import Data.MonoTraversable ( MonoFoldable(oforM_) )+import Data.Word (Word8)++import qualified ByteString.StrictBuilder as B+import CGrep.Parser.Chunk++import GHC.Exts ( inline )+import Data.Coerce ( coerce )+import Data.Text.Internal.Read (T)++newtype TokenState = TokenState { unTokenState :: Int }+ deriving newtype (Eq)++instance Show TokenState where+ show StateSpace = "space"+ show StateIdentifier = "identifier"+ show StateDigit = "digit"+ show StateBracket = "bracket"+ show StateLiteral = "literal"+ show StateOther = "other"++ {-# INLINE show #-}++pattern StateSpace :: TokenState+pattern StateSpace = TokenState 0++pattern StateIdentifier :: TokenState+pattern StateIdentifier = TokenState 1++pattern StateDigit :: TokenState+pattern StateDigit = TokenState 2++pattern StateBracket :: TokenState+pattern StateBracket = TokenState 3++pattern StateLiteral :: TokenState+pattern StateLiteral = TokenState 4++pattern StateOther :: TokenState+pattern StateOther = TokenState 5++newtype Token = Token Chunk+ deriving newtype (Eq, Ord)++instance Show Token where+ show (Token (Chunk typ bs off)) = "(" ++ show typ ++ " " ++ C.unpack bs ++ " @" ++ show off ++ ")"+ {-# INLINE show #-}+++eqToken :: Token -> Token -> Bool+eqToken a b = tToken a == tToken b &&+ tTyp a == tTyp b+{-# INLINE eqToken #-}+++mkTokenIdentifier :: C.ByteString -> Offset -> Token+mkTokenIdentifier bs off = Token $ Chunk ChunkIdentifier bs off+{-# INLINE mkTokenIdentifier #-}++mkTokenKeyword :: C.ByteString -> Offset -> Token+mkTokenKeyword bs off = Token $ Chunk ChunkKeyword bs off+{-# INLINE mkTokenKeyword #-}++mkTokenDigit :: C.ByteString -> Offset -> Token+mkTokenDigit bs off = Token $ Chunk ChunkDigit bs off+{-# INLINE mkTokenDigit #-}++mkTokenBracket :: C.ByteString -> Offset -> Token+mkTokenBracket bs off = Token $ Chunk ChunkBracket bs off+{-# INLINE mkTokenBracket #-}++mkTokenOperator :: C.ByteString -> Offset -> Token+mkTokenOperator bs off = Token $ Chunk ChunkOperator bs off+{-# INLINE mkTokenOperator #-}++mkTokenString :: C.ByteString -> Offset -> Token+mkTokenString bs off = Token $ Chunk ChunkString bs off+{-# INLINE mkTokenString #-}++mkTokenNativeType :: C.ByteString -> Offset -> Token+mkTokenNativeType bs off = Token $ Chunk ChunkNativeType bs off+{-# INLINE mkTokenNativeType #-}++mkTokenFromWord :: Maybe FileTypeInfo -> C.ByteString -> Offset -> Token+mkTokenFromWord Nothing txt off = mkTokenIdentifier txt off+mkTokenFromWord (Just info) txt off =+ case HM.lookup txt (ftKeywords info) of+ Just typ -> case typ of+ Keyword -> mkTokenKeyword txt off+ NativeType -> mkTokenNativeType txt off+ _ -> mkTokenIdentifier txt off+{-# INLINABLE mkTokenFromWord #-}+++mkToken :: Maybe FileTypeInfo -> TokenState -> C.ByteString -> Offset -> Token+mkToken _ StateSpace = mkTokenOperator+mkToken info StateIdentifier = mkTokenFromWord info+mkToken _ StateDigit = mkTokenDigit+mkToken _ StateBracket = mkTokenBracket+mkToken _ StateLiteral = mkTokenString+mkToken _ StateOther = mkTokenOperator+++tTyp :: Token -> ChunkType+tTyp = cTyp . coerce+{-# INLINE tTyp #-}++tOffset :: Token -> Offset+tOffset t = cOffset (coerce t :: Chunk)+{-# INLINE tOffset #-}++tToken :: Token -> Text8+tToken t = cToken (coerce t :: Chunk)+{-# INLINE tToken #-}+++isTokenIdentifier :: Token -> Bool+isTokenIdentifier t = cTyp (coerce t) == ChunkIdentifier+{-# INLINE isTokenIdentifier #-}++isTokenKeyword :: Token -> Bool+isTokenKeyword t = cTyp (coerce t) == ChunkKeyword+{-# INLINE isTokenKeyword #-}++isTokenNumber :: Token -> Bool+isTokenNumber t = cTyp (coerce t) == ChunkDigit+{-# INLINE isTokenNumber #-}++isTokenBracket :: Token -> Bool+isTokenBracket t = cTyp (coerce t) == ChunkBracket+{-# INLINE isTokenBracket #-}++isTokenOperator :: Token -> Bool+isTokenOperator t = cTyp (coerce t) == ChunkOperator+{-# INLINE isTokenOperator #-}++isTokenString :: Token -> Bool+isTokenString t = cTyp (coerce t) == ChunkString+{-# INLINE isTokenString #-}++isTokenNativeType :: Token -> Bool+isTokenNativeType t = cTyp (coerce t) == ChunkNativeType+{-# INLINE isTokenNativeType #-}++isTokenUnspecified :: Token -> Bool+isTokenUnspecified t = cTyp (coerce t) == ChunkUnspec+{-# INLINE isTokenUnspecified #-}+++data TokenFilter = TokenFilter+ { tfIdentifier :: !Bool+ , tfKeyword :: !Bool+ , tfNativeType :: !Bool+ , tfString :: !Bool+ , tfNumber :: !Bool+ , tfOperator :: !Bool+ , tfBracket :: !Bool+ } deriving stock (Eq, Show)+++filterToken :: TokenFilter -> Token -> Bool+filterToken f t = case cTyp (coerce t :: Chunk) of+ ChunkIdentifier -> tfIdentifier f+ ChunkKeyword -> tfKeyword f+ ChunkDigit -> tfNumber f+ ChunkOperator -> tfOperator f+ ChunkString -> tfString f+ ChunkNativeType -> tfNativeType f+ ChunkBracket -> tfBracket f+ ChunkUnspec -> False+++mkTokenFilter :: (Traversable t) => t ChunkType -> TokenFilter+mkTokenFilter = foldr go (TokenFilter False False False False False False False)+ where+ go ChunkIdentifier f = f { tfIdentifier = True }+ go ChunkKeyword f = f { tfKeyword = True }+ go ChunkNativeType f = f { tfNativeType = True }+ go ChunkDigit f = f { tfNumber = True }+ go ChunkOperator f = f { tfOperator = True }+ go ChunkString f = f { tfString = True }+ go ChunkBracket f = f { tfBracket = True }+ go ChunkUnspec f = f+++(<~) :: STRef s a -> a -> ST s ()+ref <~ !x = writeSTRef ref x+{-# INLINE (<~) #-}+++data TokenIdx = TokenIdx {+ offset :: {-# UNPACK #-}!Int+ , len :: {-# UNPACK #-}!Int+}++tkString :: TokenIdx -> C.ByteString -> C.ByteString+tkString (TokenIdx off len) = C.take len . C.drop off+{-# INLINE tkString #-}+++data AccOp = Reset | Start {-# UNPACK #-}!Int | Append {-# UNPACK #-} !Int+++(<<~) :: STRef s TokenIdx -> AccOp -> ST s ()+ref <<~ Reset = writeSTRef ref (TokenIdx (-1) 0)+ref <<~ Start cur = writeSTRef ref (TokenIdx cur 1)+ref <<~ Append cur = modifySTRef' ref $ \case+ TokenIdx (-1) 0 -> TokenIdx cur 1+ TokenIdx off len -> TokenIdx off (len + 1)++{-# INLINE (<<~) #-}+++{-# INLINE parseTokens #-}+parseTokens :: TokenFilter -> Maybe FileTypeInfo -> C.ByteString -> S.Seq Token+parseTokens f@TokenFilter{..} l t = runST (case l >>= ftIdentifierChars of+ Nothing -> parseToken' isAlpha_ isAlphaNum_ l t+ Just (isAlpha1, isAlphaN) -> parseToken' isAlpha1 isAlphaN l t)+ where parseToken' :: CharIdentifierF -> CharIdentifierF -> Maybe FileTypeInfo -> C.ByteString -> ST a (S.Seq Token)+ parseToken' isAlpha1 isAlphaN info txt = do++ stateR <- newSTRef StateSpace+ accR <- newSTRef (TokenIdx (-1) (-1))+ tokensR <- newSTRef S.empty+ curR <- newSTRef 0++ oforM_ txt $ \w -> do++ let x = BI.w2c w+ cur <- readSTRef curR+ state <- readSTRef stateR++ case state of+ StateSpace -> {-# SCC "StateSpace" #-}+ if | isSpace x -> do accR <<~ Reset+ | inline isAlpha1 x -> do stateR <~ StateIdentifier ; accR <<~ Start cur+ | x == chr 2 -> do stateR <~ StateLiteral ; accR <<~ Reset+ | isDigit x -> do stateR <~ StateDigit ; accR <<~ Start cur+ | isBracket' x -> do stateR <~ StateBracket ; accR <<~ Start cur+ | otherwise -> do stateR <~ StateOther ; accR <<~ Start cur++ StateIdentifier -> {-# SCC "StateIdentifier" #-}+ if isAlphaN x+ then accR <<~ Append cur+ else do+ acc <- readSTRef accR+ tokens <- readSTRef tokensR+ if | isSpace x -> do stateR <~ StateSpace ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken_ tfIdentifier tfKeyword tfNativeType (mkTokenFromWord info) acc txt)+ | x == chr 2 -> do stateR <~ StateLiteral ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken_ tfIdentifier tfKeyword tfNativeType (mkTokenFromWord info) acc txt)+ | isBracket' x -> do stateR <~ StateBracket ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken_ tfIdentifier tfKeyword tfNativeType (mkTokenFromWord info) acc txt)+ | otherwise -> do stateR <~ StateOther ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken_ tfIdentifier tfKeyword tfNativeType (mkTokenFromWord info) acc txt)++ StateDigit -> {-# SCC "StateDigit" #-}+ if isCharNumber x+ then accR <<~ Append cur+ else do+ acc <- readSTRef accR+ tokens <- readSTRef tokensR+ if | isSpace x -> do stateR <~ StateSpace ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken tfNumber mkTokenDigit acc txt)+ | x == chr 2 -> do stateR <~ StateLiteral ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken tfNumber mkTokenDigit acc txt)+ | inline isAlpha1 x -> do stateR <~ StateIdentifier ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfNumber mkTokenDigit acc txt)+ | isBracket' x -> do stateR <~ StateBracket ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfNumber mkTokenDigit acc txt)+ | otherwise -> do stateR <~ StateOther ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfNumber mkTokenDigit acc txt)++ StateLiteral -> {-# SCC "StateLiteral" #-}+ if x == chr 3+ then do+ acc <- readSTRef accR+ tokens <- readSTRef tokensR+ stateR <~ StateSpace ; accR <<~ Reset; tokensR <~ (tokens |> buildToken tfString mkTokenString acc txt)+ else do accR <<~ Append cur++ StateBracket -> {-# SCC "StateBracket" #-} do+ acc <- readSTRef accR+ tokens <- readSTRef tokensR+ if | isSpace x -> do stateR <~ StateSpace ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)+ | inline isAlpha1 x -> do stateR <~ StateIdentifier ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)+ | isDigit x -> do stateR <~ StateDigit ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)+ | isBracket' x -> do accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)+ | x == chr 2 -> do stateR <~ StateLiteral ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)+ | otherwise -> do stateR <~ StateOther ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)++ StateOther -> {-# SCC "StateOther" #-} do+ acc <- readSTRef accR+ tokens <- readSTRef tokensR+ if | isSpace x -> do stateR <~ StateSpace ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken tfOperator mkTokenOperator acc txt)+ | inline isAlpha1 x -> do stateR <~ StateIdentifier ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfOperator mkTokenOperator acc txt)+ | isDigit x -> if tkString acc txt == "."+ then do stateR <~ StateDigit ; accR <<~ Append cur+ else do stateR <~ StateDigit ; accR <<~ Start cur ; tokensR <~ (tokens |> buildToken tfOperator mkTokenOperator acc txt)+ | isBracket' x -> do stateR <~ StateBracket ; accR <<~ Append cur ; tokensR <~ (tokens |> buildToken tfOperator mkTokenOperator acc txt)+ | x == chr 2 -> do stateR <~ StateLiteral ; accR <<~ Reset ; tokensR <~ (tokens |> buildToken tfBracket mkTokenBracket acc txt)+ | otherwise -> do accR <<~ Append cur++ curR <~ (cur + 1)++ lastAcc <- readSTRef accR+ tokens <- readSTRef tokensR++ if lastAcc.len == 0+ then return tokens+ else do+ state <- readSTRef stateR+ cur <- readSTRef curR+ return $ tokens |> buildFilteredToken f (mkToken info state) lastAcc txt+++buildFilteredToken :: TokenFilter -> (C.ByteString -> Offset -> Token) -> TokenIdx -> C.ByteString -> Token+buildFilteredToken tf f (TokenIdx start len) txt =+ let t = f (subByteString start len txt) (fromIntegral start)+ in if filterToken tf t then t else unspecifiedToken+{-# INLINE buildFilteredToken #-}+++buildToken :: Bool -> (C.ByteString -> Offset -> Token) -> TokenIdx -> C.ByteString -> Token+buildToken True f (TokenIdx start len) txt = f (subByteString start len txt) (fromIntegral start)+buildToken False f (TokenIdx start len) txt = unspecifiedToken+{-# INLINE buildToken #-}+++buildToken_ :: Bool -> Bool -> Bool -> (C.ByteString -> Offset -> Token) -> TokenIdx -> C.ByteString -> Token+buildToken_ True True True f (TokenIdx start len) txt = f (subByteString start len txt) (fromIntegral start)+buildToken_ True False False f (TokenIdx start len) txt = let t = f (subByteString start len txt) (fromIntegral start) in+ if isTokenIdentifier t+ then t+ else unspecifiedToken+buildToken_ False True False f (TokenIdx start len) txt = let t = f (subByteString start len txt) (fromIntegral start) in+ if isTokenKeyword t+ then t+ else unspecifiedToken+buildToken_ False False True f (TokenIdx start len) txt = let t = f (subByteString start len txt) (fromIntegral start) in+ if isTokenNativeType t+ then t+ else unspecifiedToken+buildToken_ _ _ _ f (TokenIdx start len) txt = unspecifiedToken+++subByteString :: Int -> Int -> C.ByteString -> C.ByteString+subByteString i n = C.take n . C.drop i+{-# INLINE subByteString #-}+++unspecifiedToken :: Token+unspecifiedToken = Token $ Chunk ChunkUnspec C.empty 0
− src/CGrep/Parser/WildCard.hs
@@ -1,221 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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.Parser.WildCard (WildCard(..), MultiCard,- mkWildCardFromToken,- combineMultiCard,- filterTokensWithMultiCards,- wildCardMap,- wildCardMatch,- multiCardMatch) where--import qualified Data.Map as M--import CGrep.Common-import CGrep.Distance-import CGrep.Parser.Token--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)----type MultiCard a = [WildCard a]---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 )- ]---mkWildCardFromToken :: (SemanticToken a) => a -> WildCard a-mkWildCardFromToken t- | tkIsIdentifier t = case () of- _ | Just wc <- M.lookup str wildCardMap -> wc- | isWildCardIdentif str -> IdentifCard str- | otherwise -> TokenCard $ tkToIdentif (rmWildCardEscape str) (tkToOffset t)- where str = tkToString t-- | otherwise = TokenCard t---combineMultiCard :: (SemanticToken a) => [MultiCard a] -> [MultiCard a]-combineMultiCard (m1:r@(m2:m3:ms))- | [TokenCard b] <- m2, tkToString b == "OR" = combineMultiCard $ (m1++m3):ms- | otherwise = m1 : combineMultiCard r-combineMultiCard [m1,m2] = [m1,m2]-combineMultiCard [m1] = [m1]-combineMultiCard [] = []---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---isWildCardIdentif :: String -> Bool-isWildCardIdentif s =- case () of- _ | (x:y:_) <- s -> wprefix x && isNumber y- | [x] <- s -> wprefix x- | otherwise -> error "isWildCardIdentif"- where wprefix x = x == '$' || x == '_'---rmWildCardEscape :: String -> String-rmWildCardEscape ('$':xs) = xs-rmWildCardEscape ('_':xs) = xs-rmWildCardEscape xs = xs---{-# 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 respective 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 = rmQuote $ trim (tkToString l)- rs = rmQuote $ trim (tkToString r)- | otherwise = l `tkEquivalent` r-
+ src/CGrep/Search.hs view
@@ -0,0 +1,78 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Search ( searchStringIndices+ , searchStringTaggedIndices+ , eligibleForSearch+ , TaggedIx(..)+ ) where++import CGrep.Types ( Text8 )+import Data.Int ( Int64 )+import GHC.Exts ( groupWith )++import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Search as BM+import qualified Data.ByteString.Search.DFA as DFA++import qualified Data.ByteString.Lazy.Search as LBM+import qualified Data.ByteString.Lazy.Search.DFA as LDFA+import Data.List.Extra ( notNull )+++findIndices :: Text8 -> Text8 -> [Int]+findIndices p = if C.length p <= 3+ then DFA.indices p+ else BM.indices p+{-# INLINE findIndices #-}+++searchStringIndices :: [Text8] -> Text8 -> [[Int64]]+searchStringIndices ps text = ps >>= \p -> [fromIntegral <$> p `findIndices` text]+{-# INLINE searchStringIndices #-}+++data TaggedIx a = TaggedIx {+ index :: {-# UNPACK #-} !Int+ , tags :: [a]+} deriving stock (Show)++instance Eq (TaggedIx a) where+ (TaggedIx i1 _) == (TaggedIx i2 _) = i1 == i2++instance Ord (TaggedIx a) where+ compare (TaggedIx i1 _) (TaggedIx i2 _) = compare i1 i2++-- >>> searchStringTaggedIndices [("a",2),("b",1),("a",0), ("he", 42)] "aheba"+-- [TaggedIx {index = 0, tags = [2,0]},TaggedIx {index = 1, tags = [42]},TaggedIx {index = 3, tags = [1]},TaggedIx {index = 4, tags = [2,0]}]++searchStringTaggedIndices :: [(Text8, a)] -> Text8 -> [TaggedIx a]+searchStringTaggedIndices ps text =+ let res = ps >>= \p -> let pat = fst p+ tag = snd p+ ids = findIndices pat text+ in (\i -> TaggedIx (fromIntegral i) [tag]) <$> ids+ in fuseGroup <$> groupWith index res+ where {-# INLINE fuseGroup #-}+ fuseGroup :: [TaggedIx a] -> TaggedIx a+ fuseGroup xs = TaggedIx (index $ head xs) $ concatMap tags xs++eligibleForSearch :: [a] -> [[Int64]] -> Bool+eligibleForSearch [_] = all notNull+eligibleForSearch _ = any notNull+{-# INLINE eligibleForSearch #-}
src/CGrep/Strategy/BoyerMoore.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,89 +16,93 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -{-# LANGUAGE TupleSections #-}- module CGrep.Strategy.BoyerMoore (search) where import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as LC -import Control.Monad.Trans.Reader-import Control.Monad.IO.Class-import Data.List+import Control.Monad.Trans.Reader ( reader, ask )+import Control.Monad.IO.Class ( MonadIO(liftIO) )+import Data.List ( isSuffixOf, isPrefixOf, genericLength ) import CGrep.Common-import CGrep.Output-import CGrep.Filter-import CGrep.Lang-import CGrep.Types+ ( Text8,+ expandMultiline,+ getTargetContents,+ getTargetName,+ ignoreCase)+import CGrep.Output ( Output, mkOutputElements, runSearch )+import CGrep.ContextFilter ( mkContextFilter)+import CGrep.FileType ( FileType )+import CGrep.FileTypeMap ( fileTypeLookup, contextFilter, FileTypeInfo )+import CGrep.Types ( Offset )+import CGrep.Search -import qualified CGrep.Token as T+import Reader ( ReaderIO, Env(..) )+import Options ( Options(word_match, prefix_match, suffix_match) )+import Verbose ( putMsgLnVerbose )+import CGrep.Parser.Chunk+import Data.Int ( Int64 ) -import Reader-import Options-import Debug-import Util+import System.Posix.FilePath ( RawFilePath )+import System.IO ( stderr ) +import CGrep.Parser.Line ( getLineOffsets, getLineByOffset )+import qualified Data.Vector.Unboxed as UV+import Data.Array (indices) -search :: FilePath -> [Text8] -> OptionT IO [Output]-search f patterns = do - opt <- reader snd+search :: Maybe (FileType, FileTypeInfo) -> RawFilePath -> [Text8] -> ReaderIO [Output]+search info f patterns = do++ Env{..} <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f -- transform text - let [text''', _ , _ , _] = scanr ($) text [ expandMultiline opt- , contextFilter (getFileLang opt filename) (mkContextFilter opt)- , ignoreCase opt- ]+ let ctxFilter = mkContextFilter opt + let [text''', _ , text', _] = scanr ($) text [ expandMultiline opt+ , contextFilter (fst <$> info) ctxFilter False+ , ignoreCase opt+ ]+ -- make shallow search - let shallow = shallowSearch patterns text'''+ let indices' = searchStringIndices patterns text'+ let indices''' = searchStringIndices patterns text''' -- search for matching tokens - let tokens = concatMap (\(p, xs) -> let p' = C.unpack p in map (,p') xs ) $ zip patterns shallow+ let ctor = Chunk ChunkUnspec - -- filter exact/partial matching tokens+ let chunks = concat $ zipWith (\p xs -> (p `ctor` ) <$> xs ) patterns indices''' - let tokens' = if word_match opt || prefix_match opt || suffix_match opt- then filter (checkToken opt text''') tokens- else tokens+ -- filter exact/partial matching tokens - putStrLevel1 $ "strategy : running Boyer-Moore search on " ++ filename ++ "..."+ let lineOffsets = getLineOffsets (fromIntegral $ C.length text) text - runSearch opt filename (any notNull shallow) $ do+ let chunks' = if word_match opt || prefix_match opt || suffix_match opt+ then filter (checkChunk opt lineOffsets (snd <$> info) text''') chunks+ else chunks - -- print banners...+ putMsgLnVerbose 2 stderr $ "strategy : running Boyer-Moore search on " <> filename+ putMsgLnVerbose 3 stderr $ "---\n" <> text''' <> "\n---" - putStrLevel2 $ "tokens : " ++ show tokens- putStrLevel2 $ "tokens' : " ++ show tokens'- putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---"+ runSearch opt filename (eligibleForSearch patterns indices') $ do - mkOutput filename text text''' tokens'+ putMsgLnVerbose 2 stderr $ "chunks' : " <> show chunks'+ mkOutputElements lineOffsets filename text text''' chunks' -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+checkChunk :: Options -> UV.Vector Int64 -> Maybe FileTypeInfo -> Text8 -> Chunk -> Bool+checkChunk opt vec info text chunk+ | word_match opt = let !off = cOffset chunk - off' in any (\chunk' -> cOffset chunk' == off && cToken chunk' == cToken chunk) cs+ | prefix_match opt = any (\chunk' -> cToken chunk `C.isPrefixOf` cToken chunk' && cOffset chunk' + off' == cOffset chunk) cs+ | suffix_match opt = any (\chunk' -> cToken chunk `C.isSuffixOf` cToken chunk' && cOffset chunk' + off' + fromIntegral (C.length (cToken chunk') - C.length (cToken chunk)) == cOffset chunk) cs | otherwise = undefined- where (text',off') = getLineByOffset off text- ts = T.tokenizer text'---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-+ where (# line',off' #) = getLineByOffset (cOffset chunk) text vec+ cs = parseChunks info line'
− src/CGrep/Strategy/Cpp/Semantic.hs
@@ -1,103 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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.Parser.Cpp.Token as Cpp--import Control.Monad.Trans.Reader-import Control.Monad.IO.Class-import Data.List-import Data.Function-import Data.Maybe--import CGrep.Filter-import CGrep.Lang-import CGrep.Common-import CGrep.Output--import CGrep.Parser.WildCard--import Reader-import Debug-import Util---search :: FilePath -> [Text8] -> OptionT IO [Output]-search f patterns = do-- opt <- reader snd- text <- liftIO $ getTargetContents f-- let filename = getTargetName f-- -- transform text-- let filt = (mkContextFilter opt) { getFilterComment = False }--- let [text''', text'' , text', _] = scanr ($) text [ expandMultiline opt- , contextFilter (getFileLang opt filename) filt- , ignoreCase opt- ]-- -- pre-process patterns-- patterns' = map (Cpp.tokenizer . contextFilter (Just Cpp) filt) patterns -- [ [t1,t2,..], [t1,t2...] ]- patterns'' = map (map mkWildCardFromToken) patterns' -- [ [w1,w2,..], [w1,w2,..] ]- patterns''' = map (combineMultiCard . map (:[])) patterns'' -- [ [m1,m2,..], [m1,m2,..] ] == [ [ [w1], [w2],..], [[w1],[w2],..]]-- identif = mapMaybe (\x -> case x of- TokenCard (Cpp.TokenChar xs _) -> Just (rmQuote $ trim xs)- TokenCard (Cpp.TokenString xs _) -> Just (rmQuote $ trim xs)- TokenCard (Cpp.TokenIdentifier "OR" _) -> Nothing- TokenCard t -> Just (Cpp.toString t)- _ -> Nothing- ) . concat $ patterns''-- -- put banners...-- putStrLevel1 $ "strategy : running C/C++ semantic search on " ++ filename ++ "..."- putStrLevel2 $ "wildcards : " ++ show patterns''- putStrLevel2 $ "multicards: " ++ show patterns'''- putStrLevel2 $ "identif : " ++ show identif-- let idpack = map C.pack identif- quick1 = all notNull $ shallowSearch idpack text'- quick2 = all notNull $ shallowSearch idpack text''-- runSearch opt filename (quick1 && quick2) $ do-- -- parse source code, get the Cpp.Token list...-- let tokens = Cpp.tokenizer text'''-- -- get matching tokens ...-- let tokens' = sortBy (compare `on` Cpp.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns'''-- let matches = map (\t -> let n = fromIntegral (Cpp.toOffset t) in (n, Cpp.toString t)) tokens' :: [(Int, String)]-- putStrLevel2 $ "tokens : " ++ show tokens'- putStrLevel2 $ "matches : " ++ show matches- putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---"-- mkOutput filename text text''' matches-
− src/CGrep/Strategy/Cpp/Tokenizer.hs
@@ -1,106 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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.Parser.Cpp.Token as Cpp--import Control.Monad.Trans.Reader-import Control.Monad.IO.Class--import CGrep.Filter-import CGrep.Lang-import CGrep.Common-import CGrep.Output-import CGrep.Distance--import Data.List--import Reader-import Options-import Debug-import Util---search :: FilePath -> [Text8] -> OptionT IO [Output]-search f ps = do-- opt <- reader snd- text <- liftIO $ getTargetContents f-- let filename = getTargetName f-- -- transform text-- let filt = (mkContextFilter opt) { getFilterComment = False }-- let [text''', _ , text', _] = scanr ($) text [ expandMultiline opt- , contextFilter (getFileLang opt filename) filt- , ignoreCase opt- ]--- putStrLevel1 $ "strategy : running C/C++ token search on " ++ filename ++ "..."-- let quick = all notNull $ shallowSearch ps text'-- runSearch opt filename quick $ do-- -- parse source code, get the Cpp.Token list...-- let tokens = Cpp.tokenizer text'''-- -- context-filterting...-- 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...-- tokens'' = cppTokenFilter opt (map C.unpack ps) tokens'-- -- convert Cpp.Tokens to CGrep.Tokens-- matches = map (\t -> let off = fromIntegral (Cpp.toOffset t) in (off, Cpp.toString t)) tokens'' :: [(Int, String)]-- putStrLevel2 $ "tokens : " ++ show tokens- putStrLevel2 $ "tokens' : " ++ show tokens'- putStrLevel2 $ "tokens'' : " ++ show tokens''- putStrLevel2 $ "matches : " ++ show matches- putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---"-- mkOutput filename text text''' matches---cppTokenFilter :: Options -> [String] -> [Cpp.Token] -> [Cpp.Token]-cppTokenFilter opt patterns tokens- | edit_dist opt = filter (\t -> any (\p -> p ~== Cpp.toString t) patterns) tokens- | word_match opt = filter ((`elem` patterns) . Cpp.toString) tokens- | prefix_match opt = filter ((\t -> any (`isPrefixOf`t) patterns) . Cpp.toString) tokens- | suffix_match opt = filter ((\t -> any (`isSuffixOf`t) patterns) . Cpp.toString) tokens- | otherwise = filter ((\t -> any (`isInfixOf` t) patterns) . Cpp.toString) tokens--
− src/CGrep/Strategy/Generic/Semantic.hs
@@ -1,102 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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 qualified CGrep.Parser.Generic.Token as Generic--import CGrep.Filter-import CGrep.Lang-import CGrep.Common-import CGrep.Output--import CGrep.Parser.Token-import CGrep.Parser.WildCard--import Control.Monad.Trans.Reader-import Control.Monad.IO.Class--import Data.List-import Data.Function-import Data.Maybe--import Reader-import Debug-import Util---search :: FilePath -> [Text8] -> OptionT IO [Output]-search f ps = do-- opt <- reader snd- text <- liftIO $ getTargetContents f-- let filename = getTargetName f-- -- transform text-- let [text''', text'', text', _ ] = scanr ($) text [ expandMultiline opt- , contextFilter (getFileLang opt filename) filt- , ignoreCase opt- ]-- filt = (mkContextFilter opt) { getFilterComment = False }-- -- pre-process patterns-- patterns = map (Generic.tokenizer . contextFilter (getFileLang opt filename) filt) ps -- [ [t1,t2,..], [t1,t2...] ]- patterns' = map (map mkWildCardFromToken) patterns -- [ [w1,w2,..], [w1,w2,..] ]- patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [[[w1], [w2],..], [[w1],[w2],..]]-- identif = mapMaybe (\x -> case x of- TokenCard (Generic.TokenLiteral xs _) -> Just (rmQuote $ trim xs)- TokenCard (Generic.TokenAlpha "OR" _) -> Nothing- TokenCard t -> Just (tkToString t)- _ -> Nothing- ) . concat $ patterns'-- -- put banners...-- putStrLevel1 $ "strategy : running generic semantic search on " ++ filename ++ "..."- putStrLevel2 $ "wildcards : " ++ show patterns'- putStrLevel2 $ "multicards: " ++ show patterns''- putStrLevel2 $ "identif : " ++ show identif-- let idpack = map C.pack identif- quick1 = all notNull $ shallowSearch idpack text'- quick2 = all notNull $ shallowSearch idpack text''-- runSearch opt filename (quick1 && quick2) $ do-- -- parse source code, get the Generic.Token list...-- let tokens = Generic.tokenizer text'''-- -- get matching tokens ...-- let tokens' = sortBy (compare `on` Generic.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''- let matches = map (\t -> let n = fromIntegral (Generic.toOffset t) in (n, Generic.toString t)) tokens' :: [(Int, String)]-- putStrLevel2 $ "tokens : " ++ show tokens'- putStrLevel2 $ "matches : " ++ show matches- putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---"-- mkOutput filename text text''' matches-
src/CGrep/Strategy/Levenshtein.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -17,51 +17,66 @@ -- module CGrep.Strategy.Levenshtein (search) where+import CGrep.Parser.Line ( getAllLineOffsets ) import qualified Data.ByteString.Char8 as C -import Control.Monad.Trans.Reader-import Control.Monad.IO.Class+import Control.Monad.Trans.Reader ( reader, ask )+import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import CGrep.Filter-import CGrep.Lang+import CGrep.ContextFilter ( mkContextFilter ) import CGrep.Common-import CGrep.Output-import CGrep.Distance-import CGrep.Token+ ( Text8,+ getTargetName,+ getTargetContents,+ expandMultiline,+ ignoreCase )+import CGrep.Output ( Output, mkOutputElements )+import CGrep.Distance ( (~==) )+import CGrep.Parser.Chunk ( Chunk, cToken, parseChunks )+import CGrep.FileType ( FileType )+import CGrep.FileTypeMap+ ( fileTypeLookup, FileTypeInfo, contextFilter ) -import Reader-import Debug+import Reader ( ReaderIO, Env (..) )+import Verbose ( putMsgLnVerbose )+import System.Posix.FilePath (RawFilePath)+import System.IO (stderr)+import Data.Foldable ( Foldable(toList) ) +search :: Maybe (FileType, FileTypeInfo) -> RawFilePath -> [Text8] -> ReaderIO [Output]+search info f patterns = do -search :: FilePath -> [Text8] -> OptionT IO [Output]-search f patterns = do+ Env{..} <- ask - opt <- reader snd text <- liftIO $ getTargetContents f let filename = getTargetName f -- transform text + let ctxFilter = mkContextFilter opt+ let [text''', _ , _ , _] = scanr ($) text [ expandMultiline opt- , contextFilter (getFileLang opt filename) (mkContextFilter opt)+ , contextFilter (fst <$> fileTypeLookup opt filename) ctxFilter False , ignoreCase opt ] -- parse source code, get the Cpp.Token list... - tokens' = tokenizer text'''+ tokens' = parseChunks (snd <$> info) text''' -- filter tokens... patterns' = map C.unpack patterns- matches = filter (\t -> any (\p -> p ~== snd t) patterns') tokens'+ matches = filter (\t -> any (\p -> p ~== C.unpack (cToken t)) patterns') (toList tokens') - putStrLevel1 $ "strategy : running edit-distance (Levenshtein) search on " ++ filename ++ "..."- putStrLevel2 $ "tokens : " ++ show tokens'- putStrLevel2 $ "matches : " ++ show matches- putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---"+ putMsgLnVerbose 2 stderr $ "strategy : running edit-distance (Levenshtein) search on " <> filename <> "..."+ putMsgLnVerbose 3 stderr $ "---\n" <> text''' <> "\n---" - mkOutput filename text text''' matches+ putMsgLnVerbose 2 stderr $ "tokens : " <> show tokens'+ putMsgLnVerbose 2 stderr $ "matches : " <> show matches + let lineOffsets = getAllLineOffsets text++ mkOutputElements lineOffsets filename text text''' matches
src/CGrep/Strategy/Regex.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,44 +16,56 @@ -- 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 Control.Monad.Trans.Reader-import Control.Monad.IO.Class+import Control.Monad.Trans.Reader ( reader, ask )+import Control.Monad.IO.Class ( MonadIO(liftIO) ) import Text.Regex.Base-import Text.Regex.Posix-import Text.Regex.PCRE+ ( AllTextMatches(getAllTextMatches), MatchText )+import Text.Regex.Posix ( (=~) )+import Text.Regex.PCRE ( (=~) ) -import Data.Array+import Data.Array ( Array, elems ) import CGrep.Common-import CGrep.Output-import CGrep.Filter-import CGrep.Lang+ ( Text8,+ getTargetName,+ getTargetContents,+ expandMultiline,+ ignoreCase )+import CGrep.Output ( Output, mkOutputElements )+import CGrep.ContextFilter ( mkContextFilter)+import CGrep.FileType ( FileType )+import CGrep.FileTypeMap ( FileTypeInfo(..), fileTypeLookup, contextFilter ) -import Reader-import Options-import Debug+import Reader ( ReaderIO, Env (..) )+import Options ( Options(regex_pcre) )+import Verbose ( putMsgLnVerbose ) +import CGrep.Parser.Chunk+import CGrep.Parser.Line ( getAllLineOffsets ) +import System.Posix.FilePath (RawFilePath)+import System.IO (stderr) -search :: FilePath -> [Text8] -> OptionT IO [Output]-search f patterns = do+search :: Maybe (FileType, FileTypeInfo) -> RawFilePath -> [Text8] -> ReaderIO [Output]+search info f patterns = do - opt <- reader snd+ Env{..} <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f -- transform text + let ctxFilter = mkContextFilter opt+ let [text''', _ , _ , _] = scanr ($) text [ expandMultiline opt- , contextFilter (getFileLang opt filename) (mkContextFilter opt)+ , contextFilter (fst <$> fileTypeLookup opt filename) ctxFilter False , ignoreCase opt ] @@ -61,12 +73,13 @@ (=~~~) = if regex_pcre opt then (Text.Regex.PCRE.=~) else (Text.Regex.Posix.=~) - tokens = map (\(str, (off,_)) -> (off, C.unpack str) ) $+ tokens = map (\(str, (off,_)) -> Chunk ChunkUnspec str (fromIntegral off)) $ concatMap elems $ patterns >>= (\p -> elems (getAllTextMatches $ text''' =~~~ p :: (Array Int) (MatchText Text8))) - putStrLevel1 $ "strategy : running regex " ++ (if regex_pcre opt then "(pcre)" else "(posix)") ++ " search on " ++ filename ++ "..."- putStrLevel2 $ "tokens : " ++ show tokens- putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---"+ putMsgLnVerbose 2 stderr $ "strategy : running regex " <> (if regex_pcre opt then "(pcre)" else "(posix)") <> " search on " <> filename <> "..."+ putMsgLnVerbose 3 stderr $ "---\n" <> text''' <> "\n---"+ putMsgLnVerbose 2 stderr $ "tokens : " <> show tokens - mkOutput filename text text''' tokens+ let lineOffsets = getAllLineOffsets text + mkOutputElements lineOffsets filename text text''' tokens
+ src/CGrep/Strategy/Semantic.hs view
@@ -0,0 +1,135 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Semantic (search) where++import qualified Data.ByteString.Char8 as C+import CGrep.Parser.Token++import CGrep.ContextFilter+ ( contextBitComment, mkContextFilter, (~!) )+import CGrep.Common+ ( Text8,+ trim,+ getTargetName,+ getTargetContents,+ expandMultiline,+ ignoreCase, trim8, subText )++import CGrep.Search ( eligibleForSearch, searchStringIndices )+import CGrep.Output ( Output, mkOutputElements, runSearch )+import CGrep.Parser.Line ( getAllLineOffsets )++import CGrep.Parser.Atom+ ( Atom(..),+ mkAtomFromToken,+ combineAtoms,+ filterTokensWithAtoms)++import Control.Monad.Trans.Reader ( reader, ask )+import Control.Monad.IO.Class ( MonadIO(liftIO) )++import Data.List ( sortBy, nub )+import Data.Function ( on )+import Data.Maybe ( mapMaybe )++import Reader ( ReaderIO, Env (..) )+import Verbose ( putMsgLnVerbose )+import Util ( rmQuote8 )+import CGrep.Parser.Chunk++import System.Posix.FilePath ( RawFilePath, takeBaseName )++import CGrep.FileType ( FileType )+import CGrep.FileTypeMap+ ( fileTypeLookup, FileTypeInfo, contextFilter )+import System.IO ( stderr )++import qualified Data.Sequence as S+import Data.Foldable ( Foldable(toList) )+import Data.Coerce ( coerce )++search :: Maybe (FileType, FileTypeInfo) -> RawFilePath -> [Text8] -> ReaderIO [Output]+search info f ps = do++ Env{..} <- ask++ text <- liftIO $ getTargetContents f++ let filename = getTargetName f++ let [text''', _, text', _ ] = scanr ($) text [ expandMultiline opt+ , contextFilter (fst <$> fileTypeLookup opt filename) filt True+ , ignoreCase opt+ ]++ filt = mkContextFilter opt ~! contextBitComment++ -- pre-process patterns++ pfilter = TokenFilter {+ tfIdentifier = True,+ tfKeyword = True,+ tfNativeType = True,+ tfString = True,+ tfNumber = True,+ tfOperator = True,+ tfBracket = True}++ patterns = map (parseTokens pfilter (snd <$> info) . contextFilter (fst <$> fileTypeLookup opt filename) filt True) ps+ patterns' = map (mkAtomFromToken <$>) patterns+ patterns'' = map (combineAtoms . map (:[])) (toList <$> patterns')++ identifiers = mapMaybe+ (\case+ Raw (Token (Chunk ChunkString xs _)) -> Just (rmQuote8 $ trim8 xs)+ Raw (Token (Chunk ChunkIdentifier "OR" _)) -> Nothing+ Raw t -> Just (tToken t)+ _ -> Nothing)+ (concatMap toList patterns')++ -- put banners...++ putMsgLnVerbose 2 stderr $ "strategy : running generic semantic search on " <> filename <> "..."+ putMsgLnVerbose 2 stderr $ "atoms : " <> show patterns'' <> " -> identifiers: " <> show identifiers+ putMsgLnVerbose 3 stderr $ "---\n" <> text''' <> "\n---"++ let indices' = searchStringIndices identifiers text'++ runSearch opt filename (eligibleForSearch identifiers indices') $ do++ -- parse source code, get the Generic.Chunk list...++ let tfilter = mkTokenFilter $ cTyp . coerce <$> concatMap toList patterns++ let tokens = toList $ parseTokens tfilter (snd <$> info) (subText indices' text''')++ -- get matching tokens ...++ let tokens' = sortBy (compare `on` tOffset) $ nub $ concatMap (\ms -> filterTokensWithAtoms opt ms tokens) patterns''++ -- convert Tokens to Chunks++ let matches = coerce tokens' :: [Chunk]++ putMsgLnVerbose 2 stderr $ "tokens : " <> show tokens+ putMsgLnVerbose 2 stderr $ "matches : " <> show matches++ let lineOffsets = getAllLineOffsets text++ mkOutputElements lineOffsets filename text text''' matches
+ src/CGrep/Strategy/Tokenizer.hs view
@@ -0,0 +1,130 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.Tokenizer (search) where++import qualified Data.ByteString.Char8 as C+import Control.Monad.Trans.Reader ( reader, ask )+import Control.Monad.IO.Class ( MonadIO(liftIO) )++import CGrep.ContextFilter+ ( contextBitComment, (~!), mkContextFilter )+import CGrep.Common+ ( Text8,+ expandMultiline,+ getTargetContents,+ getTargetName,+ ignoreCase,+ subText+ )+import CGrep.Output ( Output, mkOutputElements, runSearch )+import CGrep.Distance ( (~==) )++import CGrep.Parser.Line+import CGrep.Parser.Token++import CGrep.FileType ( FileType )+import CGrep.FileTypeMap+ ( fileTypeLookup, FileTypeInfo, contextFilter )++import CGrep.Search ( eligibleForSearch, searchStringIndices )+import Data.List ( isSuffixOf, isInfixOf, isPrefixOf )++import Reader ( ReaderIO, Env (..) )+import Options+ ( Options(identifier, keyword, string, number, operator, edit_dist,+ word_match, prefix_match, suffix_match, nativeType) )+import Verbose ( putMsgLnVerbose )++import CGrep.Parser.Chunk (Chunk(..))+import System.Posix.FilePath (RawFilePath)+import System.IO (stderr)++import Data.Foldable ( Foldable(toList) )+import CGrep.Types (Offset)+import Data.Coerce ( coerce )++import qualified Data.Sequence as S+import Util ( mapMaybe' )++search :: Maybe (FileType, FileTypeInfo) -> RawFilePath -> [Text8] -> ReaderIO [Output]+search info f ps = do++ Env{..} <- ask++ text <- liftIO $ getTargetContents f++ let filename = getTargetName f++ -- transform text++ let filt = mkContextFilter opt ~! contextBitComment++ let [text''', _ , text', _] = scanr ($) text [ expandMultiline opt+ , contextFilter (fst <$> fileTypeLookup opt filename) filt True+ , ignoreCase opt+ ]+++ putMsgLnVerbose 2 stderr $ "strategy: running token search on " <> filename <> "..."+ putMsgLnVerbose 3 stderr $ "---\n" <> text''' <> "\n---"++ let indices' = searchStringIndices ps text'++ runSearch opt filename (eligibleForSearch ps indices') $ do++ -- parse source code, get the token list...++ let tfilter = TokenFilter {+ tfIdentifier = identifier opt,+ tfKeyword = keyword opt,+ tfNativeType = nativeType opt,+ tfString = string opt,+ tfNumber = number opt,+ tfOperator = operator opt,+ tfBracket = False }++ let tokens = {-# SCC tok_0 #-} parseTokens tfilter (snd <$> info) (subText indices' text''')++ -- filter tokens and make chunks++ matches = {-# SCC tok_3 #-} mapMaybe' (tokenizerFilter opt ps) tokens++ putMsgLnVerbose 2 stderr $ "tokens : " <> show tokens+ putMsgLnVerbose 2 stderr $ "matches : " <> show matches++ let lineOffsets = getAllLineOffsets text++ mkOutputElements lineOffsets filename text text''' matches+++tokenizerFilter :: Options -> [C.ByteString] -> Token -> Maybe Chunk+tokenizerFilter opt patterns token+ | isTokenUnspecified token = Nothing+ | tokenPredicate opt patterns token = Just $ coerce token+ | otherwise = Nothing+{-# INLINE tokenizerFilter #-}+++tokenPredicate :: Options -> [C.ByteString] -> Token -> Bool+tokenPredicate opt patterns tokens+ | edit_dist opt = (\t -> any (\p -> C.unpack p ~== (C.unpack . tToken) t) patterns) tokens+ | word_match opt = ((`elem` patterns) . tToken) tokens+ | prefix_match opt = ((\t -> any (`C.isPrefixOf`t) patterns) . tToken) tokens+ | suffix_match opt = ((\t -> any (`C.isSuffixOf`t) patterns) . tToken) tokens+ | otherwise = ((\t -> any (`C.isInfixOf` t) patterns) . tToken) tokens
− src/CGrep/Token.hs
@@ -1,139 +0,0 @@------ Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or--- (at your option) any later version.------ This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.-----{-# LANGUAGE FlexibleInstances #-}--module CGrep.Token ( Token- , MatchLine- , tokens- , tokenizer) where--import qualified Data.ByteString.Char8 as C-import qualified Data.DList as DL--import Data.Char-import Data.Array.Unboxed-import CGrep.Types---type Token = (Offset, String)-type MatchLine = (OffsetLine, [Token])-type DString = DL.DList Char---data TokenState =- StateSpace |- StateAlpha |- StateDigit |- StateBracket |- StateOther- deriving (Eq, Enum, Show)---data TokenAccum = TokenAccum !TokenState !Offset DString (DL.DList Token)---isCharNumberLT :: UArray Char Bool-isCharNumberLT =- listArray ('\0', '\255')- (map (\c -> isHexDigit c || c `elem` ".xX") ['\0'..'\255'])---isSpaceLT :: UArray Char Bool-isSpaceLT =- listArray ('\0', '\255')- (map isSpace ['\0'..'\255'])--isAlphaLT :: UArray Char Bool-isAlphaLT =- listArray ('\0', '\255')- (map (\c -> isAlpha c || c == '_') ['\0'..'\255'])--isAlphaNumLT :: UArray Char Bool-isAlphaNumLT =- listArray ('\0', '\255')- (map (\c -> isAlphaNum c || c == '_' || c == '\'') ['\0'..'\255'])--isDigitLT :: UArray Char Bool-isDigitLT =- listArray ('\0', '\255')- (map isDigit ['\0'..'\255'])--isBracketLT :: UArray Char Bool-isBracketLT =- listArray ('\0', '\255')- (map (`elem` "{[()]}") ['\0'..'\255'])---{-# INLINE mkToken #-}--mkToken :: Offset -> DString -> Token-mkToken off ds = (off - length str, str)- where str = DL.toList ds---tokens :: Text8 -> [String]-tokens = map snd . tokenizer---tokenizer :: Text8 -> [Token]-tokenizer xs = (\(TokenAccum _ off acc out) ->- DL.toList (if null (DL.toList acc) then out- else out `DL.snoc` mkToken off acc)) $- C.foldl' tokens' (TokenAccum StateSpace 0 DL.empty DL.empty) xs- where tokens' :: TokenAccum -> Char -> TokenAccum- tokens' (TokenAccum StateSpace off _ out) x =- case () of- _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty out- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) out- | isDigitLT ! x -> TokenAccum StateDigit (off+1) (DL.singleton x) out- | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) out- | otherwise -> TokenAccum StateOther (off+1) (DL.singleton x) out-- tokens' (TokenAccum StateAlpha off acc out) x =- case () of- _ | isAlphaNumLT ! x -> TokenAccum StateAlpha (off+1) (acc `DL.snoc` x) out- | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | otherwise -> TokenAccum StateOther (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)-- tokens' (TokenAccum StateDigit off acc out) x =- case () of- _ | isCharNumberLT ! x -> TokenAccum StateDigit (off+1) (acc `DL.snoc` x) out- | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | otherwise -> TokenAccum StateOther (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)-- tokens' (TokenAccum StateBracket off acc out) x =- case () of- _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | isDigitLT ! x -> TokenAccum StateDigit (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | otherwise -> TokenAccum StateOther (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)-- tokens' (TokenAccum StateOther off acc out) x =- case () of- _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) DL.empty (out `DL.snoc` mkToken off acc)- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | isDigitLT ! x -> if DL.toList acc == "."- then TokenAccum StateDigit (off+1) (acc `DL.snoc` x) out- else TokenAccum StateDigit (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) (DL.singleton x) (out `DL.snoc` mkToken off acc)- | otherwise -> TokenAccum StateOther (off+1) (acc `DL.snoc` x) out
src/CGrep/Types.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,15 +16,16 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- --module CGrep.Types where--import Data.ByteString.Char8 as C+module CGrep.Types (+ Offset+ , Text8+ , LText8+) where -type Offset = Int-type Offset2d = (Int, Int)-type OffsetLine = Int+import Data.ByteString.Char8 as C ( ByteString )+import Data.ByteString.Lazy.Char8 as LC ( ByteString )+import Data.Int ( Int64 ) +type Offset = Int64 type Text8 = C.ByteString-type Line8 = C.ByteString-+type LText8 = LC.ByteString
src/CmdOptions.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,13 +16,27 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -module CmdOptions where+module CmdOptions (+ options+) where import Data.Version(showVersion) import System.Console.CmdArgs+ ( (&=),+ cmdArgsMode,+ args,+ explicit,+ groupname,+ help,+ name,+ program,+ summary,+ typ,+ Mode,+ CmdArgs ) -import Paths_cgrep-import Options+import Paths_cgrep ( version )+import Options ( Options(..) ) options :: Mode (CmdArgs Options) options = cmdArgsMode $ Options@@ -32,32 +46,31 @@ , 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_posix = False &= help "Use regex matching (posix)" &= explicit &= name "G" &=name "regex"- , regex_pcre = False &= help "Use regex matching (pcre)" &= explicit &= name "P" &=name "regex-pcre"+ , regex_pcre = False &= help "Use regex matching (pcre)" &= explicit &= name "P" &=name "pcre" , ignore_case = False &= help "Ignore case distinctions"- , code = False &= groupname "\nContext filters (generic)" &= help "Enable search in source code" &= explicit &= name "c" &= name "code"+ , code = False &= groupname "\nContext filters" &= help "Enable search in source code" &= explicit &= name "c" &= name "code" , 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"- , 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"- , identifier = False &= groupname "\nC/C++ language" &= help "Identifiers" &= explicit &= name "identifier"+ , identifier = False &= groupname "\nToken filters" &= help "Identifiers" &= explicit &= name "identifier" &= name "name"+ , nativeType = False &= help "Native Types" &= explicit &= name "native" &= name "type" , 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"+ , operator = False &= help "Operators" &= explicit &= name "op"+ , semantic = False &= groupname "\nSemantic" &= help "\"code\" pattern: _, _1, _2... (identifiers), $, $1, $2... (optionals), ANY, KEY, STR, LIT, NUM, HEX, OCT, OR" &= explicit &= name "S" &= name "semantic" , max_count = maxBound &= groupname "\nOutput control" &= help "Stop search in files after INT matches" &= explicit &= name "max-count"- , language_filter = [] &= help "Specify languages. ie: Cpp, +Haskell, -Makefile"- , language_force = Nothing &= help "Force the language" &= explicit &= name "language-force"- , language_map = False &= help "Lists the language mappings"- , magic_filter = [] &= help "Use unix magic as file-filter"+ , type_filter = [] &= help "Specify file types. ie: Cpp, +Haskell, -Makefile"+ , kind_filter = [] &= help "Specify file kinds. Text, Config, Language, Data, Markup or Script"+ , type_force = Nothing &= help "Force the type of file" &= explicit &= name "force-type"+ , type_map = False &= help "List the supported file types" &= explicit &= name "type-list" , invert_match = False &= help "Select non-matching lines" &= explicit &= name "invert-match" &= name "v" , multiline = 1 &= help "Enable multi-line matching" , recursive = False &= help "Enable recursive search (don't follow symlinks)" &= explicit &= name "recursive" &= name "r"+ , skip_test = False &= help "Skip files that have 'test' in the name" &= explicit &= name "skip-test" &= name "T" , prune_dir = [] &= help "Do not descend into dir" &= explicit &= name "prune-dir"- , deference_recursive = False &= help "Recursive, follow symlinks" &= explicit &= name "deference-recursive" &= name "R"+ , follow = False &= help "Follow symlinks" &= explicit &= name "follow" &= name "L" , show_match = False &= groupname "\nOutput format" &= help "Show list of matching tokens" &= explicit &= name "show-match"- , color = False &= help "Use colors to highlight the matching strings" &= explicit &= name "color"+ , color = False &= help "Use colors to highlight the match strings" &= explicit &= name "color" , no_color = False &= help "Do not use colors (override config file)" &= explicit &= name "no-color" , no_filename = False &= help "Suppress the file name prefix on output" &= explicit &= name "h" &= name "no-filename" , no_numbers = False &= help "Suppress both line and column numbers on output" &= explicit &= name "no-numbers"@@ -67,18 +80,10 @@ , vim = False &= help "Run vim editor passing the files that match" &= explicit &=name "vim" , editor = False &= help "Run the editor specified by EDITOR var., passing the files that match" &= explicit &=name "editor" , fileline = False &= help "When edit option is specified, pass the list of matching files in file:line format (e.g. vim 'file-line' plugin)" &= explicit &=name "fileline"-#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- , format = Nothing &= typ "STRING" &= help "Format output. Var: #f #n #l #t ## #, #; #0 #1...\ne.g. \"#f:#n #0 #1\"" &= explicit &= name "format" , json = False &= help "Format output as json object" &= explicit &= name "json"- , xml = False &= help "Format output as xml document" &= explicit &= name "xml"- , jobs = 1 &= groupname "\nConcurrency" &= help "Number of jobs"- , cores = 0 &= help "Number of physical processors utilized"- , chunk = 16 &= help "Specify the length of chunks"- , asynch = False &= help "Process chunks asynchronously"- , debug = 0 &= groupname "\nMiscellaneous" &= help "Debug level: 1, 2 or 3"+ , jobs = Nothing &= groupname "\nConcurrency" &= help "Number threads to run in parallel" &= explicit &= name "threads" &= name "j"+ , verbose = 0 &= groupname "\nMiscellaneous" &= help "Verbose level: 1, 2 or 3" &= explicit &= name "verbose" , no_shallow = False &= help "Disable shallow-search" &= explicit &= name "no-shallow"+ , show_palette = False &= help "Show color palette" &= explicit &= name "palette" , others = [] &= args- } &= summary ("Cgrep " ++ showVersion version ++ ". Usage: cgrep [OPTION] [PATTERN] files...") &= program "cgrep"-+ } &= summary ("Cgrep " <> showVersion version <> ". Usage: cgrep [OPTION] [PATTERN] files...") &= program "cgrep"
src/Config.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -17,85 +17,118 @@ -- {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-} -module Config where+module Config (+ Config(..)+ , dumpPalette+ , getConfig+) where -import Control.Monad-import System.Directory-import System.FilePath ((</>))+import Control.Monad ( MonadPlus(mzero), filterM, forM_ )+import System.Directory ( doesFileExist, getHomeDirectory ) import System.Console.ANSI+ ( Color(White, Red, Green, Yellow, Blue, Magenta, Cyan),+ ColorIntensity(Vivid),+ ConsoleIntensity(BoldIntensity),+ ConsoleLayer(Foreground),+ SGR(SetColor, SetConsoleIntensity), setSGRCode ) +import System.Console.ANSI.Types+ ( SGR(SetPaletteColor, SetColor, SetConsoleIntensity),+ xterm6LevelRGB,+ Color(White, Red, Green, Yellow, Blue, Magenta, Cyan),+ ColorIntensity(Vivid),+ ConsoleIntensity(BoldIntensity),+ ConsoleLayer(Foreground) )+ import qualified Data.Yaml as Y-import Data.Aeson-import Data.Maybe+import Data.Aeson ( (.!=), (.:?), FromJSON(parseJSON) )+import Data.Maybe ( fromMaybe, mapMaybe ) -import GHC.Generics-import CGrep.Lang-import Util+import GHC.Generics ( Generic )+import CGrep.FileType ( FileType ) +import Data.List.Split ( splitOn )+import qualified Data.ByteString as B+import System.FilePath ((</>))+import Data.ByteString.RawFilePath (RawFilePath)+import qualified Data.ByteString.Char8 as C++import Data.List.Extra (notNull)+import CGrep.FileKind (FileKind)+import Text.Read (readMaybe)+ cgreprc :: FilePath cgreprc = "cgreprc" data Config = Config- { configLanguages :: [Lang]- , configPruneDirs :: [String]+ { configFileTypes :: [FileType]+ , configFileKinds :: [FileKind]+ , configPruneDirs :: [RawFilePath] , configColors :: Bool , configColorFile :: [SGR] , configColorMatch :: [SGR] , configFileLine :: Bool- } deriving (Show, Read)+ , configJobs :: Maybe Int+ } deriving stock (Show, Read) defaultConfig :: Config defaultConfig = Config- { configLanguages = []+ { configFileTypes = []+ , configFileKinds = [] , configPruneDirs = [] , configColors = False , configColorFile = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Blue] , configColorMatch = [SetConsoleIntensity BoldIntensity] , configFileLine = False+ , configJobs = Nothing } mkConfig :: YamlConfig -> Config mkConfig YamlConfig{..} =- let configLanguages = mapMaybe readMaybe yamlLanguages- configPruneDirs = yamlPruneDirs+ let configFileTypes = mapMaybe readMaybe yamlFileTypes+ configFileKinds = mapMaybe readMaybe yamlFileKinds+ configPruneDirs = C.pack <$> yamlPruneDirs configColors = yamlColors configColorFile = fromMaybe [] (yamlColorFileName >>= readColor) configColorMatch = fromMaybe [] (yamlColorMatch >>= readColor) configFileLine = yamlFileLine+ configJobs = yamlJobs in Config {..} data YamlConfig = YamlConfig- { yamlLanguages :: [String]+ { yamlFileTypes :: [String]+ , yamlFileKinds :: [String] , yamlPruneDirs :: [String] , yamlColors :: Bool , yamlColorFileName :: Maybe String , yamlColorMatch :: Maybe String , yamlFileLine :: Bool- } deriving (Show, Generic)+ , yamlJobs :: Maybe Int+ } deriving stock (Show, Generic) instance Y.FromJSON YamlConfig where parseJSON (Y.Object v) =- YamlConfig <$> v .:? "languages" .!= []+ YamlConfig <$> v .:? "file_types" .!= []+ <*> v .:? "file_kinds" .!= [] <*> v .:? "prune_dirs" .!= [] <*> v .:? "colors" .!= False <*> v .:? "color_filename" .!= Nothing <*> v .:? "color_match" .!= Nothing <*> v .:? "file_line" .!= False+ <*> v .:? "threads" .!= Nothing parseJSON _ = mzero getConfig :: IO (Config, Maybe FilePath) getConfig = do home <- getHomeDirectory- confs <- filterM doesFileExist [cgreprc, "." ++ cgreprc, home </> "." ++ cgreprc, "/etc" </> cgreprc]+ confs <- filterM doesFileExist [cgreprc, "." <> cgreprc, home </> "." <> cgreprc, "/etc" </> cgreprc] if notNull confs then do conf <- Y.decodeFileEither (head confs)@@ -114,6 +147,15 @@ readColor "Magenta" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Magenta] readColor "Cyan" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Cyan] readColor "White" = Just [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid White]-readColor _ = Nothing+readColor "Orange" = Just [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB 5 2 0]+readColor "Acqua" = Just [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB 2 5 4]+readColor xs = case splitOn ":" xs of+ [r, g, b] -> Just [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB (read r) (read g) (read b)]+ _ -> Nothing +dumpPalette :: IO ()+dumpPalette = do+ let palette = [(r, g, b) | r <- [0..5], g <- [0..5], b <- [0..5]]+ forM_ palette $ \(r, g, b) -> do+ putStrLn $ setSGRCode [SetConsoleIntensity BoldIntensity, SetPaletteColor Foreground $ xterm6LevelRGB r g b] <> "COLOR " <> show r <> ":" <> show g <> ":" <> show b <> setSGRCode []
− src/Debug.hs
@@ -1,43 +0,0 @@------ copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>------ 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.Trans.Reader-import Control.Monad.IO.Class-import Control.Monad--import Options-import Reader---putStrLevel1 :: String -> OptionT IO ()-putStrLevel1 xs = do- n <- reader $ debug . snd- when (n > 0) $ liftIO $ putStrLn xs--putStrLevel2 :: String -> OptionT IO ()-putStrLevel2 xs = do- n <- reader $ debug . snd- when (n > 1) $ liftIO $ putStrLn xs--putStrLevel3 :: String -> OptionT IO ()-putStrLevel3 xs = do- n <- reader $ debug . snd- when (n > 2) $ liftIO $ putStrLn xs
src/Main.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -16,308 +16,134 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -{-# LANGUAGE RecordWildCards #-}- module Main where -import Data.List-import Data.List.Split (chunksOf)-import qualified Data.Map as M-import Data.Maybe-import Data.Char-import Data.Data()--import Data.IORef-import Data.Version(showVersion)-import Data.Function-import qualified Data.Set as Set-import Paths_cgrep--import Control.Exception as E-import Control.Concurrent-import Control.Concurrent.Async-import Control.Monad.STM-import Control.Concurrent.STM.TChan--import Control.Monad-import Control.Monad.Trans-import Control.Monad.Trans.Except-import Control.Monad.Trans.Reader-import Control.Applicative--import System.Console.CmdArgs-import System.Directory-import System.FilePath ((</>))-import System.Environment-import System.PosixCompat.Files as PosixCompat-import System.IO-import System.Exit-import System.Process (readProcess, runProcess, waitForProcess)--import CGrep.CGrep-import CGrep.Lang-import CGrep.Output-import CGrep.Common-import CGrep.Parser.WildCard--import CmdOptions-import Options-import Util-import Debug-import Config-import Reader--import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C import qualified Codec.Binary.UTF8.String as UC -import Data.Tuple.Extra--fileFilter :: Options -> [Lang] -> FilePath -> Bool-fileFilter opts langs filename = maybe False (liftA2 (||) (const $ null langs) (`elem` langs)) (getFileLang opts filename)---getFilesMagic :: [FilePath] -> IO [String]-getFilesMagic filenames = lines <$> readProcess "/usr/bin/file" ("-b" : filenames) []----- push file names in Chan...--withRecursiveContents :: Options -> FilePath -> [Lang] -> [String] -> Set.Set FilePath -> ([FilePath] -> IO ()) -> IO ()-withRecursiveContents opts dir langs pdirs visited action = do- isDir <- doesDirectoryExist dir- if isDir then do- xs <- getDirectoryContents dir-- (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, x `notElem` [".", ".."]]-- magics <- if null (magic_filter opts) || null files- then return []- else getFilesMagic files-- -- filter the list of files- --- let files' = if null magics- then filter (fileFilter opts langs) files- else catMaybes $ zipWith (\f m -> if any (`isInfixOf` m) (magic_filter opts) then Just f else Nothing ) files magics-- unless (null files') $- let chunks = chunksOf (Options.chunk opts) files' in- forM_ chunks $ \b -> action b-- -- process dirs- --- forM_ dirs $ \path -> do- lstatus <- getSymbolicLinkStatus path- when ( deference_recursive opts || not (PosixCompat.isSymbolicLink lstatus)) $- unless (isPruneableDir path pdirs) $ do -- this is a good directory (unless already visited)!- cpath <- canonicalizePath path- unless (cpath `Set.member` visited) $- withRecursiveContents opts path langs pdirs (Set.insert cpath visited) action- else action [dir]---isPruneableDir:: FilePath -> [FilePath] -> Bool-isPruneableDir dir = any (`isSuffixOf` pdir)- where pdir = mkPrunableDirName dir--mkPrunableDirName :: FilePath -> FilePath-mkPrunableDirName xs | "/" `isSuffixOf` xs = xs- | otherwise = xs ++ "/"---- read patterns from file--readPatternsFromFile :: FilePath -> IO [C.ByteString]-readPatternsFromFile f =- if null f then return []- else map trim8 . C.lines <$> C.readFile f--getFilePaths :: Bool -> -- pattern(s) from file- [String] -> -- list of patterns and files- [String]-getFilePaths False xs = if length xs == 1 then [] else tail xs-getFilePaths True xs = xs---parallelSearch :: [FilePath] -> [C.ByteString] -> [Lang] -> (Bool, Bool) -> OptionT IO ()-parallelSearch paths patterns langs (isTermIn, _) = do-- (conf@Config{..}, opts@Options{..}) <- ask-- -- create Transactional Chan and Vars...-- in_chan <- liftIO newTChanIO- out_chan <- liftIO newTChanIO--- -- launch worker threads...-- forM_ [1 .. jobs] $ \_ -> liftIO . forkIO $- void $ runExceptT . forever $ do- fs <- lift $ atomically $ readTChan in_chan- lift $- E.catch (- case fs of- [] -> atomically $ writeTChan out_chan []- xs -> void $ (if asynch then flip mapConcurrently- else forM) xs $ \x -> do- out <- fmap (take max_count ) (runReaderT (runCgrep conf opts x patterns) (conf, sanitizeOptions x opts))- unless (null out) $ atomically $ writeTChan out_chan out)- (\e -> let msg = show (e :: SomeException) in- hPutStrLn stderr (showFileName conf opts (getTargetName (head fs))- ++ ": exception: " ++ takeN 80 msg))- when (null fs) $ throwE ()--- -- push the files to grep for...-- _ <- liftIO . forkIO $ do-- if recursive || deference_recursive- then forM_ (if null paths then ["."] else paths) $ \p ->- withRecursiveContents opts p langs- (mkPrunableDirName <$> configPruneDirs ++ prune_dir) (Set.singleton p) (atomically . writeTChan in_chan)-- else forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . (:[]))-- -- enqueue EOF messages:-- replicateM_ jobs ((atomically . writeTChan in_chan) [])-- -- dump output until workers are done-- putPrettyHeader-- let stop = jobs-- matchingFiles <- liftIO $ newIORef Set.empty-- fix (\action n m ->- unless (n == stop) $ do- out <- liftIO $ atomically $ readTChan out_chan- case out of- [] -> action (n+1) m- _ -> do- case () of- _ | json -> when m $ liftIO $ putStrLn ","- | otherwise -> return ()- let out' = map (\p -> p {outTokens = map (\(off, s) -> (length $ UC.decode $ B.unpack $ C.take off $ outLine p, UC.decodeString s)) $ outTokens p}) out- prettyOutput out' >>= mapM_ (liftIO . putStrLn)- liftIO $ when (vim || editor) $- mapM_ (modifyIORef matchingFiles . Set.insert . (outFilePath &&& outLineNo)) out- action n True- ) 0 False--- putPrettyFooter+import Data.List ( isSuffixOf, (\\), isInfixOf, nub, sort, union, isPrefixOf, genericLength, partition, elemIndex )+import Data.Maybe ( catMaybes )+import Data.Char ( toLower )+import Data.Version ( showVersion ) - -- run editor...+import Control.Monad.Trans.Reader ( ReaderT(runReaderT), ask )+import Control.Monad ( when, void ) - when (vim || editor ) $ liftIO $ do+import qualified Data.Map as M+import GHC.Conc ( getNumCapabilities, setNumCapabilities )+import GHC.IO.Handle ( hIsTerminalDevice ) - editor' <- if vim- then return (Just "vim")- else lookupEnv "EDITOR"+import System.IO ( stdin, stdout, stderr )+import System.Console.CmdArgs ( cmdArgsRun )+import System.Exit ( exitSuccess )+import System.Environment ( withArgs ) - files <- Set.toList <$> readIORef matchingFiles+import CGrep.FileType ( readTypeList, readKindList )+import CGrep.FileTypeMap ( dumpFileTypeInfoMap, fileTypeInfoMap )+import CGrep.Parser.Atom ( wildCardMap )+import CGrep.Common ( trim8 ) - let editFiles = (if fileline || configFileLine- then fmap (\(a,b) -> a ++ ":" ++ show b)- else nub . sort . fmap fst) files+import Verbose ( putMsgLnVerbose )+import Paths_cgrep ( version )+import CmdOptions ( options )+import Options ( Options(..) )+import Config+ ( dumpPalette, getConfig, Config(configFileTypes, configColors, configJobs, configFileKinds) ) - putStrLn $ "cgrep: open files " ++ unwords editFiles ++ "..."- void $ runProcess (fromJust $ editor' <|> Just "vi")- editFiles- Nothing- Nothing- (Just stdin)- (Just stdout)- (Just stderr) >>= waitForProcess+import Util ( partitionM)+import Reader ( ReaderIO, Env (..) )+import Search ( parallelSearch, isRegexp )+import System.Posix.FilePath (RawFilePath) +import Data.List.Extra (notNull)+import Data.Functor ( ($>), void )+import Control.Applicative ( Alternative((<|>)) ) main :: IO () main = do -- check whether this is a terminal device- isTermIn <- hIsTerminalDevice stdin isTermOut <- hIsTerminalDevice stdout - -- read Cgrep config options-- (conf, _) <- getConfig+ -- read config options+ (conf, _) <- getConfig -- read command-line options-- opts <- (if isTermOut+ opt@Options{..} <- (if isTermOut then \o -> o { color = color o || configColors conf } else id) <$> cmdArgsRun options -- 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!"-+ when (length (catMaybes [ if json then Just "" else Nothing ]) > 1) $+ error "Cgrep: you can use one back-end at time!" -- display lang-map and exit...+ when type_map $+ dumpFileTypeInfoMap fileTypeInfoMap >> exitSuccess - when (language_map opts) $- dumpLangMap langMap >> exitSuccess+ -- display color palette and exit...+ when show_palette $+ dumpPalette >> exitSuccess -- check whether the pattern list is empty, display help message if it's the case-- when (null (others opts) && isTermIn && null (file opts)) $+ when (null others && isTermIn && null file) $ withArgs ["--help"] $ void (cmdArgsRun options) - -- load patterns:+ let others' = C.pack <$> others - patterns <- if null (file opts) then return $ map (C.pack . UC.encodeString) (((:[]).head.others) opts)- else readPatternsFromFile $ file opts+ -- load patterns+ patterns <- if null file then pure $ readPatternsFromCommandLine others'+ else readPatternsFromFile (C.pack file) - let patterns' = map (if ignore_case opts then ic else id) patterns- where ic | (not . isRegexp) opts && semantic opts = C.unwords . map (\p -> if C.unpack p `elem` wildCardTokens then p else C.map toLower p) . C.words+ let patterns' = map (if ignore_case then ic else id) patterns+ where ic | (not . isRegexp) opt && semantic = C.unwords . map (\p -> if p `elem` wildCardTokens then p else C.map toLower p) . C.words | otherwise = C.map toLower where wildCardTokens = "OR" : M.keys wildCardMap -- "OR" is not included in wildCardMap -- display the configuration in use -- when (isJust confpath) $- -- hPutStrLn stderr $ showBold opts ("Using '" ++ fromJust confpath ++ "' configuration file...")+ -- hPutStrLn stderr $ showBold opt ("Using '" <> fromJust confpath <> "' configuration file...") -- load files to parse:-- let paths = getFilePaths (notNull (file opts)) (others opts)+ let paths = getFilePaths (notNull file) others' -- parse cmd line language list:+ let (l0, l1, l2) = readTypeList type_filter - let (l0, l1, l2) = splitLangList (language_filter opts)+ -- file type enabled:+ let types = (if null l0 then configFileTypes conf else l0 `union` l1) \\ l2+ kinds = if null kind_filter then configFileKinds conf else readKindList kind_filter - -- language enabled: - let langs = (if null l0 then configLanguages conf else l0 `union` l1) \\ l2-- runReaderT (do putStrLevel1 $ "Cgrep " ++ showVersion version ++ "!"- putStrLevel1 $ "options : " ++ show opts- putStrLevel1 $ "config : " ++ show conf- putStrLevel1 $ "languages : " ++ show langs- putStrLevel1 $ "pattern : " ++ show patterns'- putStrLevel1 $ "files : " ++ show paths- putStrLevel1 $ "isTermIn : " ++ show isTermIn- putStrLevel1 $ "isTermOut : " ++ show isTermOut- ) (conf, opts)+ runReaderT (do+ putMsgLnVerbose 1 stderr $ "cgrep " <> showVersion version <> "!"+ putMsgLnVerbose 1 stderr $ "File types: " <> show type_filter+ putMsgLnVerbose 1 stderr $ "File kinds: " <> show kinds+ ) (Env conf opt) -- specify number of cores-- when (cores opts /= 0) $ setNumCapabilities (cores opts)+ cap <- case jobs <|> configJobs conf of+ (Just j) -> setNumCapabilities (j+1) $> j+ Nothing -> getNumCapabilities -- run search+ runReaderT (parallelSearch paths patterns' types kinds isTermIn) (Env conf opt {jobs = Just cap}) - runReaderT (parallelSearch paths patterns' langs (isTermIn, isTermOut)) (conf, opts) +readPatternsFromFile :: RawFilePath -> IO [C.ByteString]+readPatternsFromFile "" = return []+readPatternsFromFile f = map trim8 . C.lines <$> C.readFile (C.unpack f) ++readPatternsFromCommandLine :: [C.ByteString] -> [C.ByteString]+readPatternsFromCommandLine [] = []+readPatternsFromCommandLine xs | ":" `elem` xs = takeWhile (/= ":") xs+ | otherwise = [ head xs ]+++getFilePaths :: Bool -> [RawFilePath] -> [RawFilePath]+getFilePaths False xs = case ":" `elemIndex` xs of+ Nothing -> if null xs then [] else tail xs+ (Just n) -> drop (n+1) xs+getFilePaths True xs = xs
src/Options.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -20,7 +20,7 @@ module Options where -import Data.Data+import Data.Data ( Data, Typeable ) data Options = Options -- Pattern:@@ -36,28 +36,27 @@ , code :: Bool , comment :: Bool , literal :: Bool- -- Semantic:- , semantic :: Bool- -- C/C++ Token:+ -- Tokenizer: , identifier :: Bool+ , nativeType :: Bool , keyword :: Bool- , directive :: Bool- , header :: Bool , number :: Bool , string :: Bool- , char :: Bool- , oper :: Bool+ , operator :: Bool+ -- Semantic:+ , semantic :: Bool -- Output control: , max_count :: Int- , language_filter :: [String]- , language_force :: Maybe String- , language_map :: Bool- , magic_filter :: [String]+ , type_filter :: [String]+ , kind_filter :: [String]+ , type_force :: Maybe String+ , type_map :: Bool , invert_match :: Bool , multiline :: Int , recursive :: Bool+ , skip_test :: Bool , prune_dir :: [FilePath]- , deference_recursive :: Bool+ , follow :: Bool -- Output format: , show_match :: Bool , color :: Bool@@ -67,23 +66,15 @@ , no_column :: Bool , count :: Bool , filename_only :: Bool-#ifdef ENABLE_HINT- , hint :: Maybe String-#endif- , format :: Maybe String , json :: Bool- , xml :: Bool , vim :: Bool , editor :: Bool , fileline :: Bool -- Parallel:- , jobs :: Int- , cores :: Int- , chunk :: Int- , asynch :: Bool+ , jobs :: Maybe Int -- Misc:- , debug :: Int+ , verbose :: Int , no_shallow :: Bool+ , show_palette :: Bool , others :: [String]- } deriving (Data, Typeable, Show)-+ } deriving stock (Data, Typeable, Show)
src/Reader.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -18,9 +18,14 @@ module Reader where -import Control.Monad.Trans.Reader+import Control.Monad.Trans.Reader ( ReaderT ) -import Config-import Options+import Config ( Config )+import Options ( Options ) -type OptionT = ReaderT (Config, Options)+data Env = Env {+ conf :: Config+ , opt :: Options+}++type ReaderIO = ReaderT Env IO
+ src/Search.hs view
@@ -0,0 +1,331 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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.+--nc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module Search (+ parallelSearch+ , isRegexp+) where++import Data.List ( isPrefixOf, isSuffixOf, partition, elemIndex, intersperse )+import Data.List.Split ( chunksOf )+import qualified Data.Map as M+import Data.Maybe ( fromJust, isJust, catMaybes, fromMaybe )+import Data.Function ( fix )+import qualified Data.Set as S++import Control.Exception as E ( catch, SomeException )+import Control.Concurrent ( forkIO, MVar, putMVar, forkOn, threadDelay )++import Control.Monad ( when, forM_, forever, unless, void, forM, replicateM_ )+import Control.Monad.Trans ( MonadIO(liftIO) )+import Control.Monad.Trans.Except ( runExceptT, throwE )+import Control.Monad.Trans.Reader+ ( ReaderT(runReaderT), ask, reader, ask, local )+import Control.Applicative+ ( Applicative(liftA2), Alternative((<|>)) )++import System.Environment ( lookupEnv )+import System.PosixCompat.Files as PC+ ( getFileStatus, getSymbolicLinkStatus, isDirectory, FileStatus )+import System.IO+ ( BufferMode(BlockBuffering),+ hSetBinaryMode,+ hSetBuffering,+ hPutStrLn,+ stderr,+ stdin,+ stdout,+ stderr,+ hPutStrLn )++import System.Process ( runProcess, waitForProcess )++import CGrep.Output+ ( putOutputElements,+ showFileName,+ Output(..),+ showFileName )+import CGrep.Common ( takeN, getTargetName, Text8, takeN )+import Options ( Options(..) )+import Config+ ( Config(Config, configFileTypes, configFileLine, configColorMatch,+ configColorFile, configColors, configPruneDirs),+ dumpPalette )+import Reader+ ( Env(Env, opt, conf),+ ReaderIO,+ Env(..) )++import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B++import qualified Data.ByteString.Lazy.Char8 as LB+import qualified Data.ByteString.Char8 as C+import qualified Codec.Binary.UTF8.String as UC++import Data.Tuple.Extra ( )+import qualified Data.Bifunctor++import qualified Data.Vector as V hiding ((!))+import Data.Vector ((!))++import Data.IORef+ ( modifyIORef, modifyIORef', newIORef, readIORef, IORef, atomicModifyIORef, atomicModifyIORef' )+import Control.Concurrent.Chan.Unagi.Bounded+ ( newChan, readChan, writeChan )++import System.Posix.Directory.Traversals ( getDirectoryContents )+import System.Posix.FilePath ( RawFilePath, takeBaseName, (</>) )+import System.Posix.Directory.Foreign (dtDir)+import System.Directory (makeAbsolute, canonicalizePath)+import Data.Functor ( void, (<&>), ($>))+import RawFilePath.Directory (doesDirectoryExist)+import Control.Arrow ( Arrow((&&&)) )+import Control.Concurrent.Async (forConcurrently, forConcurrently_, mapConcurrently_, async, Async, wait, asyncOn)++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.Tokenizer as Tokenizer+import qualified CGrep.Strategy.Semantic as Semantic+import Control.Monad.Catch ( SomeException, MonadCatch(catch) )+import Control.Monad.IO.Class ( MonadIO(liftIO) )++import CGrep.FileType ( FileType )+import CGrep.FileTypeMap+ ( fileTypeInfoLookup, fileTypeLookup, FileTypeInfo )++import Control.Monad.Loops ( whileM_ )+import Verbose (putMsgLnVerbose, putMsgLn)+import Control.Concurrent.MVar ( newMVar, takeMVar )+import Data.IORef.Extra (atomicWriteIORef')+import CGrep.FileKind ( FileKind )+import qualified Data.List.NonEmpty as NE (unzip)+++withRecursiveContents :: Options+ -> RawFilePath+ -> [FileType]+ -> [FileKind]+ -> [RawFilePath]+ -> S.Set RawFilePath+ -> IORef Int+ -> ([RawFilePath] -> IO ()) -> IO ()+withRecursiveContents opt@Options{..} dir fTypes fKinds pdirs visited walkers action = do+ xs <- getDirectoryContents dir+ let (dirs, files) = partition ((== dtDir) . fst) xs++ -- filter the list of files+ let files' = (dir </>) . snd <$> filter (\f -> fileFilter opt fTypes fKinds (snd f) && (not skip_test || isNotTestFile (snd f))) files+ let dirs' = (dir </>) . snd <$> dirs++ -- run IO action+ mapM_ action (chunksOf 8 files')++ -- process directories recursively...+ foreach <- readIORef walkers >>= \tot -> do+ if tot < 64 then pure (forConcurrently_ @[])+ else pure forM_++ foreach dirs' $ \dirPath -> do+ unless (isPrunableDir dirPath pdirs) $+ -- this is a good directory, unless already visited...+ -- this is a good directory, unless already visited...+ -- this is a good directory, unless already visited...+ -- this is a good directory, unless already visited...++ -- this is a good directory, unless already visited...++ -- this is a good directory, unless already visited...++ -- this is a good directory, unless already visited...+ -- this is a good directory, unless already visited...++ -- this is a good directory, unless already visited...+ makeRawAbsolute dirPath >>= \cpath ->+ unless (cpath `S.member` visited) $ incrRef walkers *>+ withRecursiveContents opt dirPath fTypes fKinds pdirs (S.insert cpath visited) walkers action++ decrRef walkers+++parallelSearch :: [RawFilePath] -> [C.ByteString] -> [FileType] -> [FileKind] -> Bool -> ReaderIO ()+parallelSearch paths patterns fTypes fKinds isTermIn = do+ Env{..} <- ask++ let Config{..} = conf+ Options{..} = opt++ let multiplier = 4+ jobs' = fromMaybe 1 jobs+ totalJobs = jobs' * multiplier++ -- create channels ...+ fileCh <- liftIO $ newChan 65536++ -- recursively traverse the filesystem ...+ _ <- liftIO . forkOn 0 $ do+ walkers <- newIORef (0 :: Int)+ if recursive || follow+ then forM_ (if null paths then ["."] else paths) $ \p ->+ doesDirectoryExist p >>= \case+ True -> incrRef walkers *>+ withRecursiveContents opt p fTypes fKinds+ (mkPrunableDirName <$> configPruneDirs <> (C.pack <$> prune_dir)) (S.singleton p) walkers (do+ writeChan (fst fileCh))+ _ -> writeChan (fst fileCh) [p]+ else forM_ (if null paths && not isTermIn+ then [("", 0)]+ else paths `zip` [0..]) (\(p, idx) -> writeChan (fst fileCh) [p])++ -- enqueue EOF messages...+ when (verbose > 0) $ putMsgLn @Text8 stderr "filesystem traversal completed!"+ replicateM_ totalJobs $ writeChan (fst fileCh) []++ -- launch the worker threads...+ matchingFiles <- liftIO $ newIORef S.empty++ let env = Env conf opt+ runSearch = getSearcher env++ workers <- forM ([0 .. totalJobs-1] :: [Int]) $ \idx -> do+ let processor = 1 + idx `div` multiplier+ liftIO . asyncOn processor $ void . runExceptT $ do+ asRef <- liftIO $ newIORef ([] :: [Async ()])+ forever $ do+ fs <- liftIO $ readChan (snd fileCh)+ liftIO $ E.catch (+ case fs of+ [] -> liftIO $ readIORef asRef >>= mapM_ wait+ fs -> runReaderT (do+ out <- catMaybes <$> forM fs (\f -> do+ out' <- take max_count <$> runSearch (fileTypeInfoLookup opt f) f patterns+ when (vim || editor) $+ liftIO $ mapM_ (modifyIORef matchingFiles . S.insert . (outFilePath &&& outLineNumb)) out'+ putOutputElements out')+ unless (null out) $+ liftIO $ async (do+ let !dump = LB.toStrict $ B.toLazyByteString (mconcat ((<> B.char8 '\n') <$> out))+ B.hPut stdout dump) >>= \a -> modifyIORef' asRef (a:)+ ) env+ ) (\e -> let msg = show (e :: SomeException) in+ C.hPutStrLn stderr (showFileName conf opt (getTargetName (head fs)) <> ": error: " <> C.pack (takeN 120 msg)))+ when (null fs) $ do+ when (verbose > 0) $ putMsgLn stderr $ "[" <> C.pack (show idx) <> "]@" <> C.pack (show processor) <>" searcher done!"+ throwE ()++ -- wait workers to complete the job+ liftIO $ mapM_ wait workers++ -- run editor...+ when (vim || editor ) $ liftIO $ do+ editor' <- if vim+ then return (Just "vim")+ else lookupEnv "EDITOR"++ files <- S.toList <$> readIORef matchingFiles+ let filesUnpacked = Data.Bifunctor.first C.unpack <$> files++ let editFiles = (if fileline || configFileLine+ then fmap (\(a,b) -> a <> ":" <> show b)+ else fmap fst) filesUnpacked++ putStrLn $ "cgrep: open files " <> unwords editFiles <> "..."++ void $ runProcess (fromJust $ editor' <|> Just "vi")+ editFiles+ Nothing+ Nothing+ (Just stdin)+ (Just stdout)+ (Just stderr) >>= waitForProcess++getSearcher :: Env -> (Maybe (FileType, FileTypeInfo) -> RawFilePath -> [Text8] -> ReaderIO [Output])+getSearcher Env{..} = do+ if | (not . isRegexp) opt && not (hasTokenizerOpt opt) && not (semantic opt) && edit_dist opt -> Levenshtein.search+ | (not . isRegexp) opt && not (hasTokenizerOpt opt) && not (semantic opt) -> BoyerMoore.search+ | (not . isRegexp) opt && semantic opt -> Semantic.search+ | (not . isRegexp) opt -> Tokenizer.search+ | isRegexp opt -> Regex.search+ | otherwise -> undefined+++makeRawAbsolute :: RawFilePath -> IO RawFilePath+makeRawAbsolute p = makeAbsolute (C.unpack p) <&> C.pack+{-# INLINE makeRawAbsolute #-}++incrRef :: IORef Int -> IO ()+incrRef ref = atomicModifyIORef' ref (\n -> (n+1, ()))+{-# INLINE incrRef #-}++decrRef :: IORef Int -> IO ()+decrRef ref = atomicModifyIORef' ref (\n -> (n-1, ()))+{-# INLINE decrRef #-}+++fileFilter :: Options -> [FileType] -> [FileKind] -> RawFilePath -> Bool+fileFilter opt fTypes fKinds filename = fileFilterTypes typ && fileFilterKinds kin+ where (typ, kin) = NE.unzip $ fileTypeLookup opt filename+ fileFilterTypes = maybe False (liftA2 (||) (const $ null fTypes) (`elem` fTypes))+ fileFilterKinds = maybe False (liftA2 (||) (const $ null fKinds) (`elem` fKinds))+++isNotTestFile :: RawFilePath -> Bool+isNotTestFile f =+ let fs = [("_test" `C.isSuffixOf`), ("-test" `C.isSuffixOf`), ("test-" `C.isPrefixOf`), ("test_" `C.isPrefixOf`), ("test" == )] :: [C.ByteString -> Bool]+ in not $ any ($ takeBaseName f) fs+{-# INLINE isNotTestFile #-}+++isPrunableDir:: RawFilePath -> [RawFilePath] -> Bool+isPrunableDir dir = any (`C.isSuffixOf` pdir)+ where pdir = mkPrunableDirName dir+{-# INLINE isPrunableDir #-}+++mkPrunableDirName :: RawFilePath -> RawFilePath+mkPrunableDirName xs | "/" `C.isSuffixOf` xs = xs+ | otherwise = xs <> "/"+{-# INLINE mkPrunableDirName #-}+++(.!.) :: V.Vector a -> Int -> a+v .!. i = v ! (i `mod` V.length v)+{-# INLINE (.!.) #-}+++hasFileType :: RawFilePath -> Options -> [FileType] -> Bool+hasFileType path opt xs = isJust $ fileTypeLookup opt path >>= (\(typ, _) -> typ `elemIndex` xs)+{-# INLINE hasFileType #-}+++hasTokenizerOpt :: Options -> Bool+hasTokenizerOpt Options{..} =+ identifier ||+ nativeType ||+ keyword ||+ number ||+ string ||+ operator+++isRegexp :: Options -> Bool+isRegexp opt = regex_posix opt || regex_pcre opt+{-# INLINE isRegexp #-}
src/Util.hs view
@@ -1,5 +1,5 @@ ----- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com> -- -- 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@@ -18,57 +18,47 @@ module Util where -import qualified Data.ByteString.Char8 as C-import qualified Data.ByteString.Lazy.Char8 as LC--import Data.Array.Unboxed--import Data.Maybe-import Data.Char---- from hlint :-)+import Data.Maybe ( listToMaybe )+import Data.Char ( toLower ) +import qualified Data.ByteString.Char8 as C+import qualified Data.Sequence as S+import Data.Sequence ((|>), Seq((:<|), (:|>), Empty))+import Text.Read (readMaybe) partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) partitionM _ [] = return ([], []) partitionM f (x:xs) = do res <- f x (as,bs) <- partitionM f xs- return ([x | res]++as, [x | not res]++bs)---notNull :: [a] -> Bool-notNull = not . null+ return ([x | res]<>as, [x | not res]<>bs)+{-# INLINE partitionM #-} xor :: Bool -> Bool -> Bool a `xor` b = a && not b || not a && b+{-# INLINE xor #-} prettyRead :: Read a => String -> String -> a prettyRead xs err = case readMaybe xs of Just v -> v- _ -> error $ err ++ ": parse error near " ++ show (take 40 xs)---readMaybe :: Read a => String -> Maybe a-readMaybe = fmap fst . listToMaybe . reads+ _ -> error $ err <> ": parse error near '" <> take 40 xs <> "'" 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+{-# INLINE spanGroup #-} -toLowercase :: Char -> Char-toLowercase x = ctypeLowercase ! x- where ctypeLowercase = listArray ('\0','\255') (map toLower ['\0'..'\255']) :: UArray Char Char+spanGroupSeq :: Int -> S.Seq a -> [S.Seq a]+spanGroupSeq _ S.Empty = []+spanGroupSeq 1 xs = [xs]+spanGroupSeq n xs = S.take n xs : spanGroupSeq n (S.drop 1 xs)+{-# INLINE spanGroupSeq #-} rmQuote :: String -> String@@ -78,4 +68,31 @@ | x == '"' || x == '\'' = if x == last xs then init xs else y | otherwise = y+{-# INLINE rmQuote #-} ++rmQuote8 :: C.ByteString -> C.ByteString+rmQuote8 b | C.length b < 2 = b+ | otherwise =+ case C.uncons b of+ Just (x,xs) -> if (x == '"' || x == '\'') && (x == C.last b) then C.init xs else b+ _ -> b+{-# INLINE rmQuote8 #-}+++mapMaybe' :: Foldable f => (a -> Maybe b) -> f a -> [b]+mapMaybe' f = foldr g []+ where+ g x rest+ | Just y <- f x = y : rest+ | otherwise = rest+++findWithIndex :: forall a. (a -> Bool) -> [a] -> (# Int, Maybe a #)+findWithIndex predicate = go predicate 0+ where+ go :: forall a. (a -> Bool) -> Int -> [a] -> (# Int, Maybe a #)+ go p _ [] = (# 0, Nothing #)+ go p !index (x:xs)+ | p x = (# index, Just x #)+ | otherwise = go p (index + 1) xs
+ src/Verbose.hs view
@@ -0,0 +1,66 @@+--+-- Copyright (c) 2013-2023 Nicola Bonelli <nicola@larthia.com>+--+-- 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 Verbose where++import Control.Monad.Trans.Reader ( reader )+import Control.Monad.IO.Class ( MonadIO(liftIO) )+import Control.Monad ( when )++import Options ( Options(verbose) )+import Reader ( ReaderIO, Env(..) )++import qualified Data.ByteString as C (hPutStr, hPut)+import GHC.IO.Handle ( Handle )+import System.IO ( Handle, hPutStrLn, hPutStr )+import Data.String ( IsString )++import qualified Data.ByteString.Char8 as C+import qualified Data.Text as T+import qualified Data.Text.IO as T+++class (IsString a) => PutStr a where+ putStringLn :: Handle -> a -> IO ()+ putString :: Handle -> a -> IO ()++instance PutStr String where+ putStringLn = hPutStrLn+ putString = hPutStr++instance PutStr C.ByteString where+ putStringLn = C.hPutStrLn+ putString = C.hPutStr++instance PutStr T.Text where+ putStringLn = T.hPutStrLn+ putString = T.hPutStr+++putMsgLnVerbose :: (PutStr a) => Int -> Handle -> a -> ReaderIO ()+putMsgLnVerbose l h xs = do+ n <- reader $ verbose . opt+ when (n >= l) $+ liftIO $ putStringLn h xs+{-# INLINE putMsgLnVerbose #-}+++putMsgLn :: (PutStr a, MonadIO m) => Handle -> a -> m ()+putMsgLn h xs =+ liftIO $ putStringLn h xs+{-# INLINE putMsgLn #-}