packages feed

screp-0.1.0.0: app/Main.hs

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.Config (runParserViaGhc, ConfigError(..))
import Scrappy.Files (listFilesRecursive)

import Options.Applicative
import System.Exit (exitFailure, exitSuccess)
import System.IO (hPutStrLn, stderr)
import System.Directory (doesDirectoryExist, doesFileExist)
import Data.List (isSuffixOf, nub)

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
  } deriving Show

optionsParser :: Parser Options
optionsParser = Options
  <$> strArgument
      ( metavar "PATTERN"
     <> help "Parsec DSL pattern (e.g., 'some digit', 'ref \"email\"')"
      )
  <*> some (strArgument
      ( metavar "FILE..."
     <> help "Files or directories to search"
      ))
  <*> switch
      ( long "recursive"
     <> short 'r'
     <> help "Search directories recursively"
      )
  <*> many (strOption
      ( long "extension"
     <> short 'e'
     <> metavar "EXT"
     <> help "Only search files with extension (e.g., .hs, .txt)"
      ))
  <*> switch
      ( long "verbose"
     <> short 'v'
     <> help "Verbose output with full match text"
      )
  <*> switch
      ( long "count"
     <> short 'c'
     <> help "Only print count of matches"
      )
  <*> switch
      ( long "quiet"
     <> short 'q'
     <> help "Quiet mode (exit code only)"
      )
  <*> optional (option auto
      ( long "max-results"
     <> short 'm'
     <> metavar "N"
     <> help "Maximum number of results to show"
      ))
  <*> switch
      ( long "json"
     <> help "Output results as JSON"
      )
  <*> optional (strOption
      ( long "import"
     <> short 'i'
     <> metavar "FILE"
     <> help "Haskell file with named parsers (for use with 'ref \"name\"')"
      ))

main :: IO ()
main = do
  opts <- execParser $ info (optionsParser <**> helper)
    ( fullDesc
   <> progDesc "Search files using Parsec parser patterns"
   <> header "screp - grep with parser combinators"
    )

  -- Parse the DSL pattern
  case parseExpr (optPattern opts) of
    Left err -> do
      hPutStrLn stderr $ "Pattern parse error: " ++ show err
      exitFailure
    Right ast -> do
      -- Check if pattern uses refs
      if containsRef ast
        then runWithRefs opts ast
        else runWithoutRefs opts ast

-- | Run search using inline DSL only (no refs)
runWithoutRefs :: Options -> ParserExpr -> IO ()
runWithoutRefs opts ast = do
  case interpret ast of
    Left (UnknownRef name) -> do
      hPutStrLn stderr $ "Unknown parser reference: " ++ name
      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

-- | Run search using external parsers via runghc
runWithRefs :: Options -> ParserExpr -> IO ()
runWithRefs opts ast = do
  case optImport opts of
    Nothing -> do
      hPutStrLn stderr "Pattern uses 'ref' but no --import file specified."
      hPutStrLn stderr "Usage: screp --import Parsers.hs 'ref \"email\"' file.txt"
      exitFailure
    Just importPath -> do
      -- Extract the ref names (for now, only support single ref patterns)
      let refs = nub $ extractRefs ast
      case refs of
        [refName] -> do
          files <- gatherFiles opts (optTargets opts)
          allResults <- searchFilesWithRef importPath refName files
          outputResults opts allResults
        [] -> do
          -- No refs found, shouldn't happen since containsRef was true
          hPutStrLn stderr "Internal error: no refs found"
          exitFailure
        _ -> do
          hPutStrLn stderr "Currently only single ref patterns are supported."
          hPutStrLn stderr $ "Found refs: " ++ show refs
          exitFailure

-- | Search files using external parser via runghc
searchFilesWithRef :: FilePath -> String -> [FilePath] -> IO [MatchResult]
searchFilesWithRef 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

    toMatchResult fp (line, col, matchText) = MatchResult
      { mrFilePath = fp
      , mrLine = line
      , mrCol = col
      , mrMatchText = matchText
      }

    showError (ConfigFileNotFound path) = "Import file not found: " ++ path
    showError (GhcRunFailed msg) = "GHC error: " ++ msg
    showError (ParseResultFailed msg) = "Parse error: " ++ msg

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

  if optQuiet opts
    then if null results then exitFailure else exitSuccess
    else do
      let fmt | optCount opts = FormatCount
              | optJSON opts = FormatJSON
              | optVerbose opts = FormatVerbose
              | otherwise = FormatGrep
      putStr $ formatResults fmt results
      if null results then exitFailure else exitSuccess

-- | Gather all files to search based on options
gatherFiles :: Options -> [FilePath] -> IO [FilePath]
gatherFiles opts targets = do
  allFiles <- concat <$> mapM (expandTarget opts) targets
  pure $ filterByExtension (optExtensions opts) allFiles

-- | Expand a target (file or directory) to a list of files
expandTarget :: Options -> FilePath -> IO [FilePath]
expandTarget opts target = do
  isDir <- doesDirectoryExist target
  isFile <- doesFileExist target
  case (isDir, isFile) of
    (True, _) ->
      if optRecursive opts
        then listFilesRecursive target
        else do
          hPutStrLn stderr $ "Warning: " ++ target ++ " is a directory. Use -r to search recursively."
          pure []
    (_, True) -> pure [target]
    _ -> do
      hPutStrLn stderr $ "Warning: " ++ target ++ " not found"
      pure []

-- | Filter files by extension
filterByExtension :: [String] -> [FilePath] -> [FilePath]
filterByExtension [] files = files
filterByExtension exts files = filter hasExt files
  where
    hasExt fp = any (`isSuffixOf` fp) normalizedExts
    normalizedExts = map ensureDot exts
    ensureDot ext = if "." `isPrefixOf` ext then ext else "." ++ ext
    isPrefixOf prefix str = take (length prefix) str == prefix