pgrep (empty) → 0.1.0.0
raw patch · 12 files changed
+1298/−0 lines, 12 filesdep +basedep +containersdep +directory
Dependencies added: base, containers, directory, filepath, optparse-applicative, parsec, pgrep, process, scrappy-core
Files
- LICENSE +28/−0
- README.md +114/−0
- app/Main.hs +151/−0
- pgrep.cabal +64/−0
- src/Scrappy/Files.hs +83/−0
- src/Scrappy/Grep/Config.hs +99/−0
- src/Scrappy/Grep/DSL.hs +47/−0
- src/Scrappy/Grep/DSL/Interpreter.hs +115/−0
- src/Scrappy/Grep/DSL/Parser.hs +177/−0
- src/Scrappy/Grep/Output.hs +67/−0
- src/Scrappy/Grep/Search.hs +74/−0
- test/Test.hs +279/−0
+ LICENSE view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2024, Galen Sprout++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,114 @@+# scrappy-file++File system utilities for the scrappy web scraping library, plus **pgrep** - a grep-like CLI that uses Parsec parsers instead of regex.++## pgrep++Search files using Parsec parser patterns instead of regular expressions.++### Installation++```bash+cabal build pgrep+cabal install pgrep+```++Make sure `~/.local/bin` is in your PATH:+```bash+export PATH="$HOME/.local/bin:$PATH"+```++### Usage++```bash+pgrep PATTERN FILE...+pgrep [OPTIONS] PATTERN FILE...+```++### DSL Primitives++| Primitive | Example | Description |+|-----------|---------|-------------|+| `char` | `char 'x'` | Single character |+| `string` | `string "abc"` | Literal string |+| `anyChar` | `anyChar` | Any character |+| `digit` | `digit` | 0-9 |+| `letter` | `letter` | a-z, A-Z |+| `alphaNum` | `alphaNum` | Letter or digit |+| `space` | `space` | Single whitespace |+| `spaces` | `spaces` | Zero or more whitespace |+| `newline` | `newline` | Newline character |+| `oneOf` | `oneOf "abc"` | Match one of chars |+| `noneOf` | `noneOf "xyz"` | Match none of chars |++### DSL Combinators++| Combinator | Syntax | Description |+|------------|--------|-------------|+| Sequence | `p1 >> p2` | Run p1 then p2, return p2's result |+| Concat | `p1 <+> p2` | Run both, concatenate results |+| Alternative | `p1 <\|> p2` | Try p1, else p2 |+| Many | `many p` | Zero or more |+| Some | `some p` | One or more |+| Optional | `optional p` | Zero or one |+| Try | `try p` | Backtracking |+| Between | `between '(' ')' p` | Parse between delimiters |+| Count | `count 3 p` | Exactly n repetitions |+| ManyTill | `manyTill p end` | Non-greedy: match p until end |++### Examples++```bash+# Find digits+pgrep 'some digit' file.txt++# Find email patterns+pgrep 'some alphaNum <+> char '\''@'\'' <+> some alphaNum <+> char '\''.'\'' <+> some letter' contacts.txt++# Find TODO comments+pgrep 'string "TODO"' -r ./src/++# Search recursively with extension filter+pgrep -r -e .hs 'string "import"' ./src/++# Count matches+pgrep -c 'digit' data.txt++# JSON output+pgrep --json 'some digit' file.txt++# Non-greedy matching: find everything between X and Y+pgrep 'string "START" <+> manyTill anyChar (string "END")' file.txt+```++### Options++```+-r, --recursive Search directories recursively+-e, --extension EXT Only search files with extension (e.g., .hs, .txt)+-v, --verbose Verbose output with full match text+-c, --count Only print count of matches+-q, --quiet Quiet mode (exit code only)+-m, --max-results N Maximum number of results to show+--json Output results as JSON+```++### Output Format++Default output is grep-like:+```+file.txt:1:28:123+file.txt:2:5:test@example.com+```++Format: `filepath:line:column:matched_text`++## Library API++The `Scrappy.Grep.*` modules expose:++- `Scrappy.Grep.DSL` - AST types (`ParserExpr`, `MatchResult`)+- `Scrappy.Grep.DSL.Parser` - Parse DSL strings to AST+- `Scrappy.Grep.DSL.Interpreter` - Convert AST to Parsec parsers+- `Scrappy.Grep.Search` - File/directory search functions+- `Scrappy.Grep.Output` - Result formatting
+ app/Main.hs view
@@ -0,0 +1,151 @@+module Main where++import Scrappy.Grep.DSL+import Scrappy.Grep.DSL.Parser (parseExpr)+import Scrappy.Grep.DSL.Interpreter (interpret, InterpreterError(..))+import Scrappy.Grep.Search (searchFile, searchFiles, searchText)+import Scrappy.Grep.Output (formatResults, OutputFormat(..))+import Scrappy.Files (listFilesRecursive)++import Options.Applicative+import System.Exit (exitFailure, exitSuccess)+import System.IO (hPutStrLn, stderr)+import System.Directory (doesDirectoryExist, doesFileExist)+import System.FilePath (takeExtension)+import Control.Monad (filterM, when)+import Data.List (isSuffixOf)++data Options = Options+ { optPattern :: String+ , optTargets :: [FilePath]+ , optRecursive :: Bool+ , optExtensions :: [String]+ , optVerbose :: Bool+ , optCount :: Bool+ , optQuiet :: Bool+ , optMaxResults :: Maybe Int+ , optJSON :: Bool+ } deriving Show++optionsParser :: Parser Options+optionsParser = Options+ <$> strArgument+ ( metavar "PATTERN"+ <> help "Parsec DSL pattern (e.g., 'some digit >> char '@' >> some letter')"+ )+ <*> some (strArgument+ ( metavar "FILE..."+ <> help "Files or directories to search"+ ))+ <*> switch+ ( long "recursive"+ <> short 'r'+ <> help "Search directories recursively"+ )+ <*> many (strOption+ ( long "extension"+ <> short 'e'+ <> metavar "EXT"+ <> help "Only search files with extension (e.g., .hs, .txt)"+ ))+ <*> switch+ ( long "verbose"+ <> short 'v'+ <> help "Verbose output with full match text"+ )+ <*> switch+ ( long "count"+ <> short 'c'+ <> help "Only print count of matches"+ )+ <*> switch+ ( long "quiet"+ <> short 'q'+ <> help "Quiet mode (exit code only)"+ )+ <*> optional (option auto+ ( long "max-results"+ <> short 'm'+ <> metavar "N"+ <> help "Maximum number of results to show"+ ))+ <*> switch+ ( long "json"+ <> help "Output results as JSON"+ )++main :: IO ()+main = do+ opts <- execParser $ info (optionsParser <**> helper)+ ( fullDesc+ <> progDesc "Search files using Parsec parser patterns"+ <> header "pgrep - grep with parser combinators"+ )++ -- Parse the DSL pattern+ case parseExpr (optPattern opts) of+ Left err -> do+ hPutStrLn stderr $ "Pattern parse error: " ++ show err+ exitFailure+ Right ast -> do+ -- Interpret the AST into a parser+ case interpret ast of+ Left (UnknownRef name) -> do+ hPutStrLn stderr $ "Unknown parser reference: " ++ name+ hPutStrLn stderr "Note: Config-based refs not yet implemented. Use inline DSL only."+ exitFailure+ Right parser -> do+ -- Gather all files to search+ files <- gatherFiles opts (optTargets opts)++ -- Search all files+ allResults <- searchFiles parser files++ -- Apply max results limit+ let results = case optMaxResults opts of+ Nothing -> allResults+ Just n -> take n allResults++ -- Output based on options+ if optQuiet opts+ then if null results then exitFailure else exitSuccess+ else do+ let fmt | optCount opts = FormatCount+ | optJSON opts = FormatJSON+ | optVerbose opts = FormatVerbose+ | otherwise = FormatGrep+ putStr $ formatResults fmt results+ if null results then exitFailure else exitSuccess++-- | Gather all files to search based on options+gatherFiles :: Options -> [FilePath] -> IO [FilePath]+gatherFiles opts targets = do+ allFiles <- concat <$> mapM (expandTarget opts) targets+ pure $ filterByExtension (optExtensions opts) allFiles++-- | Expand a target (file or directory) to a list of files+expandTarget :: Options -> FilePath -> IO [FilePath]+expandTarget opts target = do+ isDir <- doesDirectoryExist target+ isFile <- doesFileExist target+ case (isDir, isFile) of+ (True, _) ->+ if optRecursive opts+ then listFilesRecursive target+ else do+ hPutStrLn stderr $ "Warning: " ++ target ++ " is a directory. Use -r to search recursively."+ pure []+ (_, True) -> pure [target]+ _ -> do+ hPutStrLn stderr $ "Warning: " ++ target ++ " not found"+ pure []++-- | Filter files by extension+filterByExtension :: [String] -> [FilePath] -> [FilePath]+filterByExtension [] files = files+filterByExtension exts files = filter hasExt files+ where+ hasExt fp = any (`isSuffixOf` fp) normalizedExts+ normalizedExts = map ensureDot exts+ ensureDot ext = if "." `isPrefixOf` ext then ext else "." ++ ext+ isPrefixOf prefix str = take (length prefix) str == prefix
+ pgrep.cabal view
@@ -0,0 +1,64 @@+cabal-version: 2.4+name: pgrep+version: 0.1.0.0+synopsis: grep-like CLI using Parsec parsers instead of regex+description:+ pgrep is a grep-like command-line tool that uses Parsec parser+ combinators instead of regular expressions for pattern matching.+ Write patterns using a familiar Haskell-like DSL with combinators+ like 'some digit', 'string "TODO"', or 'manyTill anyChar (string "END")'.++homepage: https://github.com/Ace-Interview-Prep/pgrep+license: BSD-3-Clause+license-file: LICENSE+author: Galen Sprout+maintainer: galen.sprout@gmail.com+bug-reports: https://github.com/Ace-Interview-Prep/pgrep/issues+category: Text, Console+build-type: Simple+extra-source-files: README.md, LICENSE++library+ exposed-modules: Scrappy.Files+ , Scrappy.Grep.DSL+ , Scrappy.Grep.DSL.Parser+ , Scrappy.Grep.DSL.Interpreter+ , Scrappy.Grep.Search+ , Scrappy.Grep.Config+ , Scrappy.Grep.Output+ build-depends: base >=4.19.0 && <5+ , scrappy-core >=0.1.0.1 && <0.2+ , containers >=0.7 && <0.8+ , directory >=1.3.8 && <1.4+ , filepath >=1.5.4 && <1.6+ , parsec >=3.1.18 && <3.2+ , process >=1.6 && <1.7+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++executable pgrep+ main-is: Main.hs+ build-depends: base >=4.19.0 && <5+ , pgrep+ , scrappy-core >=0.1.0.1 && <0.2+ , optparse-applicative >=0.14 && <0.19+ , directory >=1.3.8 && <1.4+ , filepath >=1.5.4 && <1.6+ , containers >=0.7 && <0.8+ hs-source-dirs: app+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts++test-suite pgrep-test+ type: exitcode-stdio-1.0+ main-is: Test.hs+ build-depends: base >=4.19.0 && <5+ , pgrep+ , scrappy-core >=0.1.0.1 && <0.2+ , directory >=1.3.8 && <1.4+ , filepath >=1.5.4 && <1.6+ , parsec >=3.1.18 && <3.2+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Scrappy/Files.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Scrappy.Files where++import Scrappy.Types+import Scrappy.Scrape+import Text.Parsec+import Scrappy.Elem+import qualified Data.Map.Strict as Map+import Control.Exception+import Control.Monad+import Data.Map.Strict (Map,keys, toList)+import Data.List (foldl')+import System.FilePath+import System.Directory+++-- | Recursively lists all files in a directory, returning absolute file paths.+listFilesRecursive :: FilePath -> IO [FilePath]+listFilesRecursive dir = do+ contents <- listDirectory dir -- Get directory contents+ paths <- forM contents $ \name -> do+ let fullPath = dir </> name -- Create full path+ isDir <- doesDirectoryExist fullPath+ if isDir+ then listFilesRecursive fullPath -- Recursively search subdirectories+ else do+ absPath <- makeAbsolute fullPath -- Get absolute path in IO context+ return [absPath] -- Wrap in list for concatenation+ return (concat paths) -- Flatten list of lists+++searchFile :: ScraperT a -> FilePath -> IO Bool+searchFile p fp = do+ str <- readFile fp+ pure $ exists p str++searchStrFile :: String -> FilePath -> IO Bool+searchStrFile s fp = searchFile (string "s") fp++searchManyFile :: [String] -> FilePath -> IO (Map String Int)+searchManyFile strs fp = flip catch (\(_ :: IOException) -> pure mempty) $ do+ print fp+ file <- readFile fp+ case scrape (buildElemsOpts strs) file of+ Nothing -> pure mempty+ Just results -> pure $ countOccurrences results++-- | Function to count occurrences of each unique string in a list+countOccurrences :: [String] -> Map String Int+countOccurrences = foldl' (\acc word -> Map.insertWith (+) word 1 acc) Map.empty++++areFilesUsed :: FilePath -> FilePath -> IO ()+areFilesUsed sourceDir usageDir = do+ sources <- listFilesRecursive sourceDir+ searchFiles <- listFilesRecursive usageDir+ let sources' = takeFileName <$> sources+ maps <- mapM (\x -> searchManyFile sources' x) searchFiles+ let mapped = mconcat maps+ print mapped++ print "---"++ print $ filter (\s -> not $ elem s (keys mapped)) sources'++areFilesUsed' :: FilePath -> [FilePath] -> IO [String]+areFilesUsed' sourceDir usageDirs = do+ sources <- listFilesRecursive sourceDir+ searchFiles <- mconcat <$> mapM listFilesRecursive usageDirs+ putStr "Number of files: "+ print $ length searchFiles+ let sources' = takeFileName <$> sources+ maps <- mapM (\x -> searchManyFile sources' x) searchFiles+ let mapped = mconcat maps+ mapM_ print $ toList mapped++ print "---"++ let unused = filter (\s -> s `notElem` keys mapped) sources'+ mapM_ print unused+ pure unused
+ src/Scrappy/Grep/Config.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Scrappy.Grep.Config+ ( runParserViaGhc+ , defaultConfigPath+ , ConfigError(..)+ ) where++import System.Process (readProcessWithExitCode)+import System.Directory (doesFileExist, getHomeDirectory, createDirectoryIfMissing)+import System.FilePath ((</>))+import System.Exit (ExitCode(..))+import Control.Exception (try, SomeException)+import Text.Read (readMaybe)++data ConfigError+ = ConfigFileNotFound FilePath+ | GhcRunFailed String+ | ParseResultFailed String+ deriving (Show, Eq)++-- | Default config file path: ~/.config/parsec-grep/Parsers.hs+defaultConfigPath :: IO FilePath+defaultConfigPath = do+ home <- getHomeDirectory+ let dir = home </> ".config" </> "parsec-grep"+ createDirectoryIfMissing True dir+ pure $ dir </> "Parsers.hs"++-- | Run a named parser from the config file via runghc+-- Returns the matches as a list of (line, col, matchText)+runParserViaGhc+ :: FilePath -- ^ Config file path (Parsers.hs)+ -> String -- ^ Parser name (e.g., "email")+ -> String -- ^ Content to search+ -> IO (Either ConfigError [(Int, Int, String)])+runParserViaGhc configPath parserName content = do+ exists <- doesFileExist configPath+ if not exists+ then pure $ Left $ ConfigFileNotFound configPath+ else do+ -- Generate a wrapper script that imports the config and runs the parser+ let wrapperScript = generateWrapper configPath parserName+ result <- try $ readProcessWithExitCode "runghc" ["-e", wrapperScript] content+ case result of+ Left (e :: SomeException) -> pure $ Left $ GhcRunFailed (show e)+ Right (ExitSuccess, stdout, _) ->+ case parseOutput stdout of+ Nothing -> pure $ Left $ ParseResultFailed stdout+ Just matches -> pure $ Right matches+ Right (ExitFailure code, _, stderr) ->+ pure $ Left $ GhcRunFailed $ "Exit code " ++ show code ++ ": " ++ stderr++-- | Generate a Haskell expression that runs the parser and outputs results+generateWrapper :: FilePath -> String -> String+generateWrapper configPath parserName = unlines+ [ ":set -i" ++ takeDirectory configPath+ , ":load " ++ configPath+ , "import Parsers"+ , "import Text.Parsec"+ , "import Data.Map (lookup)"+ , "import Data.Maybe (fromMaybe)"+ , "import Scrappy.Find (findNaive)"+ , ""+ , "main = do"+ , " content <- getContents"+ , " let mParser = Data.Map.lookup \"" ++ parserName ++ "\" parsers"+ , " case mParser of"+ , " Nothing -> putStrLn \"ERROR:UnknownParser:" ++ parserName ++ "\""+ , " Just p -> do"+ , " case parse (findNaiveWithPos p) \"\" content of"+ , " Left err -> putStrLn $ \"ERROR:ParseFailed:\" ++ show err"+ , " Right Nothing -> putStrLn \"MATCHES:\""+ , " Right (Just ms) -> putStrLn $ \"MATCHES:\" ++ show ms"+ ]+ where+ takeDirectory = reverse . dropWhile (/= '/') . reverse++-- | Parse the output from runghc+parseOutput :: String -> Maybe [(Int, Int, String)]+parseOutput output+ | "MATCHES:" `isPrefixOf` output =+ let rest = drop 8 output+ in if null rest || rest == "\n"+ then Just []+ else readMaybe (takeWhile (/= '\n') rest)+ | otherwise = Nothing+ where+ isPrefixOf prefix str = take (length prefix) str == prefix++-- Note: This is a simplified implementation. A more robust version would:+-- 1. Use a temp file for the wrapper script+-- 2. Handle GHC package dependencies properly+-- 3. Cache compiled parsers for performance+--+-- For now, we'll implement a simpler version that works for basic cases+-- and can be enhanced later.+
+ src/Scrappy/Grep/DSL.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveGeneric #-}++module Scrappy.Grep.DSL+ ( ParserExpr(..)+ , MatchResult(..)+ ) where++import GHC.Generics (Generic)++-- | AST representation of the parsec-grep DSL+data ParserExpr+ -- Primitives+ = PChar Char -- char 'x'+ | PString String -- string "abc"+ | PAnyChar -- anyChar+ | PDigit -- digit+ | PLetter -- letter+ | PAlphaNum -- alphaNum+ | PSpace -- space+ | PSpaces -- spaces+ | PNewline -- newline+ | POneOf String -- oneOf "abc"+ | PNoneOf String -- noneOf "abc"++ -- Combinators+ | PSeq ParserExpr ParserExpr -- p1 >> p2 (sequence, return second)+ | PSeqConcat ParserExpr ParserExpr -- p1 <+> p2 (sequence, concatenate results)+ | PAlt ParserExpr ParserExpr -- p1 <|> p2 (alternative)+ | PMany ParserExpr -- many p (zero or more)+ | PSome ParserExpr -- some p (one or more)+ | POptional ParserExpr -- optional p (zero or one)+ | PTry ParserExpr -- try p (backtracking)+ | PBetween Char Char ParserExpr -- between '(' ')' p+ | PCount Int ParserExpr -- count 3 p+ | PManyTill ParserExpr ParserExpr -- manyTill p end (non-greedy)++ -- References to named parsers (from config file)+ | PRef String -- ref "email"+ deriving (Show, Eq, Generic)++-- | A match result with position information+data MatchResult = MatchResult+ { mrFilePath :: FilePath+ , mrLine :: Int -- Starting line (1-indexed)+ , mrCol :: Int -- Starting column (1-indexed)+ , mrMatchText :: String -- The matched text (may contain newlines)+ } deriving (Show, Eq, Generic)
+ src/Scrappy/Grep/DSL/Interpreter.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE FlexibleContexts #-}++module Scrappy.Grep.DSL.Interpreter+ ( interpret+ , interpretWithRefs+ , InterpreterError(..)+ ) where++import Scrappy.Grep.DSL+import Scrappy.Scrape (ScraperT)++import Text.Parsec hiding ((<|>))+import Data.Map (Map)+import qualified Data.Map as Map+import Control.Applicative ((<|>))++data InterpreterError+ = UnknownRef String+ deriving (Show, Eq)++-- | Interpret AST without named references (refs will fail)+interpret :: ParserExpr -> Either InterpreterError (ScraperT String)+interpret = interpretWithRefs Map.empty++-- | Interpret AST with named parser references+-- The Map contains pre-interpreted parsers for each ref name+interpretWithRefs :: Map String (ScraperT String) -> ParserExpr -> Either InterpreterError (ScraperT String)+interpretWithRefs refs = go+ where+ go :: ParserExpr -> Either InterpreterError (ScraperT String)+ go expr = case expr of+ -- Primitives (return matched text as String)+ PChar c -> Right $ (:[]) <$> char c+ PString s -> Right $ string s+ PAnyChar -> Right $ (:[]) <$> anyChar+ PDigit -> Right $ (:[]) <$> digit+ PLetter -> Right $ (:[]) <$> letter+ PAlphaNum -> Right $ (:[]) <$> alphaNum+ PSpace -> Right $ (:[]) <$> space+ PSpaces -> Right $ many space+ PNewline -> Right $ (:[]) <$> newline+ POneOf cs -> Right $ (:[]) <$> oneOf cs+ PNoneOf cs -> Right $ (:[]) <$> noneOf cs++ -- Sequence: run p1 then p2, return p2's result+ PSeq p1 p2 -> do+ parser1 <- go p1+ parser2 <- go p2+ Right $ parser1 *> parser2++ -- Sequence with concatenation: run both, concatenate results+ PSeqConcat p1 p2 -> do+ parser1 <- go p1+ parser2 <- go p2+ Right $ (++) <$> parser1 <*> parser2++ -- Alternative: try p1, if fails try p2+ PAlt p1 p2 -> do+ parser1 <- go p1+ parser2 <- go p2+ Right $ try parser1 <|> parser2++ -- Many: zero or more+ PMany p -> do+ parser <- go p+ Right $ concat <$> many (try parser)++ -- Some: one or more+ PSome p -> do+ parser <- go p+ Right $ concat <$> many1 (try parser)++ -- Optional: zero or one+ POptional p -> do+ parser <- go p+ Right $ option "" (try parser)++ -- Try: backtracking+ PTry p -> do+ parser <- go p+ Right $ try parser++ -- Between: parse between delimiters+ PBetween open close p -> do+ parser <- go p+ Right $ do+ o <- char open+ result <- parser+ c <- char close+ pure $ [o] ++ result ++ [c]++ -- Count: exactly n repetitions+ PCount n p -> do+ parser <- go p+ Right $ concat <$> count n parser++ -- ManyTill: non-greedy match until end+ PManyTill p end -> do+ parserP <- go p+ parserEnd <- go end+ Right $ manyTillConcat parserP parserEnd++ -- Reference: lookup in refs map+ PRef name -> case Map.lookup name refs of+ Nothing -> Left $ UnknownRef name+ Just parser -> Right parser++-- | manyTill that concatenates all matched strings including the end+manyTillConcat :: ScraperT String -> ScraperT String -> ScraperT String+manyTillConcat p end = go+ where+ go = (try end) <|> do+ x <- p+ xs <- go+ pure (x ++ xs)
+ src/Scrappy/Grep/DSL/Parser.hs view
@@ -0,0 +1,177 @@+module Scrappy.Grep.DSL.Parser+ ( parseExpr+ , ParseError+ ) where++import Scrappy.Grep.DSL++import Text.Parsec hiding ((<|>), many)+import Text.Parsec.String (Parser)+import Control.Applicative ((<|>), many)+import Control.Monad (void)++-- | Parse a DSL string into an AST+parseExpr :: String -> Either ParseError ParserExpr+parseExpr = parse (spaces *> exprParser <* eof) "parsec-grep DSL"++-- | Main expression parser - handles combinators with proper precedence+-- Precedence (lowest to highest): <|>, >> / <+>, modifiers, atoms+exprParser :: Parser ParserExpr+exprParser = altExpr++-- | Alternative: p1 <|> p2+altExpr :: Parser ParserExpr+altExpr = chainl1 seqExpr altOp+ where+ altOp = PAlt <$ try (spaces *> string "<|>" <* spaces)++-- | Sequence: p1 >> p2 or p1 <+> p2+seqExpr :: Parser ParserExpr+seqExpr = chainl1 termExpr seqOp+ where+ seqOp = try (PSeqConcat <$ try (spaces *> string "<+>" <* spaces))+ <|> (PSeq <$ try (spaces *> string ">>" <* spaces))++-- | Term: modified expression or atom+termExpr :: Parser ParserExpr+termExpr = modifiedExpr <|> atomExpr++-- | Modifiers: many, some, optional, try+modifiedExpr :: Parser ParserExpr+modifiedExpr = do+ modifier <- try $ do+ m <- choice+ [ PMany <$ try (string "many")+ , PSome <$ try (string "some")+ , POptional <$ try (string "optional")+ , PTry <$ try (string "try")+ ]+ spaces1+ pure m+ inner <- termExpr+ pure $ modifier inner++-- | At least one space+spaces1 :: Parser ()+spaces1 = void $ many1 (oneOf " \t\n")++-- | Atom: primitive, reference, or parenthesized expression+atomExpr :: Parser ParserExpr+atomExpr = choice+ [ parenExpr+ , primitiveExpr+ , refExpr+ ]++-- | Parenthesized expression+parenExpr :: Parser ParserExpr+parenExpr = between (char '(' <* spaces) (spaces *> char ')') exprParser++-- | Reference to named parser: ref "name"+refExpr :: Parser ParserExpr+refExpr = do+ try $ string "ref"+ spaces+ PRef <$> stringLiteral++-- | Primitive parsers+primitiveExpr :: Parser ParserExpr+primitiveExpr = choice+ [ try manyTillExpr+ , try betweenExpr+ , try countExpr+ , try charExpr+ , try stringExpr+ , try oneOfExpr+ , try noneOfExpr+ , try $ PAlphaNum <$ string "alphaNum" -- must come before 'alpha' prefix match+ , try $ PAnyChar <$ string "anyChar"+ , try $ PDigit <$ string "digit"+ , try $ PLetter <$ string "letter"+ , try $ PSpaces <$ string "spaces" -- must come before 'space'+ , try $ PSpace <$ string "space"+ , try $ PNewline <$ string "newline"+ ]++-- | char 'x'+charExpr :: Parser ParserExpr+charExpr = do+ string "char"+ spaces+ PChar <$> charLiteral++-- | string "abc"+stringExpr :: Parser ParserExpr+stringExpr = do+ string "string"+ spaces+ PString <$> stringLiteral++-- | oneOf "abc"+oneOfExpr :: Parser ParserExpr+oneOfExpr = do+ string "oneOf"+ spaces+ POneOf <$> stringLiteral++-- | noneOf "abc"+noneOfExpr :: Parser ParserExpr+noneOfExpr = do+ string "noneOf"+ spaces+ PNoneOf <$> stringLiteral++-- | between '(' ')' expr+betweenExpr :: Parser ParserExpr+betweenExpr = do+ string "between"+ spaces+ open <- charLiteral+ spaces+ close <- charLiteral+ spaces+ inner <- termExpr+ pure $ PBetween open close inner++-- | count 3 expr+countExpr :: Parser ParserExpr+countExpr = do+ _ <- string "count"+ spaces+ n <- read <$> many1 digit+ spaces+ inner <- termExpr+ pure $ PCount n inner++-- | manyTill p end - match p until end, non-greedy+manyTillExpr :: Parser ParserExpr+manyTillExpr = do+ _ <- string "manyTill"+ spaces+ p <- termExpr+ spaces+ end <- termExpr+ pure $ PManyTill p end++-- | Character literal: 'x' or '\n' etc+charLiteral :: Parser Char+charLiteral = between (char '\'') (char '\'') charContent+ where+ charContent = escapedChar <|> noneOf "'\\"++-- | String literal: "abc" with escape support+stringLiteral :: Parser String+stringLiteral = between (char '"') (char '"') (many stringChar)+ where+ stringChar = escapedChar <|> noneOf "\"\\"++-- | Escape sequences+escapedChar :: Parser Char+escapedChar = char '\\' >> choice+ [ '\n' <$ char 'n'+ , '\t' <$ char 't'+ , '\r' <$ char 'r'+ , '\\' <$ char '\\'+ , '\'' <$ char '\''+ , '"' <$ char '"'+ ]
+ src/Scrappy/Grep/Output.hs view
@@ -0,0 +1,67 @@+module Scrappy.Grep.Output+ ( formatResult+ , formatResults+ , OutputFormat(..)+ ) where++import Scrappy.Grep.DSL (MatchResult(..))+import Data.List (intercalate)++data OutputFormat+ = FormatGrep -- file:line:col:match+ | FormatVerbose -- file:line:col: match (with context)+ | FormatJSON -- JSON output+ | FormatCount -- Just count of matches+ deriving (Show, Eq)++-- | Format a single match result+formatResult :: OutputFormat -> MatchResult -> String+formatResult fmt mr = case fmt of+ FormatGrep ->+ mrFilePath mr ++ ":" +++ show (mrLine mr) ++ ":" +++ show (mrCol mr) ++ ":" +++ escapeNewlines (mrMatchText mr)++ FormatVerbose ->+ mrFilePath mr ++ ":" +++ show (mrLine mr) ++ ":" +++ show (mrCol mr) ++ ": " +++ mrMatchText mr++ FormatJSON ->+ "{\"file\":\"" ++ escapeJSON (mrFilePath mr) +++ "\",\"line\":" ++ show (mrLine mr) +++ ",\"col\":" ++ show (mrCol mr) +++ ",\"match\":\"" ++ escapeJSON (mrMatchText mr) ++ "\"}"++ FormatCount -> ""++-- | Format multiple results+formatResults :: OutputFormat -> [MatchResult] -> String+formatResults FormatCount results =+ show (length results) ++ " match" ++ (if length results == 1 then "" else "es")+formatResults FormatJSON results =+ "[" ++ intercalate "," (map (formatResult FormatJSON) results) ++ "]"+formatResults fmt results =+ unlines $ map (formatResult fmt) results++-- | Escape newlines for single-line output+escapeNewlines :: String -> String+escapeNewlines = concatMap escape+ where+ escape '\n' = "\\n"+ escape '\t' = "\\t"+ escape '\r' = "\\r"+ escape c = [c]++-- | Escape for JSON strings+escapeJSON :: String -> String+escapeJSON = concatMap escape+ where+ escape '"' = "\\\""+ escape '\\' = "\\\\"+ escape '\n' = "\\n"+ escape '\t' = "\\t"+ escape '\r' = "\\r"+ escape c = [c]
+ src/Scrappy/Grep/Search.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleContexts #-}++module Scrappy.Grep.Search+ ( searchFile+ , searchFiles+ , searchText+ , offsetToLineCol+ ) where++import Scrappy.Grep.DSL (MatchResult(..))+import Scrappy.Scrape (ScraperT)++import Text.Parsec (parse, getPosition, sourceColumn, sourceLine, try, anyChar, (<|>), eof)+import System.Directory (doesFileExist)++-- | Search a file for all matches, returning results with positions+searchFile :: ScraperT String -> FilePath -> IO [MatchResult]+searchFile parser fp = do+ exists <- doesFileExist fp+ if not exists+ then pure []+ else do+ content <- readFile fp+ pure $ searchText fp parser content++-- | Search multiple files+searchFiles :: ScraperT String -> [FilePath] -> IO [MatchResult]+searchFiles parser fps = concat <$> mapM (searchFile parser) fps++-- | Search text content and return matches with positions+searchText :: FilePath -> ScraperT String -> String -> [MatchResult]+searchText fp parser content =+ case parse (findAllWithPos parser) "" content of+ Left _ -> []+ Right matches -> map (toMatchResult fp) matches++-- | Find all matches with their positions+findAllWithPos :: ScraperT String -> ScraperT [(Int, Int, String)]+findAllWithPos parser = go+ where+ go = do+ atEnd <- (True <$ eof) <|> pure False+ if atEnd+ then pure []+ else tryMatch <|> skipAndContinue++ tryMatch = do+ pos <- getPosition+ let line = sourceLine pos+ col = sourceColumn pos+ matched <- try parser+ rest <- go+ pure $ (line, col, matched) : rest++ skipAndContinue = do+ _ <- anyChar+ go++-- | Convert (line, col, match) to MatchResult+toMatchResult :: FilePath -> (Int, Int, String) -> MatchResult+toMatchResult fp (line, col, matched) = MatchResult+ { mrFilePath = fp+ , mrLine = line+ , mrCol = col+ , mrMatchText = matched+ }++-- | Convert a byte offset in text to (line, col) - 1-indexed+offsetToLineCol :: String -> Int -> (Int, Int)+offsetToLineCol content offset =+ let prefix = take offset content+ lineNum = 1 + length (filter (== '\n') prefix)+ colNum = 1 + length (takeWhile (/= '\n') (reverse prefix))+ in (lineNum, colNum)
+ test/Test.hs view
@@ -0,0 +1,279 @@+module Main where++import Scrappy.Grep.DSL+import Scrappy.Grep.DSL.Parser (parseExpr)+import Scrappy.Grep.DSL.Interpreter (interpret)+import Scrappy.Grep.Search (searchText, searchFile, searchFiles)+import Scrappy.Grep.Output (formatResults, OutputFormat(..))++import System.Exit (exitFailure, exitSuccess)+import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive, doesDirectoryExist)+import System.FilePath ((</>))+import Control.Monad (when)++main :: IO ()+main = do+ putStrLn "Running pgrep tests...\n"++ -- Run all tests+ results <- sequence+ [ testDSLParser+ , testInterpreter+ , testSearchString+ , testSearchFile+ , testSearchDirectory+ ]++ -- Summary+ let passed = length (filter id results)+ total = length results+ putStrLn $ "\n" ++ show passed ++ "/" ++ show total ++ " tests passed"++ if and results+ then exitSuccess+ else exitFailure++-- | Test DSL parser+testDSLParser :: IO Bool+testDSLParser = do+ putStrLn "=== DSL Parser Tests ==="++ let tests =+ [ ("char 'a'", PChar 'a')+ , ("string \"hello\"", PString "hello")+ , ("digit", PDigit)+ , ("letter", PLetter)+ , ("anyChar", PAnyChar)+ , ("alphaNum", PAlphaNum)+ , ("space", PSpace)+ , ("spaces", PSpaces)+ , ("newline", PNewline)+ , ("oneOf \"abc\"", POneOf "abc")+ , ("noneOf \"xyz\"", PNoneOf "xyz")+ , ("many digit", PMany PDigit)+ , ("some letter", PSome PLetter)+ , ("optional digit", POptional PDigit)+ , ("try letter", PTry PLetter)+ , ("count 3 digit", PCount 3 PDigit)+ , ("between '(' ')' digit", PBetween '(' ')' PDigit)+ , ("digit >> letter", PSeq PDigit PLetter)+ , ("digit <+> letter", PSeqConcat PDigit PLetter)+ , ("digit <|> letter", PAlt PDigit PLetter)+ , ("ref \"email\"", PRef "email")+ -- Precedence tests+ , ("digit >> letter <|> space", PAlt (PSeq PDigit PLetter) PSpace)+ , ("digit <+> letter >> space", PSeq (PSeqConcat PDigit PLetter) PSpace)+ , ("many digit >> letter", PSeq (PMany PDigit) PLetter)+ -- Parentheses+ , ("(digit >> letter)", PSeq PDigit PLetter)+ , ("many (digit <|> letter)", PMany (PAlt PDigit PLetter))+ ]++ results <- mapM runParserTest tests+ pure $ and results++ where+ runParserTest (input, expected) = do+ case parseExpr input of+ Left err -> do+ putStrLn $ " FAIL: '" ++ input ++ "'"+ putStrLn $ " Error: " ++ show err+ pure False+ Right actual ->+ if actual == expected+ then do+ putStrLn $ " PASS: '" ++ input ++ "'"+ pure True+ else do+ putStrLn $ " FAIL: '" ++ input ++ "'"+ putStrLn $ " Expected: " ++ show expected+ putStrLn $ " Actual: " ++ show actual+ pure False++-- | Test interpreter+testInterpreter :: IO Bool+testInterpreter = do+ putStrLn "\n=== Interpreter Tests ==="++ let tests =+ [ ("digit", "abc123def", ["1", "2", "3"])+ , ("some digit", "abc123def456", ["123", "456"])+ , ("string \"hello\"", "say hello world hello", ["hello", "hello"])+ , ("letter <+> digit", "a1 b2 c3", ["a1", "b2", "c3"])+ , ("char 'a' >> char 'b'", "ab ab ab", ["b", "b", "b"])+ , ("char 'a' <+> char 'b'", "ab ab ab", ["ab", "ab", "ab"])+ , ("between '(' ')' some digit", "(123) (456)", ["(123)", "(456)"])+ , ("count 3 letter", "abc def ghi", ["abc", "def", "ghi"])+ , ("digit <|> letter", "a1b2c3", ["a", "1", "b", "2", "c", "3"])+ ]++ results <- mapM runInterpTest tests+ pure $ and results++ where+ runInterpTest (pattern, input, expected) = do+ case parseExpr pattern of+ Left err -> do+ putStrLn $ " FAIL: '" ++ pattern ++ "' - parse error: " ++ show err+ pure False+ Right ast -> case interpret ast of+ Left err -> do+ putStrLn $ " FAIL: '" ++ pattern ++ "' - interpret error: " ++ show err+ pure False+ Right parser -> do+ let results = searchText "<test>" parser input+ matches = map mrMatchText results+ if matches == expected+ then do+ putStrLn $ " PASS: '" ++ pattern ++ "' on \"" ++ take 20 input ++ "...\""+ pure True+ else do+ putStrLn $ " FAIL: '" ++ pattern ++ "'"+ putStrLn $ " Input: \"" ++ input ++ "\""+ putStrLn $ " Expected: " ++ show expected+ putStrLn $ " Actual: " ++ show matches+ pure False++-- | Test search on a string+testSearchString :: IO Bool+testSearchString = do+ putStrLn "\n=== String Search Tests ==="++ -- Test multi-line matching+ let multiLineContent = "Hello World\nThis is line 2\nAnd line 3"++ case parseExpr "string \"line\"" of+ Left err -> do+ putStrLn $ " FAIL: parse error: " ++ show err+ pure False+ Right ast -> case interpret ast of+ Left err -> do+ putStrLn $ " FAIL: interpret error: " ++ show err+ pure False+ Right parser -> do+ let results = searchText "<test>" parser multiLineContent+ if length results == 2+ then do+ putStrLn $ " PASS: Found " ++ show (length results) ++ " matches for 'line'"+ -- Check positions+ let r1 = head results+ r2 = results !! 1+ if mrLine r1 == 2 && mrLine r2 == 3+ then do+ putStrLn $ " PASS: Line numbers correct (line 2 and 3)"+ pure True+ else do+ putStrLn $ " FAIL: Line numbers wrong"+ putStrLn $ " Result 1 line: " ++ show (mrLine r1)+ putStrLn $ " Result 2 line: " ++ show (mrLine r2)+ pure False+ else do+ putStrLn $ " FAIL: Expected 2 matches, got " ++ show (length results)+ pure False++-- | Test search on a file+testSearchFile :: IO Bool+testSearchFile = do+ putStrLn "\n=== File Search Tests ==="++ -- Create a temp test file+ let testDir = "/tmp/parsec-grep-test"+ testFile = testDir </> "test.txt"+ testContent = unlines+ [ "Hello World"+ , "Email: test@example.com"+ , "Phone: 123-456-7890"+ , "Another email: foo@bar.org"+ ]++ createDirectoryIfMissing True testDir+ writeFile testFile testContent++ -- Test finding email-like patterns+ case parseExpr "some alphaNum <+> char '@' <+> some alphaNum <+> char '.' <+> some letter" of+ Left err -> do+ putStrLn $ " FAIL: parse error: " ++ show err+ cleanup testDir+ pure False+ Right ast -> case interpret ast of+ Left err -> do+ putStrLn $ " FAIL: interpret error: " ++ show err+ cleanup testDir+ pure False+ Right parser -> do+ results <- searchFile parser testFile+ let matches = map mrMatchText results+ if length matches == 2 && "test@example.com" `elem` matches && "foo@bar.org" `elem` matches+ then do+ putStrLn $ " PASS: Found 2 email addresses in file"+ putStrLn $ " Matches: " ++ show matches+ cleanup testDir+ pure True+ else do+ putStrLn $ " FAIL: Expected 2 emails"+ putStrLn $ " Got: " ++ show matches+ cleanup testDir+ pure False++ where+ cleanup dir = do+ exists <- doesDirectoryExist dir+ when exists $ removeDirectoryRecursive dir++-- | Test search on a directory+testSearchDirectory :: IO Bool+testSearchDirectory = do+ putStrLn "\n=== Directory Search Tests ==="++ -- Create a temp test directory with multiple files+ let testDir = "/tmp/parsec-grep-test-dir"+ file1 = testDir </> "file1.txt"+ file2 = testDir </> "file2.txt"+ subDir = testDir </> "subdir"+ file3 = subDir </> "file3.txt"++ createDirectoryIfMissing True testDir+ createDirectoryIfMissing True subDir++ writeFile file1 "TODO: fix this bug\nTODO: add tests"+ writeFile file2 "Regular content\nNothing special"+ writeFile file3 "TODO: implement feature"++ -- Test finding TODO comments+ case parseExpr "string \"TODO\"" of+ Left err -> do+ putStrLn $ " FAIL: parse error: " ++ show err+ cleanup testDir+ pure False+ Right ast -> case interpret ast of+ Left err -> do+ putStrLn $ " FAIL: interpret error: " ++ show err+ cleanup testDir+ pure False+ Right parser -> do+ results <- searchFiles parser [file1, file2, file3]+ if length results == 3+ then do+ putStrLn $ " PASS: Found 3 TODO comments across 3 files"+ -- Check that results come from different files+ let files = map mrFilePath results+ if file1 `elem` files && file3 `elem` files+ then do+ putStrLn $ " PASS: Results from correct files"+ cleanup testDir+ pure True+ else do+ putStrLn $ " FAIL: Results from wrong files"+ putStrLn $ " Files: " ++ show files+ cleanup testDir+ pure False+ else do+ putStrLn $ " FAIL: Expected 3 matches"+ putStrLn $ " Got: " ++ show (length results)+ cleanup testDir+ pure False++ where+ cleanup dir = do+ exists <- doesDirectoryExist dir+ when exists $ removeDirectoryRecursive dir