pgrep-0.1.0.0: src/Scrappy/Grep/Config.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Scrappy.Grep.Config
( runParserViaGhc
, defaultConfigPath
, ConfigError(..)
) where
import System.Process (readProcessWithExitCode)
import System.Directory (doesFileExist, getHomeDirectory, createDirectoryIfMissing)
import System.FilePath ((</>))
import System.Exit (ExitCode(..))
import Control.Exception (try, SomeException)
import Text.Read (readMaybe)
data ConfigError
= ConfigFileNotFound FilePath
| GhcRunFailed String
| ParseResultFailed String
deriving (Show, Eq)
-- | Default config file path: ~/.config/parsec-grep/Parsers.hs
defaultConfigPath :: IO FilePath
defaultConfigPath = do
home <- getHomeDirectory
let dir = home </> ".config" </> "parsec-grep"
createDirectoryIfMissing True dir
pure $ dir </> "Parsers.hs"
-- | Run a named parser from the config file via runghc
-- Returns the matches as a list of (line, col, matchText)
runParserViaGhc
:: FilePath -- ^ Config file path (Parsers.hs)
-> String -- ^ Parser name (e.g., "email")
-> String -- ^ Content to search
-> IO (Either ConfigError [(Int, Int, String)])
runParserViaGhc configPath parserName content = do
exists <- doesFileExist configPath
if not exists
then pure $ Left $ ConfigFileNotFound configPath
else do
-- Generate a wrapper script that imports the config and runs the parser
let wrapperScript = generateWrapper configPath parserName
result <- try $ readProcessWithExitCode "runghc" ["-e", wrapperScript] content
case result of
Left (e :: SomeException) -> pure $ Left $ GhcRunFailed (show e)
Right (ExitSuccess, stdout, _) ->
case parseOutput stdout of
Nothing -> pure $ Left $ ParseResultFailed stdout
Just matches -> pure $ Right matches
Right (ExitFailure code, _, stderr) ->
pure $ Left $ GhcRunFailed $ "Exit code " ++ show code ++ ": " ++ stderr
-- | Generate a Haskell expression that runs the parser and outputs results
generateWrapper :: FilePath -> String -> String
generateWrapper configPath parserName = unlines
[ ":set -i" ++ takeDirectory configPath
, ":load " ++ configPath
, "import Parsers"
, "import Text.Parsec"
, "import Data.Map (lookup)"
, "import Data.Maybe (fromMaybe)"
, "import Scrappy.Find (findNaive)"
, ""
, "main = do"
, " content <- getContents"
, " let mParser = Data.Map.lookup \"" ++ parserName ++ "\" parsers"
, " case mParser of"
, " Nothing -> putStrLn \"ERROR:UnknownParser:" ++ parserName ++ "\""
, " Just p -> do"
, " case parse (findNaiveWithPos p) \"\" content of"
, " Left err -> putStrLn $ \"ERROR:ParseFailed:\" ++ show err"
, " Right Nothing -> putStrLn \"MATCHES:\""
, " Right (Just ms) -> putStrLn $ \"MATCHES:\" ++ show ms"
]
where
takeDirectory = reverse . dropWhile (/= '/') . reverse
-- | Parse the output from runghc
parseOutput :: String -> Maybe [(Int, Int, String)]
parseOutput output
| "MATCHES:" `isPrefixOf` output =
let rest = drop 8 output
in if null rest || rest == "\n"
then Just []
else readMaybe (takeWhile (/= '\n') rest)
| otherwise = Nothing
where
isPrefixOf prefix str = take (length prefix) str == prefix
-- Note: This is a simplified implementation. A more robust version would:
-- 1. Use a temp file for the wrapper script
-- 2. Handle GHC package dependencies properly
-- 3. Cache compiled parsers for performance
--
-- For now, we'll implement a simpler version that works for basic cases
-- and can be enhanced later.