screp 0.1.0.0 → 0.2.0.0
raw patch · 7 files changed
+805/−107 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Scrappy.Grep.DSL: MatchContext :: [String] -> [String] -> MatchContext
+ Scrappy.Grep.DSL: [mcAfter] :: MatchContext -> [String]
+ Scrappy.Grep.DSL: [mcBefore] :: MatchContext -> [String]
+ Scrappy.Grep.DSL: [mrContext] :: MatchResult -> Maybe MatchContext
+ Scrappy.Grep.DSL: data MatchContext
+ Scrappy.Grep.DSL: instance GHC.Classes.Eq Scrappy.Grep.DSL.MatchContext
+ Scrappy.Grep.DSL: instance GHC.Generics.Generic Scrappy.Grep.DSL.MatchContext
+ Scrappy.Grep.DSL: instance GHC.Show.Show Scrappy.Grep.DSL.MatchContext
+ Scrappy.Grep.Output: ColorAlways :: ColorMode
+ Scrappy.Grep.Output: ColorAuto :: ColorMode
+ Scrappy.Grep.Output: ColorNever :: ColorMode
+ Scrappy.Grep.Output: FormatFilesOnly :: OutputFormat
+ Scrappy.Grep.Output: FormatFilesWithout :: OutputFormat
+ Scrappy.Grep.Output: OutputOptions :: ColorMode -> Bool -> OutputOptions
+ Scrappy.Grep.Output: [ooColor] :: OutputOptions -> ColorMode
+ Scrappy.Grep.Output: [ooNoFilename] :: OutputOptions -> Bool
+ Scrappy.Grep.Output: data ColorMode
+ Scrappy.Grep.Output: data OutputOptions
+ Scrappy.Grep.Output: defaultOutputOptions :: OutputOptions
+ Scrappy.Grep.Output: formatResultsGrouped :: OutputOptions -> OutputFormat -> [MatchResult] -> String
+ Scrappy.Grep.Output: formatResultsWithOpts :: OutputOptions -> OutputFormat -> [MatchResult] -> String
+ Scrappy.Grep.Output: instance GHC.Classes.Eq Scrappy.Grep.Output.ColorMode
+ Scrappy.Grep.Output: instance GHC.Classes.Eq Scrappy.Grep.Output.OutputOptions
+ Scrappy.Grep.Output: instance GHC.Show.Show Scrappy.Grep.Output.ColorMode
+ Scrappy.Grep.Output: instance GHC.Show.Show Scrappy.Grep.Output.OutputOptions
+ Scrappy.Grep.Search: SearchOptions :: Bool -> Int -> Int -> SearchOptions
+ Scrappy.Grep.Search: [soContextAfter] :: SearchOptions -> Int
+ Scrappy.Grep.Search: [soContextBefore] :: SearchOptions -> Int
+ Scrappy.Grep.Search: [soIgnoreCase] :: SearchOptions -> Bool
+ Scrappy.Grep.Search: data SearchOptions
+ Scrappy.Grep.Search: defaultSearchOptions :: SearchOptions
+ Scrappy.Grep.Search: instance GHC.Classes.Eq Scrappy.Grep.Search.SearchOptions
+ Scrappy.Grep.Search: instance GHC.Show.Show Scrappy.Grep.Search.SearchOptions
+ Scrappy.Grep.Search: searchFileWithOpts :: SearchOptions -> ScraperT String -> FilePath -> IO [MatchResult]
+ Scrappy.Grep.Search: searchFilesWithOpts :: SearchOptions -> ScraperT String -> [FilePath] -> IO [MatchResult]
+ Scrappy.Grep.Search: searchTextWithContext :: SearchOptions -> FilePath -> ScraperT String -> String -> [MatchResult]
- Scrappy.Grep.DSL: MatchResult :: FilePath -> Int -> Int -> String -> MatchResult
+ Scrappy.Grep.DSL: MatchResult :: FilePath -> Int -> Int -> String -> Maybe MatchContext -> MatchResult
Files
- app/Main.hs +319/−51
- screp.cabal +6/−1
- src/Scrappy/Files.hs +14/−11
- src/Scrappy/Grep/DSL.hs +8/−0
- src/Scrappy/Grep/Output.hs +120/−21
- src/Scrappy/Grep/Search.hs +82/−18
- test/Test.hs +256/−5
app/Main.hs view
@@ -1,30 +1,53 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+ 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)-import Scrappy.Grep.Output (formatResults, OutputFormat(..))+import Scrappy.Grep.Search (searchFilesWithOpts, SearchOptions(..), defaultSearchOptions)+import Scrappy.Grep.Output (formatResultsWithOpts, formatResultsGrouped, OutputFormat(..), OutputOptions(..), ColorMode(..)) import Scrappy.Grep.Config (runParserViaGhc, ConfigError(..)) import Scrappy.Files (listFilesRecursive)+import qualified Scrappy.Scrape+import qualified Text.Parsec -import Options.Applicative+import Options.Applicative hiding ((<|>)) import System.Exit (exitFailure, exitSuccess)-import System.IO (hPutStrLn, stderr)+import System.IO (hPutStrLn, stderr, stdin, hGetContents, hIsTerminalDevice, stdout)+import qualified System.Directory import System.Directory (doesDirectoryExist, doesFileExist)-import Data.List (isSuffixOf, nub)+import System.FilePath (takeFileName, takeDirectory, (</>))+import Data.List (isSuffixOf, nub, isPrefixOf)+import Data.Char (toLower)+import Control.Exception (catch, IOException)+import Control.Monad (forM)+import Control.Applicative ((<|>), (<$)) data Options = Options- { optPattern :: String- , optTargets :: [FilePath]- , optRecursive :: Bool- , optExtensions :: [String]- , optVerbose :: Bool- , optCount :: Bool- , optQuiet :: Bool- , optMaxResults :: Maybe Int- , optJSON :: Bool- , optImport :: Maybe FilePath+ { optPattern :: String+ , optTargets :: [FilePath]+ , optRecursive :: Bool+ , optExtensions :: [String]+ , optInclude :: [String] -- --include+ , optExclude :: [String] -- --exclude+ , optExcludeDir :: [String] -- --exclude-dir+ , optIgnoreCase :: Bool -- -i+ , optVerbose :: Bool+ , optCount :: Bool+ , optQuiet :: Bool+ , optMaxResults :: Maybe Int+ , optJSON :: Bool+ , optImport :: Maybe FilePath+ , optFilesOnly :: Bool -- -l+ , optFilesWithout :: Bool -- -L+ , optNoFilename :: Bool -- -h+ , optContextBefore :: Int -- -B+ , optContextAfter :: Int -- -A+ , optContext :: Int -- -C (both)+ , optColor :: Maybe String -- --color } deriving Show optionsParser :: Parser Options@@ -33,9 +56,9 @@ ( metavar "PATTERN" <> help "Parsec DSL pattern (e.g., 'some digit', 'ref \"email\"')" )- <*> some (strArgument+ <*> many (strArgument ( metavar "FILE..."- <> help "Files or directories to search"+ <> help "Files or directories to search (use - for stdin)" )) <*> switch ( long "recursive"@@ -48,7 +71,27 @@ <> metavar "EXT" <> help "Only search files with extension (e.g., .hs, .txt)" ))+ <*> many (strOption+ ( long "include"+ <> metavar "GLOB"+ <> help "Only search files matching GLOB pattern (e.g., *.hs, src/*.txt)"+ ))+ <*> many (strOption+ ( long "exclude"+ <> metavar "GLOB"+ <> help "Skip files matching GLOB pattern"+ ))+ <*> many (strOption+ ( long "exclude-dir"+ <> metavar "GLOB"+ <> help "Skip directories matching GLOB pattern"+ )) <*> switch+ ( long "ignore-case"+ <> short 'i'+ <> help "Ignore case distinctions in pattern"+ )+ <*> switch ( long "verbose" <> short 'v' <> help "Verbose output with full match text"@@ -75,10 +118,51 @@ ) <*> optional (strOption ( long "import"- <> short 'i' <> metavar "FILE" <> help "Haskell file with named parsers (for use with 'ref \"name\"')" ))+ <*> switch+ ( long "files-with-matches"+ <> short 'l'+ <> help "Print only names of files with matches"+ )+ <*> switch+ ( long "files-without-match"+ <> short 'L'+ <> help "Print only names of files without matches"+ )+ <*> switch+ ( long "no-filename"+ <> short 'h'+ <> help "Suppress the file name prefix on output"+ )+ <*> option auto+ ( long "before-context"+ <> short 'B'+ <> metavar "NUM"+ <> value 0+ <> help "Print NUM lines of leading context"+ )+ <*> option auto+ ( long "after-context"+ <> short 'A'+ <> metavar "NUM"+ <> value 0+ <> help "Print NUM lines of trailing context"+ )+ <*> option auto+ ( long "context"+ <> short 'C'+ <> metavar "NUM"+ <> value 0+ <> help "Print NUM lines of context"+ )+ <*> optional (strOption+ ( long "color"+ <> long "colour"+ <> metavar "WHEN"+ <> help "Use color: always, never, or auto"+ )) main :: IO () main = do@@ -88,17 +172,53 @@ <> header "screp - grep with parser combinators" ) - -- Parse the DSL pattern- case parseExpr (optPattern opts) of+ -- Handle stdin if no targets or "-" specified+ let targets = if null (optTargets opts) then ["-"] else optTargets opts+ opts' = opts { optTargets = targets }++ -- Parse the DSL pattern (with case folding if -i)+ let patternStr = if optIgnoreCase opts'+ then map toLower (optPattern opts')+ else optPattern opts'++ case parseExpr patternStr of Left err -> do hPutStrLn stderr $ "Pattern parse error: " ++ show err exitFailure Right ast -> do -- Check if pattern uses refs if containsRef ast- then runWithRefs opts ast- else runWithoutRefs opts ast+ then runWithRefs opts' ast+ else runWithoutRefs opts' ast +-- | Build SearchOptions from CLI Options+mkSearchOptions :: Options -> SearchOptions+mkSearchOptions opts = SearchOptions+ { soIgnoreCase = optIgnoreCase opts+ , soContextBefore = if optContext opts > 0 then optContext opts else optContextBefore opts+ , soContextAfter = if optContext opts > 0 then optContext opts else optContextAfter opts+ }++-- | Build OutputOptions from CLI Options+mkOutputOptions :: Options -> IO OutputOptions+mkOutputOptions opts = do+ colorMode <- case optColor opts of+ Just "always" -> pure ColorAlways+ Just "never" -> pure ColorNever+ Just "auto" -> do+ isTerm <- hIsTerminalDevice stdout+ pure $ if isTerm then ColorAlways else ColorNever+ Nothing -> do+ isTerm <- hIsTerminalDevice stdout+ pure $ if isTerm then ColorAlways else ColorNever+ Just other -> do+ hPutStrLn stderr $ "Invalid --color value: " ++ other ++ " (use always, never, or auto)"+ pure ColorNever+ pure OutputOptions+ { ooColor = colorMode+ , ooNoFilename = optNoFilename opts+ }+ -- | Run search using inline DSL only (no refs) runWithoutRefs :: Options -> ParserExpr -> IO () runWithoutRefs opts ast = do@@ -108,10 +228,69 @@ hPutStrLn stderr "Use --import to provide a Haskell file with named parsers." exitFailure Right parser -> do- files <- gatherFiles opts (optTargets opts)- allResults <- searchFiles parser files- outputResults opts allResults+ -- Handle stdin+ if "-" `elem` optTargets opts+ then do+ content <- hGetContents stdin+ let searchOpts = mkSearchOptions opts+ results = searchTextWithOpts searchOpts "(stdin)" parser content+ outputResults opts results+ else do+ files <- gatherFiles opts (optTargets opts)+ let searchOpts = mkSearchOptions opts+ allResults <- searchFilesWithOpts searchOpts parser files+ outputResults opts allResults +-- | Search text with options (helper for stdin)+searchTextWithOpts :: SearchOptions -> FilePath -> Scrappy.Scrape.ScraperT String -> String -> [MatchResult]+searchTextWithOpts opts fp parser content =+ let contentToSearch = if soIgnoreCase opts then map toLower content else content+ contentLines = lines content+ in case Text.Parsec.parse (findAllWithPos parser) "" contentToSearch of+ Left _ -> []+ Right matches -> map (toMatchResultWithContext opts contentLines fp) matches+ where+ findAllWithPos p = go+ where+ go = do+ atEnd <- (True <$ Text.Parsec.eof) <|> pure False+ if atEnd+ then pure []+ else tryMatch <|> skipAndContinue++ tryMatch = do+ pos <- Text.Parsec.getPosition+ let line = Text.Parsec.sourceLine pos+ col = Text.Parsec.sourceColumn pos+ matched <- Text.Parsec.try p+ rest <- go+ pure $ (line, col, matched) : rest++ skipAndContinue = do+ _ <- Text.Parsec.anyChar+ go++ toMatchResultWithContext sopts contentLines fp' (line, col, matched) =+ let ctx = if soContextBefore sopts > 0 || soContextAfter sopts > 0+ then Just $ getContext sopts contentLines line+ else Nothing+ in MatchResult+ { mrFilePath = fp'+ , mrLine = line+ , mrCol = col+ , mrMatchText = matched+ , mrContext = ctx+ }++ getContext sopts contentLines matchLine =+ let beforeStart = max 0 (matchLine - 1 - soContextBefore sopts)+ beforeEnd = matchLine - 1+ afterStart = matchLine+ afterEnd = min (length contentLines) (matchLine + soContextAfter sopts)+ beforeLines = take (beforeEnd - beforeStart) $ drop beforeStart contentLines+ afterLines = take (afterEnd - afterStart) $ drop afterStart contentLines+ in MatchContext { mcBefore = beforeLines, mcAfter = afterLines }+ -- | Run search using external parsers via runghc runWithRefs :: Options -> ParserExpr -> IO () runWithRefs opts ast = do@@ -126,7 +305,7 @@ case refs of [refName] -> do files <- gatherFiles opts (optTargets opts)- allResults <- searchFilesWithRef importPath refName files+ allResults <- searchFilesWithRefOpts opts importPath refName files outputResults opts allResults [] -> do -- No refs found, shouldn't happen since containsRef was true@@ -138,25 +317,34 @@ exitFailure -- | Search files using external parser via runghc-searchFilesWithRef :: FilePath -> String -> [FilePath] -> IO [MatchResult]-searchFilesWithRef importPath refName files = do+searchFilesWithRefOpts :: Options -> FilePath -> String -> [FilePath] -> IO [MatchResult]+searchFilesWithRefOpts opts importPath refName files = do results <- mapM searchOne files pure $ concat results where- searchOne fp = do- content <- readFile fp- result <- runParserViaGhc importPath refName content- case result of- Left err -> do- hPutStrLn stderr $ "Error searching " ++ fp ++ ": " ++ showError err- pure []- Right matches -> pure $ map (toMatchResult fp) matches+ searchOne fp = readAndSearch `catch` handleIOError+ where+ readAndSearch = do+ content <- readFile fp+ -- Force evaluation to catch encoding errors early+ let !_ = length content+ contentToSearch = if optIgnoreCase opts then map toLower content else content+ result <- runParserViaGhc importPath refName contentToSearch+ case result of+ Left err -> do+ hPutStrLn stderr $ "Error searching " ++ fp ++ ": " ++ showError err+ pure []+ Right matches -> pure $ map (toMatchResult fp) matches + handleIOError :: IOException -> IO [MatchResult]+ handleIOError _ = pure [] -- Skip files we can't read (binary, permissions, etc.)+ toMatchResult fp (line, col, matchText) = MatchResult { mrFilePath = fp , mrLine = line , mrCol = col , mrMatchText = matchText+ , mrContext = Nothing -- TODO: add context support for refs } showError (ConfigFileNotFound path) = "Import file not found: " ++ path@@ -166,26 +354,89 @@ -- | Output results based on options outputResults :: Options -> [MatchResult] -> IO () outputResults opts allResults = do- let results = case optMaxResults opts of- Nothing -> allResults- Just n -> take n allResults+ outOpts <- mkOutputOptions opts - if optQuiet opts- then if null results then exitFailure else exitSuccess+ -- Handle -L (files without matches)+ if optFilesWithout opts+ then do+ files <- gatherFiles opts (optTargets opts)+ let filesWithMatches = nub $ map mrFilePath allResults+ filesWithoutMatches = filter (`notElem` filesWithMatches) files+ mapM_ putStrLn filesWithoutMatches+ if null filesWithoutMatches 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+ let results = case optMaxResults opts of+ Nothing -> allResults+ Just n -> take n allResults + if optQuiet opts+ then if null results then exitFailure else exitSuccess+ else do+ let fmt | optCount opts = FormatCount+ | optJSON opts = FormatJSON+ | optFilesOnly opts = FormatFilesOnly+ | optVerbose opts = FormatVerbose+ | otherwise = FormatGrep+ hasContext = optContextBefore opts > 0 || optContextAfter opts > 0 || optContext opts > 0+ output = if hasContext && fmt == FormatGrep+ then formatResultsGrouped outOpts fmt results+ else formatResultsWithOpts outOpts fmt results+ putStr output+ 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+ -- Filter out stdin marker+ let fileTargets = filter (/= "-") targets+ allFiles <- concat <$> mapM (expandTarget opts) fileTargets+ let filtered = filterByExtension (optExtensions opts) allFiles+ pure $ filterExcludes opts $ filterIncludes opts filtered +-- | Filter files by include patterns (if any specified)+filterIncludes :: Options -> [FilePath] -> [FilePath]+filterIncludes opts files =+ case optInclude opts of+ [] -> files -- No include patterns = include all+ patterns -> filter (matchesAnyGlob patterns . takeFileName) files++-- | Filter files by exclude patterns+filterExcludes :: Options -> [FilePath] -> [FilePath]+filterExcludes opts files =+ let excludeFile = not . matchesAnyGlob (optExclude opts) . takeFileName+ excludeDir = not . anyParentMatches (optExcludeDir opts)+ in filter (\f -> excludeFile f && excludeDir f) files++-- | Check if any parent directory matches exclude patterns+anyParentMatches :: [String] -> FilePath -> Bool+anyParentMatches patterns fp =+ let dirs = splitPath fp+ in any (matchesAnyGlob patterns) dirs+ where+ splitPath p = case takeDirectory p of+ "." -> []+ "/" -> []+ parent -> takeFileName parent : splitPath parent++-- | Check if a string matches any glob pattern+matchesAnyGlob :: [String] -> String -> Bool+matchesAnyGlob patterns str = any (`simpleGlobMatch` str) patterns++-- | Simple glob matching (supports * and ?)+simpleGlobMatch :: String -> String -> Bool+simpleGlobMatch [] [] = True+simpleGlobMatch [] _ = False+simpleGlobMatch ('*':rest) str = any (simpleGlobMatch rest) (tails str)+simpleGlobMatch ('?':rest) (_:str) = simpleGlobMatch rest str+simpleGlobMatch ('?':_) [] = False+simpleGlobMatch (c:rest) (s:str) = c == s && simpleGlobMatch rest str+simpleGlobMatch _ [] = False++-- | Get all tails of a list+tails :: [a] -> [[a]]+tails [] = [[]]+tails xs@(_:rest) = xs : tails rest+ -- | Expand a target (file or directory) to a list of files expandTarget :: Options -> FilePath -> IO [FilePath] expandTarget opts target = do@@ -194,7 +445,7 @@ case (isDir, isFile) of (True, _) -> if optRecursive opts- then listFilesRecursive target+ then listFilesRecursiveFiltered (optExcludeDir opts) target else do hPutStrLn stderr $ "Warning: " ++ target ++ " is a directory. Use -r to search recursively." pure []@@ -203,6 +454,24 @@ hPutStrLn stderr $ "Warning: " ++ target ++ " not found" pure [] +-- | List files recursively, filtering out excluded directories+listFilesRecursiveFiltered :: [String] -> FilePath -> IO [FilePath]+listFilesRecursiveFiltered excludeDirs dir = go dir `catch` (\(_ :: IOException) -> pure [])+ where+ go d = do+ contents <- System.Directory.listDirectory d+ paths <- forM contents $ \name -> do+ let fullPath = d </> name+ isDir <- doesDirectoryExist fullPath+ if isDir+ then if matchesAnyGlob excludeDirs name+ then pure []+ else listFilesRecursiveFiltered excludeDirs fullPath+ else do+ absPath <- System.Directory.makeAbsolute fullPath+ return [absPath]+ return (concat paths)+ -- | Filter files by extension filterByExtension :: [String] -> [FilePath] -> [FilePath] filterByExtension [] files = files@@ -211,4 +480,3 @@ 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
screp.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: screp-version: 0.1.0.0+version: 0.2.0.0 synopsis: grep-like CLI using Parsec parsers instead of regex description: screp is a grep-like command-line tool that uses Parsec parser@@ -18,6 +18,10 @@ build-type: Simple extra-source-files: README.md, LICENSE +source-repository head+ type: git+ location: https://github.com/Ace-Interview-Prep/screp.git+ library exposed-modules: Scrappy.Files , Scrappy.Grep.DSL@@ -46,6 +50,7 @@ , directory >=1.3.8 && <1.4 , filepath >=1.5.4 && <1.6 , containers >=0.7 && <0.8+ , parsec >=3.1.18 && <3.2 hs-source-dirs: app default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts
src/Scrappy/Files.hs view
@@ -16,18 +16,21 @@ -- | Recursively lists all files in a directory, returning absolute file paths.+-- Silently skips directories that cannot be read (permission denied, etc.) 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+listFilesRecursive dir = go dir `catch` (\(_ :: IOException) -> pure [])+ where+ go d = do+ contents <- listDirectory d+ paths <- forM contents $ \name -> do+ let fullPath = d </> name+ isDir <- doesDirectoryExist fullPath+ if isDir+ then listFilesRecursive fullPath+ else do+ absPath <- makeAbsolute fullPath+ return [absPath]+ return (concat paths) searchFile :: ScraperT a -> FilePath -> IO Bool
src/Scrappy/Grep/DSL.hs view
@@ -3,6 +3,7 @@ module Scrappy.Grep.DSL ( ParserExpr(..) , MatchResult(..)+ , MatchContext(..) , containsRef , extractRefs ) where@@ -46,6 +47,13 @@ , mrLine :: Int -- Starting line (1-indexed) , mrCol :: Int -- Starting column (1-indexed) , mrMatchText :: String -- The matched text (may contain newlines)+ , mrContext :: Maybe MatchContext -- Optional context lines+ } deriving (Show, Eq, Generic)++-- | Context lines around a match+data MatchContext = MatchContext+ { mcBefore :: [String] -- Lines before the match+ , mcAfter :: [String] -- Lines after the match } deriving (Show, Eq, Generic) -- | Check if a ParserExpr contains any PRef nodes
src/Scrappy/Grep/Output.hs view
@@ -1,33 +1,72 @@ module Scrappy.Grep.Output ( formatResult , formatResults+ , formatResultsWithOpts+ , formatResultsGrouped , OutputFormat(..)+ , OutputOptions(..)+ , defaultOutputOptions+ , ColorMode(..) ) where -import Scrappy.Grep.DSL (MatchResult(..))-import Data.List (intercalate)+import Scrappy.Grep.DSL (MatchResult(..), MatchContext(..))+import Data.List (intercalate, groupBy)+import Data.Function (on) data OutputFormat- = FormatGrep -- file:line:col:match- | FormatVerbose -- file:line:col: match (with context)- | FormatJSON -- JSON output- | FormatCount -- Just count of matches+ = FormatGrep -- file:line:col:match+ | FormatVerbose -- file:line:col: match (with context)+ | FormatJSON -- JSON output+ | FormatCount -- Just count of matches+ | FormatFilesOnly -- -l: just filenames with matches+ | FormatFilesWithout -- -L: just filenames without matches deriving (Show, Eq) +data ColorMode = ColorNever | ColorAlways | ColorAuto+ deriving (Show, Eq)++data OutputOptions = OutputOptions+ { ooColor :: ColorMode+ , ooNoFilename :: Bool -- -h: suppress filename+ } deriving (Show, Eq)++defaultOutputOptions :: OutputOptions+defaultOutputOptions = OutputOptions+ { ooColor = ColorNever+ , ooNoFilename = False+ }++-- ANSI color codes+colorRed, colorGreen, colorCyan, colorMagenta, colorReset :: String+colorRed = "\ESC[1;31m"+colorGreen = "\ESC[1;32m"+colorCyan = "\ESC[1;36m"+colorMagenta = "\ESC[1;35m"+colorReset = "\ESC[0m"+ -- | Format a single match result formatResult :: OutputFormat -> MatchResult -> String-formatResult fmt mr = case fmt of+formatResult = formatResultWithOpts defaultOutputOptions++-- | Format a single match result with options+formatResultWithOpts :: OutputOptions -> OutputFormat -> MatchResult -> String+formatResultWithOpts opts fmt mr = case fmt of FormatGrep ->- mrFilePath mr ++ ":" ++- show (mrLine mr) ++ ":" ++- show (mrCol mr) ++ ":" ++- escapeNewlines (mrMatchText mr)+ let useColor = ooColor opts == ColorAlways+ file = if ooNoFilename opts then "" else colorIf useColor colorMagenta (mrFilePath mr) ++ ":"+ lineNum = colorIf useColor colorGreen (show (mrLine mr)) ++ ":"+ colNum = show (mrCol mr) ++ ":"+ match = colorIf useColor colorRed (escapeNewlines (mrMatchText mr))+ in file ++ lineNum ++ colNum ++ match FormatVerbose ->- mrFilePath mr ++ ":" ++- show (mrLine mr) ++ ":" ++- show (mrCol mr) ++ ": " ++- mrMatchText mr+ let useColor = ooColor opts == ColorAlways+ file = if ooNoFilename opts then "" else colorIf useColor colorMagenta (mrFilePath mr) ++ ":"+ lineNum = colorIf useColor colorGreen (show (mrLine mr)) ++ ":"+ colNum = show (mrCol mr) ++ ": "+ match = colorIf useColor colorRed (mrMatchText mr)+ ctx = formatContext useColor mr+ in ctx ++ file ++ lineNum ++ colNum ++ match FormatJSON -> "{\"file\":\"" ++ escapeJSON (mrFilePath mr) ++@@ -36,15 +75,75 @@ ",\"match\":\"" ++ escapeJSON (mrMatchText mr) ++ "\"}" FormatCount -> ""+ FormatFilesOnly -> mrFilePath mr+ FormatFilesWithout -> mrFilePath mr +-- | Conditionally apply color+colorIf :: Bool -> String -> String -> String+colorIf False _ s = s+colorIf True color s = color ++ s ++ colorReset++-- | Format context lines+formatContext :: Bool -> MatchResult -> String+formatContext useColor mr = case mrContext mr of+ Nothing -> ""+ Just ctx ->+ let beforeStr = unlines $ map (\l -> colorIf useColor colorCyan "-" ++ l) (mcBefore ctx)+ in beforeStr+ -- | 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+formatResults = formatResultsWithOpts defaultOutputOptions++-- | Format multiple results with options+formatResultsWithOpts :: OutputOptions -> OutputFormat -> [MatchResult] -> String+formatResultsWithOpts _ FormatCount results =+ show (length results) ++ " match" ++ (if length results == 1 then "" else "es") ++ "\n"+formatResultsWithOpts _ FormatJSON results =+ "[" ++ intercalate "," (map (formatResult FormatJSON) results) ++ "]\n"+formatResultsWithOpts _ FormatFilesOnly results =+ unlines $ unique $ map mrFilePath results+formatResultsWithOpts _ FormatFilesWithout _ = "" -- Handled specially in Main+formatResultsWithOpts opts fmt results =+ unlines $ map (formatResultWithOpts opts fmt) results++-- | Format results grouped by file with context (for -A/-B/-C)+formatResultsGrouped :: OutputOptions -> OutputFormat -> [MatchResult] -> String+formatResultsGrouped opts fmt results =+ let grouped = groupBy ((==) `on` mrFilePath) results+ useColor = ooColor opts == ColorAlways+ separator = if useColor then colorCyan ++ "--" ++ colorReset else "--"+ in intercalate (separator ++ "\n") $ map (formatGroup opts fmt) grouped++formatGroup :: OutputOptions -> OutputFormat -> [MatchResult] -> String+formatGroup opts fmt mrs =+ let useColor = ooColor opts == ColorAlways+ in concatMap (formatWithContext opts useColor fmt) mrs++formatWithContext :: OutputOptions -> Bool -> OutputFormat -> MatchResult -> String+formatWithContext opts useColor fmt mr =+ let beforeCtx = case mrContext mr of+ Nothing -> ""+ Just ctx -> unlines $ zipWith (formatCtxLine opts useColor (mrFilePath mr) (mrLine mr))+ [mrLine mr - length (mcBefore ctx)..]+ (mcBefore ctx)+ mainLine = formatResultWithOpts opts fmt mr ++ "\n"+ afterCtx = case mrContext mr of+ Nothing -> ""+ Just ctx -> unlines $ zipWith (formatCtxLine opts useColor (mrFilePath mr) (mrLine mr))+ [mrLine mr + 1..]+ (mcAfter ctx)+ in beforeCtx ++ mainLine ++ afterCtx++formatCtxLine :: OutputOptions -> Bool -> FilePath -> Int -> Int -> String -> String+formatCtxLine opts useColor fp _ lineNum content =+ let file = if ooNoFilename opts then "" else colorIf useColor colorMagenta fp ++ "-"+ num = colorIf useColor colorGreen (show lineNum) ++ "-"+ in file ++ num ++ content++-- | Get unique elements preserving order+unique :: Eq a => [a] -> [a]+unique = foldr (\x acc -> if x `elem` acc then acc else x : acc) [] -- | Escape newlines for single-line output escapeNewlines :: String -> String
src/Scrappy/Grep/Search.hs view
@@ -1,39 +1,84 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-} module Scrappy.Grep.Search ( searchFile , searchFiles+ , searchFileWithOpts+ , searchFilesWithOpts , searchText+ , searchTextWithContext , offsetToLineCol+ , SearchOptions(..)+ , defaultSearchOptions ) where -import Scrappy.Grep.DSL (MatchResult(..))+import Scrappy.Grep.DSL (MatchResult(..), MatchContext(..)) import Scrappy.Scrape (ScraperT) import Text.Parsec (parse, getPosition, sourceColumn, sourceLine, try, anyChar, (<|>), eof) import System.Directory (doesFileExist)+import Control.Exception (catch, IOException)+import Data.Char (toLower) +-- | Search options+data SearchOptions = SearchOptions+ { soIgnoreCase :: Bool -- -i+ , soContextBefore :: Int -- -B+ , soContextAfter :: Int -- -C+ } deriving (Show, Eq)++defaultSearchOptions :: SearchOptions+defaultSearchOptions = SearchOptions+ { soIgnoreCase = False+ , soContextBefore = 0+ , soContextAfter = 0+ }+ -- | Search a file for all matches, returning results with positions+-- Silently skips binary files and files that can't be read searchFile :: ScraperT String -> FilePath -> IO [MatchResult]-searchFile parser fp = do+searchFile = searchFileWithOpts defaultSearchOptions++-- | Search a file with options+searchFileWithOpts :: SearchOptions -> ScraperT String -> FilePath -> IO [MatchResult]+searchFileWithOpts opts parser fp = do exists <- doesFileExist fp if not exists then pure []- else do+ else readAndSearch `catch` handleError+ where+ readAndSearch = do content <- readFile fp- pure $ searchText fp parser content+ -- Force evaluation to catch encoding errors early+ let !_ = length content+ pure $ searchTextWithContext opts fp parser content + handleError :: IOException -> IO [MatchResult]+ handleError _ = pure [] -- Skip files we can't read (binary, permissions, etc.)+ -- | Search multiple files searchFiles :: ScraperT String -> [FilePath] -> IO [MatchResult]-searchFiles parser fps = concat <$> mapM (searchFile parser) fps+searchFiles = searchFilesWithOpts defaultSearchOptions --- | Search text content and return matches with positions+-- | Search multiple files with options+searchFilesWithOpts :: SearchOptions -> ScraperT String -> [FilePath] -> IO [MatchResult]+searchFilesWithOpts opts parser fps = concat <$> mapM (searchFileWithOpts opts parser) fps++-- | Search text content and return matches with positions (no context) searchText :: FilePath -> ScraperT String -> String -> [MatchResult]-searchText fp parser content =- case parse (findAllWithPos parser) "" content of- Left _ -> []- Right matches -> map (toMatchResult fp) matches+searchText = searchTextWithContext defaultSearchOptions +-- | Search text content with context support+searchTextWithContext :: SearchOptions -> FilePath -> ScraperT String -> String -> [MatchResult]+searchTextWithContext opts fp parser content =+ let contentToSearch = if soIgnoreCase opts then map toLower content else content+ contentLines = lines content+ in case parse (findAllWithPos parser) "" contentToSearch of+ Left _ -> []+ Right matches -> map (toMatchResultWithContext opts contentLines fp) matches+ -- | Find all matches with their positions findAllWithPos :: ScraperT String -> ScraperT [(Int, Int, String)] findAllWithPos parser = go@@ -56,14 +101,33 @@ _ <- 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 (line, col, match) to MatchResult with optional context+toMatchResultWithContext :: SearchOptions -> [String] -> FilePath -> (Int, Int, String) -> MatchResult+toMatchResultWithContext opts contentLines fp (line, col, matched) =+ let ctx = if soContextBefore opts > 0 || soContextAfter opts > 0+ then Just $ getContext opts contentLines line+ else Nothing+ in MatchResult+ { mrFilePath = fp+ , mrLine = line+ , mrCol = col+ , mrMatchText = matched+ , mrContext = ctx+ }++-- | Get context lines around a match+getContext :: SearchOptions -> [String] -> Int -> MatchContext+getContext opts contentLines matchLine =+ let beforeStart = max 0 (matchLine - 1 - soContextBefore opts)+ beforeEnd = matchLine - 1+ afterStart = matchLine -- 0-indexed: line after match+ afterEnd = min (length contentLines) (matchLine + soContextAfter opts)+ beforeLines = take (beforeEnd - beforeStart) $ drop beforeStart contentLines+ afterLines = take (afterEnd - afterStart) $ drop afterStart contentLines+ in MatchContext+ { mcBefore = beforeLines+ , mcAfter = afterLines+ } -- | Convert a byte offset in text to (line, col) - 1-indexed offsetToLineCol :: String -> Int -> (Int, Int)
test/Test.hs view
@@ -1,19 +1,23 @@+{-# LANGUAGE ScopedTypeVariables #-}+ 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 Scrappy.Grep.Search (searchText, searchFile, searchFiles, searchTextWithContext, searchFilesWithOpts, SearchOptions(..))+import Scrappy.Grep.Output (formatResults, formatResultsWithOpts, formatResultsGrouped, OutputFormat(..), OutputOptions(..), ColorMode(..)) import System.Exit (exitFailure, exitSuccess) import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive, doesDirectoryExist) import System.FilePath ((</>)) import Control.Monad (when)+import Data.List (isInfixOf, isPrefixOf)+import Data.Char (toLower) main :: IO () main = do- putStrLn "Running pgrep tests...\n"+ putStrLn "Running screp tests...\n" -- Run all tests results <- sequence@@ -22,6 +26,12 @@ , testSearchString , testSearchFile , testSearchDirectory+ , testIgnoreCase+ , testContextLines+ , testColorOutput+ , testFilesOnlyOutput+ , testExcludePatterns+ , testOutputFormats ] -- Summary@@ -177,7 +187,7 @@ putStrLn "\n=== File Search Tests ===" -- Create a temp test file- let testDir = "/tmp/parsec-grep-test"+ let testDir = "/tmp/screp-test" testFile = testDir </> "test.txt" testContent = unlines [ "Hello World"@@ -226,7 +236,7 @@ putStrLn "\n=== Directory Search Tests ===" -- Create a temp test directory with multiple files- let testDir = "/tmp/parsec-grep-test-dir"+ let testDir = "/tmp/screp-test-dir" file1 = testDir </> "file1.txt" file2 = testDir </> "file2.txt" subDir = testDir </> "subdir"@@ -277,3 +287,244 @@ cleanup dir = do exists <- doesDirectoryExist dir when exists $ removeDirectoryRecursive dir++-- | Test ignore case (-i)+testIgnoreCase :: IO Bool+testIgnoreCase = do+ putStrLn "\n=== Ignore Case Tests ==="++ let content = "Hello HELLO hello HeLLo"+ opts = SearchOptions { soIgnoreCase = True, soContextBefore = 0, soContextAfter = 0 }++ -- Parse pattern in lowercase (simulating -i flag behavior)+ case parseExpr "string \"hello\"" 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+ -- Search with case-insensitive content+ let lowerContent = map toLower content+ results = searchText "<test>" parser lowerContent+ matches = map mrMatchText results++ if length matches == 4+ then do+ putStrLn $ " PASS: Found 4 case-insensitive matches for 'hello'"+ pure True+ else do+ putStrLn $ " FAIL: Expected 4 matches"+ putStrLn $ " Got: " ++ show (length matches) ++ " - " ++ show matches+ pure False++-- | Test context lines (-A/-B/-C)+testContextLines :: IO Bool+testContextLines = do+ putStrLn "\n=== Context Lines Tests ==="++ let content = unlines+ [ "Line 1: header"+ , "Line 2: before"+ , "Line 3: MATCH"+ , "Line 4: after"+ , "Line 5: footer"+ ]+ opts = SearchOptions { soIgnoreCase = False, soContextBefore = 1, soContextAfter = 1 }++ case parseExpr "string \"MATCH\"" 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 = searchTextWithContext opts "<test>" parser content++ if length results == 1+ then do+ let result = head results+ case mrContext result of+ Nothing -> do+ putStrLn " FAIL: No context returned"+ pure False+ Just ctx -> do+ let beforeOk = length (mcBefore ctx) == 1 && "Line 2: before" `isInfixOf` head (mcBefore ctx)+ afterOk = length (mcAfter ctx) == 1 && "Line 4: after" `isInfixOf` head (mcAfter ctx)++ if beforeOk && afterOk+ then do+ putStrLn " PASS: Context lines correctly captured"+ putStrLn $ " Before: " ++ show (mcBefore ctx)+ putStrLn $ " After: " ++ show (mcAfter ctx)+ pure True+ else do+ putStrLn " FAIL: Context lines incorrect"+ putStrLn $ " Before: " ++ show (mcBefore ctx)+ putStrLn $ " After: " ++ show (mcAfter ctx)+ pure False+ else do+ putStrLn $ " FAIL: Expected 1 match, got " ++ show (length results)+ pure False++-- | Test color output (--color)+testColorOutput :: IO Bool+testColorOutput = do+ putStrLn "\n=== Color Output Tests ==="++ let result = MatchResult+ { mrFilePath = "test.txt"+ , mrLine = 5+ , mrCol = 10+ , mrMatchText = "hello"+ , mrContext = Nothing+ }+ optsColor = OutputOptions { ooColor = ColorAlways, ooNoFilename = False }+ optsNoColor = OutputOptions { ooColor = ColorNever, ooNoFilename = False }++ let outputColor = formatResultsWithOpts optsColor FormatGrep [result]+ outputNoColor = formatResultsWithOpts optsNoColor FormatGrep [result]++ -- Color output should contain ANSI escape codes+ let hasEscapeCodes = "\ESC[" `isInfixOf` outputColor+ noEscapeCodes = not ("\ESC[" `isInfixOf` outputNoColor)++ if hasEscapeCodes && noEscapeCodes+ then do+ putStrLn " PASS: Color mode adds ANSI codes, no-color mode omits them"+ pure True+ else do+ putStrLn " FAIL: Color handling incorrect"+ putStrLn $ " Color output has escape codes: " ++ show hasEscapeCodes+ putStrLn $ " No-color output lacks escape codes: " ++ show noEscapeCodes+ pure False++-- | Test files-only output (-l/-L)+testFilesOnlyOutput :: IO Bool+testFilesOnlyOutput = do+ putStrLn "\n=== Files-Only Output Tests ==="++ let results =+ [ MatchResult { mrFilePath = "file1.txt", mrLine = 1, mrCol = 1, mrMatchText = "x", mrContext = Nothing }+ , MatchResult { mrFilePath = "file1.txt", mrLine = 2, mrCol = 1, mrMatchText = "y", mrContext = Nothing }+ , MatchResult { mrFilePath = "file2.txt", mrLine = 1, mrCol = 1, mrMatchText = "z", mrContext = Nothing }+ ]++ let output = formatResults FormatFilesOnly results+ outputLines = filter (not . null) $ lines output++ -- Should only list unique filenames+ if outputLines == ["file1.txt", "file2.txt"]+ then do+ putStrLn " PASS: Files-only output lists unique filenames"+ pure True+ else do+ putStrLn " FAIL: Files-only output incorrect"+ putStrLn $ " Expected: [\"file1.txt\", \"file2.txt\"]"+ putStrLn $ " Got: " ++ show outputLines+ pure False++-- | Test exclude patterns (--exclude/--exclude-dir)+testExcludePatterns :: IO Bool+testExcludePatterns = do+ putStrLn "\n=== Exclude Patterns Tests ==="++ -- Test simple glob matching+ let tests =+ [ ("*.log", "debug.log", True)+ , ("*.log", "debug.txt", False)+ , ("*.log", "app.log.bak", False)+ , ("test*", "test_file.txt", True)+ , ("test*", "my_test.txt", False)+ , ("node_modules", "node_modules", True)+ , ("node_modules", "node_module", False)+ , ("*cache*", "mycache", True)+ , ("*cache*", ".cache", True)+ , ("*cache*", "nocach", False)+ ]++ results <- mapM runGlobTest tests+ let allPassed = and results++ if allPassed+ then do+ putStrLn " PASS: All glob pattern tests passed"+ pure True+ else do+ putStrLn " FAIL: Some glob pattern tests failed"+ pure False++ where+ runGlobTest (pattern, input, expected) = do+ let result = simpleGlobMatch pattern input+ if result == expected+ then pure True+ else do+ putStrLn $ " FAIL: glob '" ++ pattern ++ "' on '" ++ input ++ "'"+ putStrLn $ " Expected: " ++ show expected ++ ", Got: " ++ show result+ pure False++ -- Simple glob matching (copied from Main.hs for testing)+ simpleGlobMatch :: String -> String -> Bool+ simpleGlobMatch [] [] = True+ simpleGlobMatch [] _ = False+ simpleGlobMatch ('*':rest) str = any (simpleGlobMatch rest) (tails str)+ simpleGlobMatch ('?':rest) (_:str) = simpleGlobMatch rest str+ simpleGlobMatch ('?':_) [] = False+ simpleGlobMatch (c:rest) (s:str) = c == s && simpleGlobMatch rest str+ simpleGlobMatch _ [] = False++ tails :: [a] -> [[a]]+ tails [] = [[]]+ tails xs@(_:rest) = xs : tails rest++-- | Test different output formats+testOutputFormats :: IO Bool+testOutputFormats = do+ putStrLn "\n=== Output Format Tests ==="++ let result = MatchResult+ { mrFilePath = "test.txt"+ , mrLine = 5+ , mrCol = 10+ , mrMatchText = "hello"+ , mrContext = Nothing+ }+ opts = OutputOptions { ooColor = ColorNever, ooNoFilename = False }++ -- Test FormatGrep+ let grepOutput = formatResultsWithOpts opts FormatGrep [result]+ let grepOk = "test.txt:5:10:hello" `isPrefixOf` grepOutput++ -- Test FormatJSON+ let jsonOutput = formatResultsWithOpts opts FormatJSON [result]+ let jsonOk = "[{\"file\":\"test.txt\",\"line\":5,\"col\":10,\"match\":\"hello\"}]" `isPrefixOf` jsonOutput++ -- Test FormatCount+ let countOutput = formatResultsWithOpts opts FormatCount [result]+ let countOk = "1 match" `isPrefixOf` countOutput++ -- Test FormatCount plural+ let countPluralOutput = formatResultsWithOpts opts FormatCount [result, result]+ let countPluralOk = "2 matches" `isPrefixOf` countPluralOutput++ -- Test no filename option+ let optsNoFile = OutputOptions { ooColor = ColorNever, ooNoFilename = True }+ let noFileOutput = formatResultsWithOpts optsNoFile FormatGrep [result]+ let noFileOk = "5:10:hello" `isPrefixOf` noFileOutput && not ("test.txt" `isInfixOf` noFileOutput)++ let allTests =+ [ ("FormatGrep", grepOk)+ , ("FormatJSON", jsonOk)+ , ("FormatCount singular", countOk)+ , ("FormatCount plural", countPluralOk)+ , ("No filename option", noFileOk)+ ]++ mapM_ (\(name, ok) -> putStrLn $ (if ok then " PASS: " else " FAIL: ") ++ name) allTests++ pure $ all snd allTests