{-# LANGUAGE FlexibleContexts #-}

module Scrappy.Grep.Search
  ( searchFile
  , searchFiles
  , searchText
  , offsetToLineCol
  ) where

import Scrappy.Grep.DSL (MatchResult(..))
import Scrappy.Scrape (ScraperT)

import Text.Parsec (parse, getPosition, sourceColumn, sourceLine, try, anyChar, (<|>), eof)
import System.Directory (doesFileExist)

-- | Search a file for all matches, returning results with positions
searchFile :: ScraperT String -> FilePath -> IO [MatchResult]
searchFile :: ScraperT Html -> Html -> IO [MatchResult]
searchFile ScraperT Html
parser Html
fp = do
  Bool
exists <- Html -> IO Bool
doesFileExist Html
fp
  if Bool -> Bool
not Bool
exists
    then [MatchResult] -> IO [MatchResult]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else do
      Html
content <- Html -> IO Html
readFile Html
fp
      [MatchResult] -> IO [MatchResult]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([MatchResult] -> IO [MatchResult])
-> [MatchResult] -> IO [MatchResult]
forall a b. (a -> b) -> a -> b
$ Html -> ScraperT Html -> Html -> [MatchResult]
searchText Html
fp ScraperT Html
parser Html
content

-- | Search multiple files
searchFiles :: ScraperT String -> [FilePath] -> IO [MatchResult]
searchFiles :: ScraperT Html -> [Html] -> IO [MatchResult]
searchFiles ScraperT Html
parser [Html]
fps = [[MatchResult]] -> [MatchResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MatchResult]] -> [MatchResult])
-> IO [[MatchResult]] -> IO [MatchResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Html -> IO [MatchResult]) -> [Html] -> IO [[MatchResult]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ScraperT Html -> Html -> IO [MatchResult]
searchFile ScraperT Html
parser) [Html]
fps

-- | Search text content and return matches with positions
searchText :: FilePath -> ScraperT String -> String -> [MatchResult]
searchText :: Html -> ScraperT Html -> Html -> [MatchResult]
searchText Html
fp ScraperT Html
parser Html
content =
  case Parsec Html () [(Int, Int, Html)]
-> Html -> Html -> Either ParseError [(Int, Int, Html)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> Html -> s -> Either ParseError a
parse (ScraperT Html -> Parsec Html () [(Int, Int, Html)]
findAllWithPos ScraperT Html
parser) Html
"" Html
content of
    Left ParseError
_ -> []
    Right [(Int, Int, Html)]
matches -> ((Int, Int, Html) -> MatchResult)
-> [(Int, Int, Html)] -> [MatchResult]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> (Int, Int, Html) -> MatchResult
toMatchResult Html
fp) [(Int, Int, Html)]
matches

-- | Find all matches with their positions
findAllWithPos :: ScraperT String -> ScraperT [(Int, Int, String)]
findAllWithPos :: ScraperT Html -> Parsec Html () [(Int, Int, Html)]
findAllWithPos ScraperT Html
parser = Parsec Html () [(Int, Int, Html)]
go
  where
    go :: Parsec Html () [(Int, Int, Html)]
go = do
      Bool
atEnd <- (Bool
True Bool
-> ParsecT Html () Identity () -> ParsecT Html () Identity Bool
forall a b.
a -> ParsecT Html () Identity b -> ParsecT Html () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Html () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) ParsecT Html () Identity Bool
-> ParsecT Html () Identity Bool -> ParsecT Html () Identity Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT Html () Identity Bool
forall a. a -> ParsecT Html () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      if Bool
atEnd
        then [(Int, Int, Html)] -> Parsec Html () [(Int, Int, Html)]
forall a. a -> ParsecT Html () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        else Parsec Html () [(Int, Int, Html)]
tryMatch Parsec Html () [(Int, Int, Html)]
-> Parsec Html () [(Int, Int, Html)]
-> Parsec Html () [(Int, Int, Html)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Html () [(Int, Int, Html)]
skipAndContinue

    tryMatch :: Parsec Html () [(Int, Int, Html)]
tryMatch = do
      SourcePos
pos <- ParsecT Html () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      let line :: Int
line = SourcePos -> Int
sourceLine SourcePos
pos
          col :: Int
col = SourcePos -> Int
sourceColumn SourcePos
pos
      Html
matched <- ScraperT Html -> ScraperT Html
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ScraperT Html
parser
      [(Int, Int, Html)]
rest <- Parsec Html () [(Int, Int, Html)]
go
      [(Int, Int, Html)] -> Parsec Html () [(Int, Int, Html)]
forall a. a -> ParsecT Html () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Int, Int, Html)] -> Parsec Html () [(Int, Int, Html)])
-> [(Int, Int, Html)] -> Parsec Html () [(Int, Int, Html)]
forall a b. (a -> b) -> a -> b
$ (Int
line, Int
col, Html
matched) (Int, Int, Html) -> [(Int, Int, Html)] -> [(Int, Int, Html)]
forall a. a -> [a] -> [a]
: [(Int, Int, Html)]
rest

    skipAndContinue :: Parsec Html () [(Int, Int, Html)]
skipAndContinue = do
      Char
_ <- ParsecT Html () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      Parsec Html () [(Int, Int, Html)]
go

-- | Convert (line, col, match) to MatchResult
toMatchResult :: FilePath -> (Int, Int, String) -> MatchResult
toMatchResult :: Html -> (Int, Int, Html) -> MatchResult
toMatchResult Html
fp (Int
line, Int
col, Html
matched) = MatchResult
  { mrFilePath :: Html
mrFilePath = Html
fp
  , mrLine :: Int
mrLine = Int
line
  , mrCol :: Int
mrCol = Int
col
  , mrMatchText :: Html
mrMatchText = Html
matched
  }

-- | Convert a byte offset in text to (line, col) - 1-indexed
offsetToLineCol :: String -> Int -> (Int, Int)
offsetToLineCol :: Html -> Int -> (Int, Int)
offsetToLineCol Html
content Int
offset =
  let prefix :: Html
prefix = Int -> Html -> Html
forall a. Int -> [a] -> [a]
take Int
offset Html
content
      lineNum :: Int
lineNum = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Html -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> Html -> Html
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Html
prefix)
      colNum :: Int
colNum = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Html -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> Html -> Html
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (Html -> Html
forall a. [a] -> [a]
reverse Html
prefix))
  in (Int
lineNum, Int
colNum)