diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/screp.cabal b/screp.cabal --- a/screp.cabal +++ b/screp.cabal @@ -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 diff --git a/src/Scrappy/Files.hs b/src/Scrappy/Files.hs --- a/src/Scrappy/Files.hs +++ b/src/Scrappy/Files.hs @@ -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 diff --git a/src/Scrappy/Grep/DSL.hs b/src/Scrappy/Grep/DSL.hs --- a/src/Scrappy/Grep/DSL.hs +++ b/src/Scrappy/Grep/DSL.hs @@ -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 diff --git a/src/Scrappy/Grep/Output.hs b/src/Scrappy/Grep/Output.hs --- a/src/Scrappy/Grep/Output.hs +++ b/src/Scrappy/Grep/Output.hs @@ -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 diff --git a/src/Scrappy/Grep/Search.hs b/src/Scrappy/Grep/Search.hs --- a/src/Scrappy/Grep/Search.hs +++ b/src/Scrappy/Grep/Search.hs @@ -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) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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 "" 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 "" 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