packages feed

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 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