packages feed

screp-0.2.0.0: src/Scrappy/Grep/Search.hs

{-# 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(..), 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 = 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 readAndSearch `catch` handleError
  where
    readAndSearch = do
      content <- readFile fp
      -- 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 = searchFilesWithOpts defaultSearchOptions

-- | 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 = 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
  where
    go = do
      atEnd <- (True <$ eof) <|> pure False
      if atEnd
        then pure []
        else tryMatch <|> skipAndContinue

    tryMatch = do
      pos <- getPosition
      let line = sourceLine pos
          col = sourceColumn pos
      matched <- try parser
      rest <- go
      pure $ (line, col, matched) : rest

    skipAndContinue = do
      _ <- anyChar
      go

-- | Convert (line, col, match) to MatchResult 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)
offsetToLineCol content offset =
  let prefix = take offset content
      lineNum = 1 + length (filter (== '\n') prefix)
      colNum = 1 + length (takeWhile (/= '\n') (reverse prefix))
  in (lineNum, colNum)