module Vgrep.Parser (
    -- * Parsing @grep@ output
      parseGrepOutput
    , parseLine

    -- ** Re-export
    , FileLineReference
    ) where

import Control.Applicative
import Data.Attoparsec.Text
import Data.Maybe
import Data.Text            hiding (takeWhile)
import Prelude              hiding (takeWhile)

import Vgrep.Ansi        (stripAnsi)
import Vgrep.Ansi.Parser (attrChange, parseAnsi)
import Vgrep.Results     (File (..), FileLineReference (..), LineReference (..))


-- | Parses lines of 'Text', skipping lines that are not valid @grep@
-- output.
parseGrepOutput :: [Text] -> [FileLineReference]
parseGrepOutput :: [Text] -> [FileLineReference]
parseGrepOutput = (Text -> Maybe FileLineReference) -> [Text] -> [FileLineReference]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe FileLineReference
parseLine

-- | Parses a line of @grep@ output. Returns 'Nothing' if the line cannot
-- be parsed.
--
-- The output should consist of a file name, line number and the content,
-- separated by colons:
--
-- >>> parseLine "path/to/file:123:foobar"
-- Just (FileLineReference {_file = File {_fileName = "path/to/file"}, _lineReference = LineReference {_lineNumber = Just 123, _lineText = Text 6 "foobar"}})
--
-- Omitting the line number still produces valid output:
--
-- >>> parseLine "path/to/file:foobar"
-- Just (FileLineReference {_file = File {_fileName = "path/to/file"}, _lineReference = LineReference {_lineNumber = Nothing, _lineText = Text 6 "foobar"}})
--
-- However, an file name must be present:
--
-- >>> parseLine "foobar"
-- Nothing
--
-- ANSI escape codes in the line text are parsed correctly:
--
-- >>> parseLine "path/to/file:foo\ESC[31mbar\ESC[mbaz"
-- Just (FileLineReference {_file = File {_fileName = "path/to/file"}, _lineReference = LineReference {_lineNumber = Nothing, _lineText = Cat 9 [Text 3 "foo",Format 3 (Attr {attrStyle = KeepCurrent, attrForeColor = SetTo (ISOColor 1), attrBackColor = KeepCurrent, attrURL = KeepCurrent}) (Text 3 "bar"),Text 3 "baz"]}})
--
parseLine :: Text -> Maybe FileLineReference
parseLine :: Text -> Maybe FileLineReference
parseLine Text
line = case Parser FileLineReference -> Text -> Either String FileLineReference
forall a. Parser a -> Text -> Either String a
parseOnly Parser FileLineReference
lineParser Text
line of
    Left  String
_      -> Maybe FileLineReference
forall a. Maybe a
Nothing
    Right FileLineReference
result -> FileLineReference -> Maybe FileLineReference
forall a. a -> Maybe a
Just FileLineReference
result

lineParser :: Parser FileLineReference
lineParser :: Parser FileLineReference
lineParser = do
    Text
file       <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Parser Text -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
':'
    Maybe Int
lineNumber <- Parser Text Int -> Parser Text (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text (Attr -> Attr) -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser Text (Attr -> Attr)
attrChange Parser Text () -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text Int -> Parser Text () -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text (Attr -> Attr) -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser Text (Attr -> Attr)
attrChange Parser Text Int -> Parser Text Char -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
':')
    Text
result     <- Parser Text
takeText
    FileLineReference -> Parser FileLineReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileLineReference :: File -> LineReference -> FileLineReference
FileLineReference
        { _file :: File
_file = File :: Text -> File
File
            { _fileName :: Text
_fileName = Formatted Attr -> Text
forall a. Formatted a -> Text
stripAnsi (Text -> Formatted Attr
parseAnsi Text
file) }
        , _lineReference :: LineReference
_lineReference = LineReference :: Maybe Int -> Formatted Attr -> LineReference
LineReference
            { _lineNumber :: Maybe Int
_lineNumber = Maybe Int
lineNumber
            , _lineText :: Formatted Attr
_lineText   = Text -> Formatted Attr
parseAnsi Text
result } }